Windows NT/2000: PSAPI
正如前面提到的那样，To o l H e l p 3 2 在Windows NT/2000 下是不存在的。不过，Wi n d o w s 平台S D K 提
供了一个叫P S A P I . D L L 的动态链接库，通过这个动态链接库可以获取类似于To o l H e l p 3 2 能够获取的信
息，包括：
?正在运行的进程。
?每个进程已加载的模块。
?已加载的设备驱动程序。
?进程内存信息。
?映射每个进程的文件内存。
Windows NT 的较高版本和Windows 2000 的所有版本都包含P S A P I . D L L 。但你要让你的应用程序的用户可以使它，还是应该随程序分发这个文件。D e l p h i 为这个D L L 提供了一个叫P S A P I . p a s 的接口单元，可以动态地加载所有的函数。因此，无论机器上有没有安装P S A P I . D L L ，引用这个单元的应用程序都能够运行(当然，不安装P S A P I . D L L ，函数无法工作，但应用程序能够运行)。
使用P S A P I 获取进程信息，首先要调用E n u m P r o c e s s e s ( )函数，其声明如下：
BOOL EnumProcesses(
DWORD * lpidProcess, // array to receive the process identifiers
DWORD cb, // size of the array
DWORD * cbNeeded // receives the number of bytes returned
);
?lpidProcess 是一个指向D W O R D 数组的指针，由函数用进程I D 填充。
?cb 包含由l p i d P r o c e s s 指定的数组的元素数。
?c b N e e d e d 返回拷贝到l p i d P r o c e s s 数组的实际字节数。用此值除以S i z e O f ( D W O R D )将得到拷贝到数组的元素数，即正在运行的进程数。
调用这个函数后，l p i d P r o c e s s 指定的数组将包含一些进程的I D 。进程I D 在自身进程中无用，但可以传递给OpenProcess() API 函数以获取进程的句柄。一旦拥有一个进程句柄，就可以调用针对进程句柄的其他P S A P I 函数，甚至其他Win32 API 函数。
P S A P I 提供了一个相似的函数-E n u m D e v i c e D r i v e r s ( )函数，用于获取已加载的设备驱动程序的
信息。声明如下：
BOOL EnumDeviceDrivers(
LPVOID *lpImageBase, // array to receive the load addresses
DWORD cb, // size of the array
LPDWORD lpcbNeeded // receives the number of bytes returned
);
先把一个叫B i g A r r a y 的数组传递给函数E n u m P r o c e s s e s ( )和E n u m D e v i c e D r i v e r s ( )，然后把
B i g A r r a y 内的数据分别移到叫F P r o c L i s t 和F D r v L i s t 的动态数组中。之所以这么复杂地实现，原因是
E n u m P r o c e s s e s ( )和E n u m D e v i c e D r i v e r s ( )都不能预先分配数组内存，因为它们不知道将要返回多少个数
组元素。因此先声明一个大数组(希望足够大)，再把结果拷贝到适当大小的动态数组中。
**********************************************
get process informations? (Windows NT/2000)
{
This function write all nt process informations into memo1. In Edit1 you can
specify the processID.
}
type
PDebugModule = ^TDebugModule;
TDebugModule = packed record
Reserved: array [0..1] of Cardinal;
Base: Cardinal;
Size: Cardinal;
Flags: Cardinal;
Index: Word;
Unknown: Word;
LoadCount: Word;
ModuleNameOffset: Word;
ImageName: array [0..$FF] of Char;
end;
type
PDebugModuleInformation = ^TDebugModuleInformation;
TDebugModuleInformation = record
Count: Cardinal;
Modules: array [0..0] of TDebugModule;
end;
PDebugBuffer = ^TDebugBuffer;
TDebugBuffer = record
SectionHandle: THandle;
SectionBase: Pointer;
RemoteSectionBase: Pointer;
SectionBaseDelta: Cardinal;
EventPairHandle: THandle;
Unknown: array [0..1] of Cardinal;
RemoteThreadHandle: THandle;
InfoClassMask: Cardinal;
SizeOfInfo: Cardinal;
AllocatedSize: Cardinal;
SectionSize: Cardinal;
ModuleInformation: PDebugModuleInformation;
BackTraceInformation: Pointer;
HeapInformation: Pointer;
LockInformation: Pointer;
Reserved: array [0..7] of Pointer;
end;
const
PDI_MODULES = $01;
ntdll = 'ntdll.dll';
var
HNtDll: HMODULE;
type
TFNRtlCreateQueryDebugBuffer = function(Size: Cardinal;
EventPair: Boolean): PDebugBuffer;
stdcall;
TFNRtlQueryProcessDebugInformation = function(ProcessId,
DebugInfoClassMask: Cardinal; var DebugBuffer: TDebugBuffer): Integer;
stdcall;
TFNRtlDestroyQueryDebugBuffer = function(DebugBuffer: PDebugBuffer): Integer;
stdcall;
var
RtlCreateQueryDebugBuffer: TFNRtlCreateQueryDebugBuffer;
RtlQueryProcessDebugInformation: TFNRtlQueryProcessDebugInformation;
RtlDestroyQueryDebugBuffer: TFNRtlDestroyQueryDebugBuffer;
function LoadRtlQueryDebug: LongBool;
begin
if HNtDll = 0 then
begin
HNtDll := LoadLibrary(ntdll);
if HNtDll <> 0 then
begin
RtlCreateQueryDebugBuffer := GetProcAddress(HNtDll, 'RtlCreateQueryDebugBuffer');
RtlQueryProcessDebugInformation := GetProcAddress(HNtDll,
'RtlQueryProcessDebugInformation');
RtlDestroyQueryDebugBuffer := GetProcAddress(HNtDll,
'RtlDestroyQueryDebugBuffer');
end;
end;
Result := Assigned(RtlCreateQueryDebugBuffer) and
Assigned(RtlQueryProcessDebugInformation) and
Assigned(RtlQueryProcessDebugInformation);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
DbgBuffer: PDebugBuffer;
Loop: Integer;
begin
if not LoadRtlQueryDebug then Exit;
Memo1.Clear;
Memo1.Lines.BeginUpdate;
DbgBuffer := RtlCreateQueryDebugBuffer(0, False);
if Assigned(DbgBuffer) then
try
if RtlQueryProcessDebugInformation(StrToIntDef(Edit1.Text, GetCurrentProcessId),
PDI_MODULES, DbgBuffer^) >= 0 then
begin
for Loop := 0 to DbgBuffer.ModuleInformation.Count - 1 do
with DbgBuffer.ModuleInformation.Modules[Loop], Memo1.Lines do
begin
Add('ImageName: ' + ImageName);
Add(' Reserved0: ' + IntToHex(Reserved[0], 8));
Add(' Reserved1: ' + IntToHex(Reserved[1], 8));
Add(' Base: ' + IntToHex(Base, 8));
Add(' Size: ' + IntToHex(Size, 8));
Add(' Flags: ' + IntToHex(Flags, 8));
Add(' Index: ' + IntToHex(Index, 4));
Add(' Unknown: ' + IntToHex(Unknown, 4));
Add(' LoadCount: ' + IntToHex(LoadCount, 4));
Add(' ModuleNameOffset: ' + IntToHex(ModuleNameOffset, 4));
end;
end;
finally
RtlDestroyQueryDebugBuffer(DbgBuffer);
end;
Memo1.Lines.EndUpdate;
end;