使用 VBScript 合并所有打开的 Notepad.exe 实例并保存到 txt 文件答案

【问题标题】：Use VBScript to Merge all open instances of Notepad.exe and save to txt file使用 VBScript 合并所有打开的 Notepad.exe 实例并保存到 txt 文件
【发布时间】：2016-03-31 17:45:07
【问题描述】：

我正在 vbscript 中寻找一种方法来查找任何打开的 notepad.exe 实例，从中复制文本并创建一个包含所有这些内容的新文件并保存。

我已经编写了代码以实际找到正在运行的实例，只是无法找到一种方法来复制其中的文本！

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

【问题讨论】：

标签： vbscript wsh

【解决方案1】：

试一试，告诉我结果：

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
'***************************************************

编辑于 2016 年 3 月 31 日 @10:45

我认为第二个代码可以用来检测和编辑任何在后台运行的 vbscript！

假设后台运行的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
'***************************************************

【讨论】：

嗨。如果在首次创建日志文件后添加 WScript.Sleep 500，它会完成一些工作。它将复制打开了以前保存的文档的任何打开的 notepad.exe 实例的内容。它不会拾取从未保存过的那些或尚未保存的更改。不过又好又快！
嗨。遗憾的是，这仍然只从以前保存的 txt 文件打开的 notepad.exe 实例中提取文本 - 如果它们只是在运行并且从未保存过。
我不知道你怎么能捕捉到从未保存过的东西？ ? ?
一样！！这就是为什么目前它只是使用发送键来模拟大量的复制和粘贴操作。感谢您的尝试！

【解决方案2】：

我创建了一些有用的东西 - 它有点粗糙，但确实有效！它本质上使用sendkeys依次恢复每个记事本，复制文本，关闭文件而不保存，然后将内容粘贴到新创建的“主”文本文件中。不过一定有更好的方法！

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

【讨论】：

使用SendKeys 总是一种糟糕的处理方式，但是对于您想要做的事情，没有更好的方法了（尽管您可以使用^a、^c使用菜单）。
我做了这个改变，它运行起来肯定更顺畅！