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;