如何在vba中用api函数遍历进程?

用api函数遍历进程的思路是先用api函数CreateToolhelp32Snapshot获取进程的快照(因为进程在不断地变化,只能获取某个时间点的进程快照来遍历),然后用api函数Process32First获取第一个进程的信息,再用api函数Process32Next获取下一个进程的信息,循环到最后一个进程,最后用api函数CloseHandle关闭快照句柄。

根据以上的原理,可以使用如下的代码遍历进程:

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH = &H104
Public 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
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = TH32CS_SNAPPROCESS Or TH32CS_SNAPHEAPLIST Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE
Sub QQ1722187970()
    Dim tProcess As PROCESSENTRY32
    Dim hSnapShot As Long
    With tProcess
        '先给结构设置缓存空间
        .dwSize = LenB(tProcess)
    End With
    Debug.Print Hex(VarPtr(tProcess))
'    获取进程快照
    hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
    '枚举所有进程
    Do Until ProcessNext(hSnapShot, tProcess) = 0
        With tProcess
            '枚举进程PID和进程名称
            Debug.Print .th32ProcessID, Trim(.szExeFile), Len(Trim(.szExeFile))
            '每次枚举完需要将原来szExeFile元素所占用的内容清除,以空格填充,否则会有冗余字符出现
            .szExeFile = Space(260)
        End With
    Loop
    CloseHandle hSnapShot
End Sub

其中PROCESSENTRY32结构的设置是关键,它的大小应该按照如何在vba中使用api函数时准确地传递用户自定义类型的变量大小?一文来设置,另外PROCESSENTRY32结构的szExeFile元素需要每次遍历时都清空原来的内容,不然容易产生冗余字符串。

       

发表评论