返回符合进程名称的所有进程PID
2013年01月12日
⁄ 综合
⁄ 共 2955字 ⁄ 字号
小 中 大
'返回符合进程名称的所有进程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，欲关闭的一个对象的句柄
'除非对内核对象的所有引用都已关闭，否则该对象不会实际删除