VB 通用枚举进程模块

Option Explicit

'************************************* 用于枚举进程*********************************
'CreateToolhelpSnapshot为指定的进程、进程使用的堆[HEAP]、模块[MODULE]、线程[THREAD]）建立一个快照[snapshot]。

'参数：
'dwFlags

'TH32CS_INHERIT -声明快照句柄是可继承的
'TH32CS_SNAPall -在快照中包含系统中所有的进程和线程
'TH32CS_SNAPheaplist -在快照中包含在th32ProcessID中指定的进程的所有的堆
'TH32CS_SNAPmodule -在快照中包含在th32ProcessID中指定的进程的所有的模块
'TH32CS_SNAPPROCESS -在快照中包含系统中所有的进程
'TH32CS_SNAPthread -在快照中包含系统中所有的线程

'th32ProcessID

'[输入]指定将要快照的进程ID。如果该参数为0表示快照当前进程。
'该参数只有在设置了TH32CS_SNAPHEAPLIST或TH32CS_SNAPMOUDLE后才有效，在其他情况下该参数被忽略，所有的进程都会被快照。
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

'参数: Handle hSnapshot传入的Snapshot句柄
'参数：LPMODULEENTRY3 lpme 指向一个 MODULEENTRY32结构的指针
'作用：从Snapshot得到第一个进程记录信息
Private Declare Function Module32First Lib "kernel32" ( ByVal hSnapShot As Long , lppe As MODULEENTRY32) As Long

'参数: Handle hSnapshot传入的Snapshot句柄
'参数：LPMODULEENTRY3 lpme 指向一个 MODULEENTRY32结构的指针
'作用: 从Snapshot得到下一个Module记录信息
Private Declare Function Module32Next Lib "kernel32" ( ByVal hSnapShot As Long , lppe As MODULEENTRY32) As Long

'关闭句柄
Private Declare Function CloseHandle Lib "kernel32" ( ByVal hObject As Long ) As Long

Private Type PROCESSENTRY32
dwSize As Long '结构大小
cntUsage As Long '此进程的引用计数
th32ProcessID As Long '进程ID
th32DefaultHeapID As Long '进程默认堆ID
th32ModuleID As Long '进程模块ID
cntThreads As Long '此进程开启的线程计数
th32ParentProcessID As Long '父进程ID
pcPriClassBase As Long '线程优先权
dwFlags As Long '保留
szExeFile As String * 260 '进程全名
End Type

Private Const TH32CS_SNAPPROCESS = &H2 'TH32CS_SNAPPROCESS -在快照中包含系统中所有的进程?
Private Const TH32CS_SNAPmodule = &H8 '表示对象为由th32ProcessID参数指定的进程调用的所有模块

Private Type MODULEENTRY32
dwSize As Long '指定结构的大小，在调用Module32First前需要设置，否则将会失败
th32ModuleID As Long '模块号
th32ProcessID As Long '包含本模块的进程号
GlblcntUsage As Long '本模块的全局引用计数
ProccntUsage As Long '包含模块的进程上下文中的模块引用计数
modBaseAddr As Byte '模块基地址
modBaseSize As Long '模块大小（字节数）
hModule As Long '包含模块的进程上下文中的hModule句柄
szModule As String * 256 '模块名
szExePath As String * 1024 '模块对应的文件名和路径
End Type

'*************************************************************************
'**函 数 名： GetProcess
'**输 入： ByVal frmRuningProcess(Form) - 直接传入各对象名
'** ： ByVal treProcess(TreeView) -
'** ： ByVal lblProcessNumber(Label) -
'**输 出： 无
'**功能描述：建立进程树结构
'**全局变量：
'**调用模块：
'**作 者： Mr.David
'**日 期： 2007-11-27 14:09:37
'**修 改 人：
'**日 期：
'**版 本： V1.0.0
'*************************************************************************
Public Sub GetProcess( ByVal frmRuningProcess As Form, ByVal treProcess As TreeView, ByVal lblProcessNumber As Label)

Dim lngResult As Long
Dim hSnapShot As Long '这些定义和VB定义有点不同，由于是Api使用，那就保留其所有权了。
Dim hMSnapshot As Long

Dim strTreTxt As String
Dim lngRet As Long
Dim treNode As Node
Dim lngProcCount As Long
Dim strTreKey As String

Dim MEY As MODULEENTRY32
Dim PEE As PROCESSENTRY32

On Error GoTo PROC_ERR

hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0 ) '快照所有进程

PEE.dwSize = Len(PEE)
MEY.dwSize = Len(MEY)

lngResult = ProcessFirst(hSnapShot, PEE) '获取第一进程

'外循环读取进程名
Do While lngResult <> 0

lngProcCount = lngProcCount + 1 '累计进程数

hMSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPmodule, PEE.th32ProcessID) '快照当前进程模块
MEY.szExePath = Space$( 256 )

strTreKey = PEE.szExeFile '对树根关键字采用的PEE.szExeFile，注意运行同一程序多个实例会转入PROC_ERR处理
strTreTxt = PEE.szExeFile

Set treNode = treProcess.Nodes.Add(, , strTreKey, strTreTxt) '进程树根是进程名

lngRet = Module32First(hMSnapshot, MEY)

'内循环读取模块名
Do While lngRet > 0

'注意一个进程的最后一个模块列出后继续列出下一个会出现类似 ??1??鏴? 的名称，这显然不是我们需要的，排除了。
'另外TreeView控件会自己处理文件名的Chr(0)字符，我们就由它处理了。
If InStr( 1 , MEY.szExePath, "?" ) = 0 Then

Set treNode = treProcess.Nodes.Add(strTreKey, tvwChild, , MEY.szExePath) '列出模块

End If

lngRet = Module32Next(hMSnapshot, MEY) '获取下一模块

Loop

'treNode.EnsureVisible '展开分支,可以选用这句
Call CloseHandle(hMSnapshot) '关闭模块快照句柄
lngResult = ProcessNext(hSnapShot, PEE) '获取下一进程

Loop

Call CloseHandle(hSnapShot) '关闭进程快照句柄

lblProcessNumber.Caption = "当前进程数：" & lngProcCount
lblProcessNumber.Visible = True

Exit Sub

PROC_ERR:

'如果发生集合中的关键字不唯一，则关键字重命名，比如Nt系统会存在多个Svchost进程，此关键字这里不重要，随便处理一下
If Err.Number = 35602 Then strTreKey = strTreKey & "1"
Resume

End Sub

调用例子：

'先分别添加一个TreeView命名为treProcess，和Label命名为lblProcessNumber。
treProcess.Nodes.Clear
Call GetProcess(frmRuningProcess, treProcess, lblProcessNumber)