Получить сведения о процессе

Delphi , Программа и Интерфейс , Процессы и Сервисы

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

// Der Quellcode wurde von NicoDE (nico@bendlins.de) geschrieben. 

{ 
  Diese Funktion schreibt alle Informationen uber den in Edit1.text angegeneben NT 
  Prozess (ProzessID) in das Feld Memo1. 
}

 { 
  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;

Статья Получить сведения о процессе раздела Программа и Интерфейс Процессы и Сервисы может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Процессы и Сервисы ::