返回符合进程名称的所有进程PID

'返回符合进程名称的所有进程PID
'如果为没有，则返回空 (Empty)
Public Function GetProcessIdFromProcessName(ByVal strExeName As String) As Long
    On Error Resume Next
    Const clMaxNumProcesses As Long = 5000 '最大进程数
    Const MAX_PATH = 260
    Const PROCESS_QUERY_INFORMATION = 1024
    Const PROCESS_VM_READ = 16
    Dim strModuleName As String * MAX_PATH
    Dim strProcessNamePath As String
    Dim strProcessName As String
    Dim allMatchingProcessIDs() As Long
    Dim alModules(1 To 400) As Long
    Dim lBytesReturned As Long
    Dim lNumMatching As Long
    Dim lNumProcesses As Long
    Dim lBytesNeeded As Long
    Dim alProcIDs() As Long
    Dim lHwndProcess As Long
    Dim lThisProcess As Long
    Dim lRet As Long
    
    
    
    On Error GoTo Z
    strExeName = UCase$(Trim$(strExeName))
    ReDim alProcIDs(clMaxNumProcesses * 4) As Long '??5000*4
    lRet = EnumProcesses(alProcIDs(1), clMaxNumProcesses * 4, lBytesReturned)
    lNumProcesses = lBytesReturned / 4
    ReDim Preserve alProcIDs(lNumProcesses) '获取所有进程的标识符,学号嘛
    
'    Dim i As Integer
'    For i = 1 To lNumProcesses
'    Debug.Print alProcIDs(i)
'    Next i
    
    ReDim allMatchingProcessIDs(1 To lNumProcesses)
    For lThisProcess = 1 To lNumProcesses 'lNumProcesses=现在进程数
        If lHwndProcess > 0 Then lRet = CloseHandle(lHwndProcess)
        lHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, alProcIDs(lThisProcess))
        If lHwndProcess <> 0 Then
           lRet = EnumProcessModules(lHwndProcess, alModules(1), 200&, lBytesNeeded)
           If lRet <> 0 Then
              lRet = GetModuleFileNameExA(lHwndProcess, alModules(1), strModuleName, MAX_PATH)
              strProcessNamePath = Trim$(UCase$(Left$(strModuleName, lRet)))
              strProcessName = Mid$(strProcessNamePath, InStrRev(strProcessNamePath, "") + 1)
              If strProcessName = strExeName Then
                 lNumMatching = lNumMatching + 1
                 allMatchingProcessIDs(lNumMatching) = alProcIDs(lThisProcess)
              End If
           End If
           If lHwndProcess > 0 Then lRet = CloseHandle(lHwndProcess)
        End If
    Next
    If lNumMatching Then
       ReDim Preserve allMatchingProcessIDs(1 To lNumMatching)
       GetProcessIdFromProcessName = allMatchingProcessIDs(1)    '这个地方，不知道是否还有其它的值。
    Else
       GetProcessIdFromProcessName = -1
    End If
    Exit Function
Z:
    GetProcessIdFromProcessName = -1
End Function
Private Sub Form_Load()

    Dim Pid As Long
    Pid = GetProcessIdFromProcessName("notepad.exe") '获取QQ程序的PID
    Debug.Print (Pid)  '>0 表示找到了，否则，就是没有找到。
    'pid就是进程的标识符

End Sub


'所用的API说明:
'OpenProcess
'打开一个现有进程的句柄
'参数表
'dwDesiredAccess Long，指定这个句柄要求的访问方法。指定API32.TXT文件中以PROCESS_???开头的一个或多个常数
'bInheritHandle  Long，如句柄能够由子进程继承，则为TRUE
'dwProcessId     Long，要打开那个进程的进程标识符
'这个函数经常用来打开一个要进行同步的进程



'CloseHandle
'关闭一个内核对象。其中包括文件、文件映射、进程、线程、安全和同步对象等。
'涉及文件处理时，这个函数通常与vb的close命令相似。应尽可能的使用close，因为它支持vb的差错控制。
'注意这个函数使用的文件句柄与vb的文件编号是完全不同的
'参数表
'hObject     Long，欲关闭的一个对象的句柄
'除非对内核对象的所有引用都已关闭，否则该对象不会实际删除