批处理之家's Archiver

yu2n 发表于 2015-11-23 13:50

VBS获取自身PID

Find my own process ID in VBScript
[url]http://stackoverflow.com/questions/8296037/find-my-own-process-id-in-vbscript[/url]

思路1:
1. 使用 WshShell.Exec 启动一个子进程,获取子进程PID,
2. 使用WIM搜索子进程ID对应的父PID

思路2:
1. 获取自身进程启动时间,作短暂延时处理
2. 使用WIM搜索进程时间,查找对应PID


实例1:[code]On Error Resume Next
Dim iMyPID : iMyPID = GetObject("winmgmts:root\cimv2").Get("Win32_Process.Handle='" & CreateObject("WScript.Shell").Exec("mshta.exe").ProcessID & "'").ParentProcessId
If Err.Number <> 0 Then Call Handle_Error(Err.Description)
On Error Goto 0
Msgbox iMyPID[/code]实例2(有黑框):[code]      ' ***********************************************************************************************************
      ' lng_MyProcessID finds and returns my own process ID. This is excruciatingly difficult in VBScript. The
      ' method used here forks "cmd /c pause" with .Exec, and then uses the returned .Exec object's .ProcessID
      ' attribute to feed into WMI to get that process's Win32_Process descriptor object, and then uses THAT
      ' WMI Win32_Process descriptor object's .ParentProcessId attribute, which will be OUR Process ID, and finally
      ' we terminate the waiting cmd process. Execing cmd is what causes the brief cmd window to flash at start up,
      ' and I can' figure out out how to hide that window.

      ' returns: My own Process ID as a long int; zero if we can't get it.
      ' ************************************************************************************************************
Msgbox lng_MyProcessID
Function lng_MyProcessID ()
        lng_MyProcessID = 0                     ' Initially assume failure
        Set objChildProcess = CreateObject("WScript.Shell").Exec ( """%ComSpec%"" /C pause" ) ' Fork a child process that just waits until its killed
        Set colPIDs= GetObject("winmgmts:").ExecQuery ( "Select * From Win32_Process Where ProcessId=" & objChildProcess.ProcessID,, 0 )
        For Each objPID In colPIDs                  ' There's exactly 1 item, but .ItemIndex(0) doesn't work in XP
                lng_MyProcessID = objPID.ParentProcessId          ' Return child's parent Process ID, which is MY process ID!
        Next
        Call objChildProcess.Terminate()                ' Terminate our temp child
End Function ' lng_MyProcessID
[/code]实例3:[code]ts1 = Timer : res1 = CurrProcessId : te1 = Timer - ts1
ts2 = Timer : res2 = ThisProcessId : te2 = Timer - ts2
WScript.Echo "CurrProcessId", res1, FormatNumber(te1, 6), _
    vbCrLf & "ThisProcessId", res2, FormatNumber(te2, 6), _
    vbCrLf & "CurrProcessId / ThisProcessId = " & te1 / te2

'> CurrProcessId 6946 0,437500
'> ThisProcessId 6946 0,015625
'> CurrProcessId / ThisProcessId = 28

Function ThisProcessId
    ThisProcessId = 0
    Dim sTFile, oPrc
    With CreateObject("Scripting.FileSystemObject")
        sTFile = .BuildPath(.GetSpecialFolder(2), "sleep.vbs")
        With .OpenTextFile(sTFile, 2, True)
            .Write "WScript.Sleep 1000"
        End With
    End With
    With CreateObject("WScript.Shell").Exec("WScript " & sTFile)
        For Each oPrc In GetObject("winmgmts:\\.\root\cimv2").ExecQuery(_
        "Select * From Win32_Process Where ProcessId=" & .ProcessID)
        Exit For : Next
        ThisProcessId = oPrc.ParentProcessId
    End With
End Function[/code]实例4:[code]Set com = CreateObject("Wscript.Shell")

Set objSWbemServices = GetObject ("WinMgmts:Root\Cimv2")
Set colProcess = objSWbemServices.ExecQuery ("Select * From Win32_Process")
dim toto, thisPid

thisPid=""
toto=200 ' just a high value like 200sec
For Each objProcess In colProcess

     If InStr (objProcess.CommandLine, WScript.ScriptName) <> 0  Then
        Ptime=((Cdbl(objProcess.UserModeTime)+Cdbl(objProcess.KernelModeTime))/10000000)
        if toto > Ptime then
            toto = Ptime
            thisPid = objProcess.ProcessId
        End If
     End If
Next

If thisPid="" then
    WScript.Echo "unable to get the PID"
Else
    WScript.Echo "PID of this script : "&thisPid
End If[/code]

yu2n 发表于 2015-11-24 13:26

[i=s] 本帖最后由 yu2n 于 2015-11-24 17:15 编辑 [/i]

获取自身PID By Yu2n[code]'获取自身PID By Yu2n
Function MePid()
        Dim oPrc : MePid = 0
        With CreateObject("WScript.Shell").Exec("mshta.exe")
                For Each oPrc In GetObject("winmgmts:").ExecQuery( _
                        "Select * From Win32_Process Where ProcessId=" & .ProcessID,,0)
                        MePid = oPrc.ParentProcessId
                Next
                .Terminate()
        End With
End Function[/code]检查 VBS 脚本是否重复执行[code]
'AppPrevInstance.vbs 检查 VBS 脚本是否重复执行 By Yu2n
If AppPrevInstance() Then
        Msgbox "请不要重复运行!",vbSystemModal+vbCritical,">"
        WScript.Quit
Else
        Msgbox "Hello World!",vbSystemModal+vbInformation,">"
End If

'检测程序是否重复运行(按 ScriptFullName、ScriptName 查询)
Function AppPrevInstance()
        Dim sSQL, nCount
        sSQL = "Select * From Win32_Process Where (Name='cscript.exe' Or Name='wscript.exe') And CommandLine Like '%{P1}%'"
        nCount = GetObject("winmgmts:").ExecQuery(Replace(Replace(sSQL,"{P1}",WScript.ScriptFullName),"\","\\")).Count
        If nCount = 0 Then nCount = GetObject("winmgmts:").ExecQuery(Replace(sSQL,"{P1}",WScript.ScriptName)).Count
        AppPrevInstance = (nCount > 1)
End Function[/code]'如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行[code]
'KillReRun.vbs 关闭重复执行的脚本程序 By Yu2n
'如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行
Msgbox "Hello World!",vbSystemModal+vbInformation,">"
KillReRun
Msgbox "已成功关闭重复运行的程序!",vbSystemModal+vbInformation,">"

'如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行
Function KillReRun()
        Dim sSql, sSqlFF, sSqlFNX, oPrc, nMePid : nMePid = 0
        With CreateObject("WScript.Shell").Exec("mshta.exe")
                For Each oPrc In GetObject("winmgmts:").ExecQuery( _
                        "Select * From Win32_Process Where ProcessId=" & .ProcessID,,0)
                        nMePid = oPrc.ParentProcessId
                Next
                .Terminate()
        End With
        sSql = "Select * From Win32_Process Where (Name='cscript.exe' Or Name='wscript.exe') And CommandLine Like '%{P1}%'"
        sSqlFF = Replace(Replace(sSql,"{P1}",WScript.ScriptFullName),"\","\\")        '按 ScriptFullName 查询
        sSqlFNX = Replace(sSql,"{P1}",WScript.ScriptName)                                                '按 ScriptName 查询
        If GetObject("winmgmts:").ExecQuery(sSqlFF).Count > 0 Then
                sSql = sSqlFF
        Else
                sSql = sSqlFNX
        End If
        For Each oPrc In GetObject("winmgmts:").ExecQuery(sSql & " And ProcessId!=" & nMePid)
                oPrc.Terminate()
        Next
        Set oPrc = Nothing
End Function[/code]

yu2n 发表于 2015-11-25 00:34

检测程序是否重复运行(按 CommandLine 严格匹配)[code]'检测程序是否重复运行(按 CommandLine 严格匹配) By Yu2n
Function AppPrevInstanceByCmd()
        Dim oExec, oPrc, nMePid, sCmd, nCount
        Const sql = "Select * From Win32_Process Where "
        Set wim = GetObject("winmgmts:\\.\root\cimv2")
        Set oExec = CreateObject("WScript.Shell").Exec("mshta.exe")
        For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & oExec.ProcessID,,0) : Exit For : Next
        oExec.Terminate()
        nMePid = oPrc.ParentProcessId        '获取自身PID
        For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & nMePid,,0) : Exit For : Next
        sCmd = Replace(oPrc.CommandLine,"\","\\")        '获取自身命令行(含参数)
        nCount = wim.ExecQuery(sql & "CommandLine='" & sCmd & "'",,0).Count        '计数
        AppPrevInstanceByCmd = (nCount > 1)
End Function[/code]

yu2n 发表于 2015-11-25 00:39

如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行(按 CommandLine 严格匹配)[code]'如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行(按 CommandLine 严格匹配) By Yu2n
Function KillReRunByCmd()
        Dim oExec, oPrc, nMePid, sCmd, nCount
        Const sql = "Select * From Win32_Process Where "
        Set wim = GetObject("winmgmts:\\.\root\cimv2")
        Set oExec = CreateObject("WScript.Shell").Exec("mshta.exe")
        For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & oExec.ProcessID,,0) : Exit For : Next
        oExec.Terminate()
        nMePid = oPrc.ParentProcessId        '获取自身PID
        For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & nMePid,,0) : Exit For : Next
        sCmd = Replace(oPrc.CommandLine,"\","\\")        '获取自身命令行(含参数)
        For Each oPrc In wim.ExecQuery(sql & "CommandLine='" & sCmd & "' And ProcessId!=" & nMePid)
                oPrc.Terminate()
        Next
End Function[/code]

zhangop9 发表于 2022-3-20 15:04

检查 VBS 脚本是否重复执行

页: [1]

Powered by Discuz! Archiver 7.2  © 2001-2009 Comsenz Inc.