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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: 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;

{/codecitation}

Добавить комментарий