[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[转贴] VBS获取自身PID

Find my own process ID in VBScript
http://stackoverflow.com/questio ... cess-id-in-vbscript

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

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


实例1:
  1. On Error Resume Next
  2. Dim iMyPID : iMyPID = GetObject("winmgmts:root\cimv2").Get("Win32_Process.Handle='" & CreateObject("WScript.Shell").Exec("mshta.exe").ProcessID & "'").ParentProcessId
  3. If Err.Number <> 0 Then Call Handle_Error(Err.Description)
  4. On Error Goto 0
  5. Msgbox iMyPID
复制代码
实例2(有黑框):
  1.       ' ***********************************************************************************************************
  2.       ' lng_MyProcessID finds and returns my own process ID. This is excruciatingly difficult in VBScript. The
  3.       ' method used here forks "cmd /c pause" with .Exec, and then uses the returned .Exec object's .ProcessID
  4.       ' attribute to feed into WMI to get that process's Win32_Process descriptor object, and then uses THAT
  5.       ' WMI Win32_Process descriptor object's .ParentProcessId attribute, which will be OUR Process ID, and finally
  6.       ' we terminate the waiting cmd process. Execing cmd is what causes the brief cmd window to flash at start up,
  7.       ' and I can' figure out out how to hide that window.
  8.       ' returns: My own Process ID as a long int; zero if we can't get it.
  9.       ' ************************************************************************************************************
  10. Msgbox lng_MyProcessID
  11. Function lng_MyProcessID ()
  12. lng_MyProcessID = 0                     ' Initially assume failure
  13. Set objChildProcess = CreateObject("WScript.Shell").Exec ( """%ComSpec%"" /C pause" ) ' Fork a child process that just waits until its killed
  14. Set colPIDs= GetObject("winmgmts:").ExecQuery ( "Select * From Win32_Process Where ProcessId=" & objChildProcess.ProcessID,, 0 )
  15. For Each objPID In colPIDs                  ' There's exactly 1 item, but .ItemIndex(0) doesn't work in XP
  16. lng_MyProcessID = objPID.ParentProcessId          ' Return child's parent Process ID, which is MY process ID!
  17. Next
  18. Call objChildProcess.Terminate()                ' Terminate our temp child
  19. End Function ' lng_MyProcessID
复制代码
实例3:
  1. ts1 = Timer : res1 = CurrProcessId : te1 = Timer - ts1
  2. ts2 = Timer : res2 = ThisProcessId : te2 = Timer - ts2
  3. WScript.Echo "CurrProcessId", res1, FormatNumber(te1, 6), _
  4.     vbCrLf & "ThisProcessId", res2, FormatNumber(te2, 6), _
  5.     vbCrLf & "CurrProcessId / ThisProcessId = " & te1 / te2
  6. '> CurrProcessId 6946 0,437500
  7. '> ThisProcessId 6946 0,015625
  8. '> CurrProcessId / ThisProcessId = 28
  9. Function ThisProcessId
  10.     ThisProcessId = 0
  11.     Dim sTFile, oPrc
  12.     With CreateObject("Scripting.FileSystemObject")
  13.         sTFile = .BuildPath(.GetSpecialFolder(2), "sleep.vbs")
  14.         With .OpenTextFile(sTFile, 2, True)
  15.             .Write "WScript.Sleep 1000"
  16.         End With
  17.     End With
  18.     With CreateObject("WScript.Shell").Exec("WScript " & sTFile)
  19.         For Each oPrc In GetObject("winmgmts:\\.\root\cimv2").ExecQuery(_
  20.         "Select * From Win32_Process Where ProcessId=" & .ProcessID)
  21.         Exit For : Next
  22.         ThisProcessId = oPrc.ParentProcessId
  23.     End With
  24. End Function
复制代码
实例4:
  1. Set com = CreateObject("Wscript.Shell")
  2. Set objSWbemServices = GetObject ("WinMgmts:Root\Cimv2")
  3. Set colProcess = objSWbemServices.ExecQuery ("Select * From Win32_Process")
  4. dim toto, thisPid
  5. thisPid=""
  6. toto=200 ' just a high value like 200sec
  7. For Each objProcess In colProcess
  8.      If InStr (objProcess.CommandLine, WScript.ScriptName) <> 0  Then
  9.         Ptime=((Cdbl(objProcess.UserModeTime)+Cdbl(objProcess.KernelModeTime))/10000000)
  10.         if toto > Ptime then
  11.             toto = Ptime
  12.             thisPid = objProcess.ProcessId
  13.         End If
  14.      End If
  15. Next
  16. If thisPid="" then
  17.     WScript.Echo "unable to get the PID"
  18. Else
  19.     WScript.Echo "PID of this script : "&thisPid
  20. End If
复制代码
1

评分人数

    • CrLf: 感谢分享技术 + 1
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

检查 VBS 脚本是否重复执行

TOP

如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行(按 CommandLine 严格匹配)
  1. '如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行(按 CommandLine 严格匹配) By Yu2n
  2. Function KillReRunByCmd()
  3. Dim oExec, oPrc, nMePid, sCmd, nCount
  4. Const sql = "Select * From Win32_Process Where "
  5. Set wim = GetObject("winmgmts:\\.\root\cimv2")
  6. Set oExec = CreateObject("WScript.Shell").Exec("mshta.exe")
  7. For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & oExec.ProcessID,,0) : Exit For : Next
  8. oExec.Terminate()
  9. nMePid = oPrc.ParentProcessId '获取自身PID
  10. For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & nMePid,,0) : Exit For : Next
  11. sCmd = Replace(oPrc.CommandLine,"\","\\") '获取自身命令行(含参数)
  12. For Each oPrc In wim.ExecQuery(sql & "CommandLine='" & sCmd & "' And ProcessId!=" & nMePid)
  13. oPrc.Terminate()
  14. Next
  15. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

检测程序是否重复运行(按 CommandLine 严格匹配)
  1. '检测程序是否重复运行(按 CommandLine 严格匹配) By Yu2n
  2. Function AppPrevInstanceByCmd()
  3. Dim oExec, oPrc, nMePid, sCmd, nCount
  4. Const sql = "Select * From Win32_Process Where "
  5. Set wim = GetObject("winmgmts:\\.\root\cimv2")
  6. Set oExec = CreateObject("WScript.Shell").Exec("mshta.exe")
  7. For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & oExec.ProcessID,,0) : Exit For : Next
  8. oExec.Terminate()
  9. nMePid = oPrc.ParentProcessId '获取自身PID
  10. For Each oPrc In wim.ExecQuery(sql & "ProcessId=" & nMePid,,0) : Exit For : Next
  11. sCmd = Replace(oPrc.CommandLine,"\","\\") '获取自身命令行(含参数)
  12. nCount = wim.ExecQuery(sql & "CommandLine='" & sCmd & "'",,0).Count '计数
  13. AppPrevInstanceByCmd = (nCount > 1)
  14. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

本帖最后由 yu2n 于 2015-11-24 17:15 编辑

获取自身PID By Yu2n
  1. '获取自身PID By Yu2n
  2. Function MePid()
  3. Dim oPrc : MePid = 0
  4. With CreateObject("WScript.Shell").Exec("mshta.exe")
  5. For Each oPrc In GetObject("winmgmts:").ExecQuery( _
  6. "Select * From Win32_Process Where ProcessId=" & .ProcessID,,0)
  7. MePid = oPrc.ParentProcessId
  8. Next
  9. .Terminate()
  10. End With
  11. End Function
复制代码
检查 VBS 脚本是否重复执行
  1. 'AppPrevInstance.vbs 检查 VBS 脚本是否重复执行 By Yu2n
  2. If AppPrevInstance() Then
  3. Msgbox "请不要重复运行!",vbSystemModal+vbCritical,">"
  4. WScript.Quit
  5. Else
  6. Msgbox "Hello World!",vbSystemModal+vbInformation,">"
  7. End If
  8. '检测程序是否重复运行(按 ScriptFullName、ScriptName 查询)
  9. Function AppPrevInstance()
  10. Dim sSQL, nCount
  11. sSQL = "Select * From Win32_Process Where (Name='cscript.exe' Or Name='wscript.exe') And CommandLine Like '%{P1}%'"
  12. nCount = GetObject("winmgmts:").ExecQuery(Replace(Replace(sSQL,"{P1}",WScript.ScriptFullName),"\","\\")).Count
  13. If nCount = 0 Then nCount = GetObject("winmgmts:").ExecQuery(Replace(sSQL,"{P1}",WScript.ScriptName)).Count
  14. AppPrevInstance = (nCount > 1)
  15. End Function
复制代码
'如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行
  1. 'KillReRun.vbs 关闭重复执行的脚本程序 By Yu2n
  2. '如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行
  3. Msgbox "Hello World!",vbSystemModal+vbInformation,">"
  4. KillReRun
  5. Msgbox "已成功关闭重复运行的程序!",vbSystemModal+vbInformation,">"
  6. '如果本脚本被重复执行,关闭之前重复执行脚本程序,只留下此脚本执行
  7. Function KillReRun()
  8. Dim sSql, sSqlFF, sSqlFNX, oPrc, nMePid : nMePid = 0
  9. With CreateObject("WScript.Shell").Exec("mshta.exe")
  10. For Each oPrc In GetObject("winmgmts:").ExecQuery( _
  11. "Select * From Win32_Process Where ProcessId=" & .ProcessID,,0)
  12. nMePid = oPrc.ParentProcessId
  13. Next
  14. .Terminate()
  15. End With
  16. sSql = "Select * From Win32_Process Where (Name='cscript.exe' Or Name='wscript.exe') And CommandLine Like '%{P1}%'"
  17. sSqlFF = Replace(Replace(sSql,"{P1}",WScript.ScriptFullName),"\","\\") '按 ScriptFullName 查询
  18. sSqlFNX = Replace(sSql,"{P1}",WScript.ScriptName) '按 ScriptName 查询
  19. If GetObject("winmgmts:").ExecQuery(sSqlFF).Count > 0 Then
  20. sSql = sSqlFF
  21. Else
  22. sSql = sSqlFNX
  23. End If
  24. For Each oPrc In GetObject("winmgmts:").ExecQuery(sSql & " And ProcessId!=" & nMePid)
  25. oPrc.Terminate()
  26. Next
  27. Set oPrc = Nothing
  28. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

返回列表