[英]Use VBScript to Merge all open instances of Notepad.exe and save to txt file
I am looking for a way in vbscript to find any open instances of notepad.exe, copy the text from them and create a new file that contains the contents of all of them and save it.我正在 vbscript 中寻找一种方法来查找 notepad.exe 的任何打开实例,从中复制文本并创建一个包含所有这些内容的新文件并保存它。
I have worked out the code to actually find the running instances, just can't work out a way to copy the text out of them!我已经制定了代码来实际找到正在运行的实例,只是无法找到一种方法来从中复制文本!
Dim objWMIService, objProcess, colProcess,WshShell
Dim strComputer, strList
strComputer = "."
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process")
For Each objProcess in colProcess
if objProcess.Name = "notepad.exe" then
msgbox objProcess.processID
WshShell.AppActivate (objProcess.processID)
'copy the text from notepad into a new file....
end if
Next
Just give a try and tell me the result :试一试并告诉我结果:
Option Explicit
Dim Title,colItems,objItem,FilePath,ws
Dim MyProcess,LogFile,fso,Contents
MyProcess = "Notepad.exe"
Title = "Merge all open instances of "& DblQuote(MyProcess) &" and save it to a text file"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
fso.DeleteFile(LogFile)
End If
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND NOT commandline like '%" & wsh.scriptname & "%'",,48)
For Each objItem in colItems
FilePath = Mid(objItem.CommandLine,InStr(objItem.CommandLine,chr(34)) + 33)
FilePath = Replace(FilePath,chr(34),"")
FilePath = Trim(FilePath)
If Len(FilePath) > 0 Then
Contents = ReadFile(FilePath,"all")
Call WriteLog(Contents,LogFile)
End If
Next
If fso.FileExists(LogFile) Then
ws.run DblQuote(LogFile)
Else
MsgBox "No running instances found for this process " &_
DblQuote(MyProcess),vbExclamation,Title
End If
'**************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************
Function ReadFile(path,mode)
Const ForReading = 1
Dim objFSO,objFile,i,strLine
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(path,ForReading)
If mode = "byline" then
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
strLine = objFile.ReadLine
strLine = Trim(strLine)
If Len(strLine) > 0 Then
arrFileLines(i) = strLine
i = i + 1
ReadFile = arrFileLines
End If
Loop
objFile.Close
End If
If mode = "all" then
ReadFile = objFile.ReadAll
objFile.Close
End If
End Function
'***************************************************
Sub WriteLog(strText,LogFile)
Dim fso,ts
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(LogFile,ForAppending,True,-1)
ts.WriteLine strText
ts.Close
End Sub
'***************************************************
Edit on 31/03/2016 @10:45编辑于 31/03/2016 @10:45
I think this second code can be used to detect and edit any kind of vbscript running on the background!我认为第二个代码可用于检测和编辑在后台运行的任何类型的 vbscript!
Imagine that the vbscript running on the background is a virus , so, we can locate its path,edit and copy its source (-_°)假设后台运行的vbscript是病毒,那么,我们可以定位到它的路径,编辑并复制它的来源(-_°)
Option Explicit
Dim Title,colItems,objItem,FilePath,ws
Dim MyProcess,LogFile,fso,Contents
MyProcess = "wscript.exe"
Title = "Search for all instances of "& DblQuote(MyProcess) &" and save it to a text file"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
fso.DeleteFile(LogFile)
End If
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND NOT commandline like '%" & wsh.scriptname & "%'",,48)
For Each objItem in colItems
FilePath = Mid(objItem.CommandLine,InStr(objItem.CommandLine,chr(34)) + 33)
FilePath = Replace(FilePath,chr(34),"")
FilePath = Trim(FilePath)
If Len(FilePath) > 0 Then
Contents = ReadFile(FilePath,"all")
Call WriteLog(DblQuote(FilePath) & vbCrlf & String(100,"*") & vbCrlf &_
Contents & vbCrlf & String(100,"*") & vbCrlf,LogFile)
End If
Next
If fso.FileExists(LogFile) Then
ws.run DblQuote(LogFile)
Else
MsgBox "No running instances found for this process " &_
DblQuote(MyProcess),vbExclamation,Title
End If
'**************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************
Function ReadFile(path,mode)
Const ForReading = 1
Dim objFSO,objFile,i,strLine
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(path,ForReading)
If mode = "byline" then
Dim arrFileLines()
i = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
strLine = objFile.ReadLine
strLine = Trim(strLine)
If Len(strLine) > 0 Then
arrFileLines(i) = strLine
i = i + 1
ReadFile = arrFileLines
End If
Loop
objFile.Close
End If
If mode = "all" then
ReadFile = objFile.ReadAll
objFile.Close
End If
End Function
'***************************************************
Sub WriteLog(strText,LogFile)
Dim fso,ts
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(LogFile,ForAppending,True,-1)
ts.WriteLine strText
ts.Close
End Sub
'***************************************************
I have created something that works - it's a bit rough, but does the job!我创造了一些有用的东西 - 它有点粗糙,但可以完成工作! It essentially uses sendkeys to restore each notepad in turn, copy the text, close the file without saving then paste the contents into a newly created "master" text file.它本质上使用发送键依次恢复每个记事本,复制文本,关闭文件而不保存,然后将内容粘贴到新创建的“主”文本文件中。 There must be a better way though!不过一定有更好的方法!
Dim objWMIService, objProcess, colProcess,WshShell
Dim strComputer, strList
strComputer = "."
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process")
dim counter
counter=0
dim newid
For Each objProcess in colProcess
if objProcess.Name = "notepad.exe" and objProcess.processID<>newid then
counter=counter+1
if counter=1 then
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
strPath = WshShell.SpecialFolders("Desktop")&"\"&serial&".txt"
Set MyFile = fso.CreateTextFile(strPath, True)
MyFile.Close
Set EngineRun = WshShell.exec("notepad.exe " & strPath)
newid=EngineRun.ProcessID
WshShell.AppActivate(newid)
end if
'msgbox objProcess.processID
WshShell.AppActivate (objProcess.processID)
WScript.Sleep 500
WshShell.sendkeys "% r"
WScript.Sleep 500
WshShell.sendkeys "%E" ' edit
WScript.sleep 500
WshShell.sendkeys "a"
WScript.sleep 500
WshShell.sendkeys "%E" ' edit
WScript.sleep 500
WshShell.sendkeys "c"
WScript.sleep 500
WScript.sleep 500
WshShell.sendkeys "%F" ' edit
WScript.sleep 500
WshShell.sendkeys "x"
WScript.sleep 500
WshShell.sendkeys "n"
WScript.sleep 500
WshShell.AppActivate (newid)
WScript.sleep 500
WshShell.sendkeys vbNewLine & " --- " & objProcess.CommandLine & " --- " & vbNewLine
WScript.sleep 500
WshShell.sendkeys "%E" ' edit
WScript.sleep 500
WshShell.sendkeys "p"
end if
Next
WshShell.AppActivate (newid)
WScript.sleep 500
WshShell.sendkeys "%F" ' edit
WScript.sleep 500
WshShell.sendkeys "s"
WScript.sleep 500
WScript.sleep 500
WshShell.sendkeys "%F" ' edit
WScript.sleep 500
WshShell.sendkeys "x"
WScript.sleep 500
function serial()
strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strDateTime = strSafeDate & strSafeTime
serial=strDateTime
end function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.