定期检测程序运行
本帖最后由 bcrun 于 2012-08-29 09:43:47 编辑

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 3000
End Sub

Private Sub Timer1_Timer()
    If 0 = getPID("qq.exe") Then MsgBox "程序已关闭", vbInformation, "提示"
End Sub

Function getPID(qq As String) As Long
    Dim objWMIService, objProcess, colProcess
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process")
    For Each objProcess In colProcess
        If LCase(objProcess.Name) = LCase(qq) Then
            getPID = objProcess.ProcessID
            Exit For
        End If
    Next
    Set objWMIService = Nothing
    Set objProcess = Nothing

End Function

运行时在Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")这行显示

实时错误 ‘-2147217375（80041021）’：
自动化错误

请大家帮忙看看是怎么回事，该程序每隔3秒检测另外一个程序是否运行
[解决办法]

引用:

回复楼上，批处理已经可以实现了，现在vb中跳出错误

我的思路是使用DOS外部命令获取任务管理器中的运行进程，再在结果中查找是否有你要查询的进程。应该很快。
[解决办法]
你用的方法是 WMI 枚举进程，而 WMI 的效率比较低，而且受 WMI 服务的影响，你可以尝试用 API 枚举进程来实现你的目的，相对高效和稳定很多。你可以参考以下几个 API 函数：
CreateToolhelp32Snapshot
Process32First
Process32Next
CloseHandle