Visual Basic 判断进程是否运行
在编写程序的时候,有时候需要判断进程,比如检测自身是否运行等等,下面的实例使用了以下4个API:
❤ CreateToolhelp32Snapshot(ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
❤ Process32First (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
❤ Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
❤ CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
如果你不明白具体的使用方法,可以自己Google、Baidu
代码如下:
'============================================= '模块 Process.bas '转载请注明出处:www.2wxk.com '代码仅供参考,如有不对请找博主(点击评论)! '============================================= Option Explicit Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * 1024 End Type Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Const TH32CS_SNAPHEAPLIST = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPTHREAD = &H4 Const TH32CS_SNAPMODULE = &H8 Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE) Const TH32CS_INHERIT = &H80000000 Public Function FindProcess(ByVal ProcessName As String) As Long Dim strdata As String Dim my As PROCESSENTRY32 Dim l As Long Dim l1 As Long Dim mName As String Dim i As Integer, pid As Long l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) If l Then my.dwSize = 1060 If (Process32First(l, my)) Then Do i = InStr(1, my.szExeFile, Chr(0)) mName = LCase(left(my.szExeFile, i - 1)) If mName = LCase(ProcessName) Then pid = my.th32ProcessID FindProcess = pid Exit Function End If Loop Until (Process32Next(l, my) < 1) End If l1 = CloseHandle(l) End If FindProcess = 0 End Function '===================== '调用函数 '===================== Private Sub Command1_Click() If FindProcess("notepad.exe") <> 0 Then '检测 notepad.exe 进程是否存在 Msgbox "记事本已经运行了!" Else Msgbox "记事本没有运行!" End If End Sub '本代码于作者 2015-12-12 17:30 Windows7 旗舰版测试通过。 '前几天优化代码,用太多函数没用而且占用空间,于是就突发奇想,一个进程都有PID,那就做一个PID检测程序,如果PID不等于0,那么进程就存在,否则就不存在,说好就开始动手。于是在网络上找到这个代码: Public Function GetProcessPid(ProcessName As String) As Long Dim pid As Long Dim pname As String Dim a As String a = Trim(LCase(Text1)) Dim my As PROCESSENTRY32 Dim l As Long Dim l1 As Long Dim flag As Boolean Dim mName As String Dim i As Integer l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) If l Then my.dwSize = 1060 End If If (Process32First(l, my)) Then '遍历第一个进程 Do i = InStr(1, my.szExeFile, Chr(0)) '返回chr(0)在各个进程中出现的位置 mName = LCase(Left(my.szExeFile, i - 1)) '返回小写的(返回i-1的前n个字符,即正确的名称) If mName = a Then pid = my.th32ProcessID End If Loop Until (Process32Next(l, my) < 1) End IfEnd Function '调用:getprocesspid(进程名),返回PID。
