Category: System Information
Title: Get process informations? (Windows NT/2000)
Date added: 15.03.2006
Hits: 3767


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;

1. How to get the current drive letter? (2603 Hits)

2. How to retrieve CPU information? (11011 Hits)

3. How to get info on memory usage from a given process? (4400 Hits)

4. How to get the drive type? (2816 Hits)

5. How to get a list of installed services? (2840 Hits)

For any problems or recommendations about Delphi Tricks site, please

feel free to contact us on that e-mail: support@delphitricks.com.
If you want to advertise on the site use that e-mail: advertise@delphitricks.com.

You can freely use or modify these Delphi source codes for non-commercial use. We are not responsible of any damages that can be caused by the utilisation of that source codes.