返回符合进程名称的所有进程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，欲关闭的一个对象的句柄
' 除非对内核对象的所有引用都已关闭，否则该对象不会实际删除