已知进程名，如何获得程序的PID？

Question

下面是小的写的一个根据进程ID获得文件路径的函数：
Public Function EnumFileName(Pid As Long) As String
Dim hProc As Long
Dim NFile As Long
Dim filename As String * 64
hProc = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
NFile = GetModuleFileNameEx(hProc, 0, filename, 64)
EnumFileName = filename & vbNullString
n = CloseHandle(a)
End Function
可是这样的话，要知道程序的进程ID才能得到程序的路径，请问有没有方法，在已经知道进程名的情况下，得到进程ID呢？请指教一下！比如说，在任务管理器中，我已经知道QQ的进程名，请问如何根据这个已知条件得到QQ的进程ID，从而得到QQ的安装目录呢？谢谢！

Answer 1

Public Function ProcessToPID(ByVal sProcess As String, Optional bIncludingPath As Boolean = True) As Long
    Dim ret As Long
    Dim pid As Long
    Dim hProcess As Long
    Dim lpFileName As String * 1024
    Dim proc As PROCESSENTRY32
    Dim snap As Long
    Dim lngContinue As Long
    Dim sFileName As String
    If bIncludingPath = False Then sProcess = PathToFile(sProcess)    snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
    proc.dwSize = Len(proc)
    lngContinue = ProcessFirst(snap, proc) '获取第一个进程，并得到其返回值
        While lngContinue <> 0 '当返回值非零时继续获取下一个进程
 
                        If bIncludingPath = True Then
                                hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pid)
                                Call GetModuleFileNameExA(hProcess, 0, lpFileName, 1024)
                                CloseHandle hProcess
                                sFileName = LCase(ConverNull(lpFileName))
                        Else
                                sFileName = LCase(ConverNull(proc.szexeFile))
                        End If
                        If LCase(sProcess) = sFileName Then
                                ret = proc.th32ProcessID
                                lngContinue = 0
                        End If
                        lngContinue = ProcessNext(snap, proc)
        Wend
    CloseHandle snap '关闭进程“快照”句柄    ProcessToPID = ret
End Function

Answer 2

Public Function ConverNull(ByVal s As String) As String
    Dim nullpos As Long
    nullpos = InStr(s, Chr$(0))
    If nullpos > 0 Then
        ConverNull = Left(s, nullpos - 1)
    Else
        ConverNull = s
    End If
End Function

Answer 3

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 Process32Next 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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
 
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
 
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
Dim PID   As Long
Dim pname    As String
Public Const PROCESS_TERMINATE = &H1Public Function CheckExE(ByVal ExePath As String) As Long
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
CheckExE = 0
If (Process32First(l, my)) Then     '遍历第一个进程
           Do
               i = InStr(1, my.szExeFile, Chr(0))
               mName = LCase(Left(my.szExeFile, i - 1))
               If FindStr(mName, ExePath) = True Then
                  CheckExE = my.th32ProcessID
                  flag = True
                  Exit Function
                'Else
                '  CheckExE = 0
                '  flag = False
                End If
           Loop Until (Process32Next(l, my) < 1)       '遍历所有进程知道返回值为False
       End If
       l1 = CloseHandle(l)
   End If
   
End FunctionPublic Function FindStr(ByVal iStr As String, ByVal iKey As String) As Boolean
Dim I As Integer
For I = 1 To Len(iStr) - (Len(iKey) - 1)
If UCase(iKey) = UCase(Mid(iStr, I, Len(iKey))) Or UCase(iKey) = UCase(iStr) Then
FindStr = True
Exit Function
Else
FindStr = False
End If
Next I
End Function
if checkexe("qq.exe")<>0 then
   msgbox checkexe("qq.exe")
endif

Answer 4

系統進程操作Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function Module32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As MODULEENTRY32) As Long
Declare Function Module32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As MODULEENTRY32) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPheaplist = &H1
Const TH32CS_SNAPthread = &H4
Const TH32CS_SNAPmodule = &H8
Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + _
                       TH32CS_SNAPthread + TH32CS_SNAPmodule
Const MAX_PATH       As Integer = 260
Const PROCESS_TERMINATE = &H1Type 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 * MAX_PATH
End TypeType MODULEENTRY32
  dwSize        As Long
  th32ModuleID  As Long
  th32ProcessID As Long
  GlblcntUsage  As Long
  ProccntUsage  As Long
  modBaseAddr   As Long
  modBaseSize   As Long
  hModule       As Long
  szModule      As String * 256
  szExePath     As String * 260
End TypeFunction GetExeNameByHwnd(ByVal WinHandle As Long) As String
  Dim Pid     As Long
  Dim tempstr As String
  Dim proc    As PROCESSENTRY32
  Dim modl    As MODULEENTRY32
  Dim snapm   As Long
  Dim snap    As Long
  Dim theloop As Long
  snap = CreateToolhelp32Snapshot(TH32CS_SNAPall, 0)
  proc.dwSize = Len(proc)
  modl.dwSize = Len(modl)
  GetWindowThreadProcessId WinHandle, Pid
  theloop = Process32First(snap, proc)
  Do While theloop <> 0
     If proc.th32ProcessID = Pid Then
        snapm = CreateToolhelp32Snapshot(TH32CS_SNAPall, proc.th32ProcessID)
        Module32First snapm, modl
        CloseHandle snapm
        tempstr = TrimNull(modl.szExePath)
        GetExeNameByHwnd = IIf(tempstr <> "", tempstr, TrimNull(proc.szExeFile))
        Exit Do
     End If
     theloop = Process32Next(snap, proc)
  Loop
ex:
  CloseHandle snap
End Function'判斷進程是否在運行
Function IsProcessRunning(procname As String) As Long
  Dim proc     As PROCESSENTRY32
  Dim snap     As Long
  Dim theloop  As Long
  Dim exePath  As String  IsProcessRunning = -1
  snap = CreateToolhelp32Snapshot(TH32CS_SNAPall, 0)
  proc.dwSize = Len(proc)
  theloop = Process32First(snap, proc)
  Do While theloop <> 0
     exePath = TrimNull(proc.szExeFile)
     Debug.Print exePath
     If UCase(procname) = UCase(exePath) Then
        IsProcessRunning = proc.th32ProcessID
        Exit Do
     End If
     theloop = Process32Next(snap, proc)
  Loop
  CloseHandle snap
End Function'中止進程
Sub KillProcess(ByVal procname As String)
    Dim r      As Long
    Dim Result As Long
    Result = IsProcessRunning(procname)
    If Result = -1 Then Exit Sub
    r = OpenProcess(PROCESS_TERMINATE, True, Result)
    TerminateProcess r, 0
End Sub'是去除API返回的字符串中的NULL字符
Function TrimNull(ByVal ss As String) As String
  On Error Resume Next
  Dim NulPos As Long
  NulPos = InStr(1, ss, vbNullChar)
  TrimNull = IIf(NulPos <> 0, Left(ss, NulPos - 1), ss)
End Function'根據PID獲取文件名稱
Sub Test()
    Dim ME32 As MODULEENTRY32
    Dim hWnd      As Long
    Dim Pid       As Long
    Dim hSnapShot As Long
    Dim Ret       As Long
    hWnd = FindWindowA(vbNullString, "Office編程技巧")
    GetWindowThreadProcessId hWnd, Pid
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPmodule, Pid)
    ME32.dwSize = Len(ME32)
    Ret = Module32First(hSnapShot, ME32)
    Do While Ret <> 0
       ExeName = ME32.szExePath
       ExeName = LCase$(Left$(ExeName, InStr(ExeName, vbNullChar) - 1))
       If InStr(ExeName, ".exe") <> 0 Then
          MsgBox ExeName
       Else
          If ExeName <> "" Then Debug.Print ExeName
       End If
       Ret = Module32Next(hSnapShot, ME32)
    Loop
End Sub

Answer 5

查询wmi的win32_process类的ProcessId属性

Answer 6

Private Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
'返回符合进程名称的所有进程PID
'如果为没有，则返回空 (Empty)
Public Function GetProcessIdFromProcessName(ByVal strExeName As String) As Variant
    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
    lRet = EnumProcesses(alProcIDs(1), clMaxNumProcesses * 4, lBytesReturned)
    lNumProcesses = lBytesReturned / 4
    ReDim Preserve alProcIDs(lNumProcesses)
    ReDim allMatchingProcessIDs(1 To lNumProcesses)
    For lThisProcess = 1 To 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
    Else
       GetProcessIdFromProcessName = Empty
    End If
    Exit Function
Z:
    GetProcessIdFromProcessName = Empty
End Function