分享一些与进程相关的函数
程序代码：Option Explicit
Private Const TH32CS_SNAPHEAPLIST = &H1
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPTHREAD = &H4
Private Const TH32CS_SNAPMODULE = &H8
Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const TH32CS_INHERIT = &H80000000
Private Const MAX_PATH As Integer = 260
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 * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetProcessTimes Lib "kernel32" (ByVal hProcess As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare Function GetThreadTimes Lib "kernel32" (ByVal hThread As Long, lpCreationTime As FILETIME, lpExitTime As FILETIME, lpKernelTime As FILETIME, lpUserTime As FILETIME) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = (&H400)
Private Const PROCESS_SET_INFORMATION = (&H200)
Private Const PROCESS_CREATE_PROCESS = (&H80)
Private Const PROCESS_CREATE_THREAD = (&H2)
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type ProcessTimeInformation
ProcessCreationTime As SYSTEMTIME
ProcessExitTime As SYSTEMTIME
ProcessKernelTime As SYSTEMTIME
ProcessUserTime As SYSTEMTIME
End Type
Public Function IsProcessExist(ByVal strName As String) As Boolean
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
Dim strTmp As String
Dim bExist As Boolean
bExist = False
strName = LCase$(strName)
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
strTmp = Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0))
'Debug.Print strTmp
If LCase$(strTmp) = strName Then
bExist = True
Exit Do
End If
r = Process32Next(hSnapShot, uProcess)
Loop
CloseHandle hSnapShot
IsProcessExist = bExist
End Function
Public Function GetPID(ByVal strName As String) As String
'返回所有进程名为strName的PID，用“,”分隔
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
Dim strTmp As String
Dim strRet As String
strName = LCase$(strName)
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
strTmp = Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0))
'Debug.Print strTmp
If LCase$(strTmp) = strName Then
strRet = strRet & uProcess.th32ProcessID & ","
End If
r = Process32Next(hSnapShot, uProcess)
Loop
CloseHandle hSnapShot
GetPID = strRet
End Function
Public Function GetProcessTime(ByVal ProcessID As Long) As Date ' As ProcessTimeInformation
'获取进程的创建时间
Dim PidCreateTime As FILETIME, PidExitime As FILETIME, PidKerneltime As FILETIME, PidUsertime As FILETIME
Dim PidSysTime As SYSTEMTIME
Dim hPro As Long
Dim dtRet As Date
'hPro = OpenProcess(PROCESS_QUERY_INFORMATION, True, ProcessID)
hPro = OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID)
GetProcessTimes hPro, PidCreateTime, PidExitime, PidKerneltime, PidUsertime
' FileTimeToSystemTime PidCreatime, PidSysTime
' GetProcessTime.ProcessCreationTime = PidSysTime '装载进程的创建时间
'
' FileTimeToSystemTime PidExitime, PidSysTime
' GetProcessTime.ProcessExitTime = PidSysTime '装载进程的终止时间
'
' FileTimeToSystemTime PidKerneltime, PidSysTime
' GetProcessTime.ProcessKernelTime = PidSysTime '装载进程用在内核模式上的总时间
'
' FileTimeToSystemTime PidUsertime, PidSysTime
' GetProcessTime.ProcessUserTime = PidSysTime '装载进程用在用户模式上的总时间
FileTimeToSystemTime PidCreateTime, PidSysTime
dtRet = PidSysTime.wYear & "-" & _
PidSysTime.wMonth & "-" & _
PidSysTime.wDay & " " & _
PidSysTime.wHour & ":" & _
PidSysTime.wMinute & ":" & _
PidSysTime.wSecond
dtRet = dtRet + 1 / 3 'GMT标准时间换成北京时间要加8个小时（8/24)
GetProcessTime = dtRet
End Function
Public Function CloseProcess(ByVal pid As Long) As Long
Dim pHandle As Long
pHandle = OpenProcess(PROCESS_ALL_ACCESS, True, pid)
CloseProcess = TerminateProcess(pHandle, ByVal 0&)
End Function
为测试一个程序时写的（主要是为了获取进程的创建时间），可能不是很标准。有兴趣的可以看一下。
[ 本帖最后由 jiashie 于 2010-8-6 12:54 编辑 ]
