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

// 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