...Prozessinformationen auslesen? (Windows NT/2000)

Autor: Michael

Kategorie: System

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

{
  Diese Funktion schreibt alle Informationen über 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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base