Mega Code Archive
Get process informations [windows nt-2000]
<![CDATA[
// 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;
]]>