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
复制代码

      ' ***********************************************************************************************************
      ' 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
复制代码

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
复制代码

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
复制代码

'获取自身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
复制代码

'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
复制代码

'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
复制代码

'检测程序是否重复运行(按 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
复制代码

'如果本脚本被重复执行，关闭之前重复执行脚本程序，只留下此脚本执行(按 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
复制代码