Question

如何用vb监视一个进程是否存在

Answer 1

Option Explicit
Private Declare Function WinStationTerminateProcess Lib "winsta.dll" (ByVal hServer As Long, ByVal ProcessID As Long, ByVal ExitCode As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
'WinStationTerminateProcess杀进程，第一和第三个参数可设为0
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 * 260
End Type
Private Type MyProcess
    ExeName As String
    pid As Long
End Type
Public Sub CloseProcess(ByVal ProName As String)                '此函数用于结束进程，ProName参数为要结束的进程名称
    WinStationTerminateProcess 0, FindPid(ProName), 0
End Sub
Public Function IsProcess(ByVal ImName As String) As Boolean    '此函数判断一个进程是否存在
    Dim ProArr() As String, PIDArr() As Long, i As Integer
    ListProcess ProArr, PIDArr
    For i = 1 To UBound(ProArr)
        If ProArr(i) = ImName Then
            IsProcess = True
            Exit Function
        End If
    Next
    IsProcess = False
End Function
Private Function FindPid(ByVal ProName As String) As Long
    Dim ProArr() As String, PIDArr() As Long, i As Integer
    ListProcess ProArr, PIDArr
    For i = 1 To UBound(ProArr)
        If ProArr(i) = ProName Then
            FindPid = PIDArr(i)
            Exit For
        End If
    Next
End Function
Private Sub ListProcess(ByRef ProExeName() As String, ByRef ProPid() As Long)
    Dim MyProcess As PROCESSENTRY32
    Dim mySnapshot As Long
    Dim ProData() As MyProcess
    Dim i As Long
    ReDim ProData(0)
    MyProcess.dwSize = Len(MyProcess)
    mySnapshot = CreateToolhelpSnapshot(2, 0)
    ProcessFirst mySnapshot, MyProcess
    ReDim Preserve ProData(UBound(ProData) + 1)
    ProData(UBound(ProData)).ExeName = Left(MyProcess.szexeFile, InStr(MyProcess.szexeFile, Chr(0)) - 1)
    ProData(UBound(ProData)).pid = MyProcess.th32ProcessID
    While ProcessNext(mySnapshot, MyProcess)
        ReDim Preserve ProData(UBound(ProData) + 1)
        ProData(UBound(ProData)).ExeName = Left(MyProcess.szexeFile, InStr(MyProcess.szexeFile, Chr(0)) - 1)
        ProData(UBound(ProData)).pid = MyProcess.th32ProcessID
    Wend
    ReDim ProExeName(1 To UBound(ProData))
    ReDim ProPid(1 To UBound(ProData))
    For i = 1 To UBound(ProData)
        With ProData(i)
            ProExeName(i) = .ExeName
            ProPid(i) = .pid
        End With
    Next
End Sub

'要监视一个进程是否存在，定时调用IsProcess函数就可以了，如果返回true就是存在