05.07.2012, 10:37
|
|
Sir Richard Abramson
|
|
Регистрация: 05.04.2008
Сообщения: 5,505
Версия Delphi: XE10
Репутация: выкл
|
|
Вот решение:
Код:
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
Form1: TForm1;
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;
implementation
{$R *.dfm}
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;
function getProcessModule(pid : cardinal):String;
var
DbgBuffer: PDebugBuffer;
Loop: Integer;
s:string;
begin
Result:='';
if not LoadRtlQueryDebug then Exit;
DbgBuffer := RtlCreateQueryDebugBuffer(0, false);
if Assigned(DbgBuffer) then
try
if RtlQueryProcessDebugInformation(pid, PDI_MODULES, DbgBuffer^) >= 0 then
begin
for Loop := 0 to DbgBuffer.ModuleInformation.Count - 1 do
S:=S+#13#10+DbgBuffer.ModuleInformation.Modules[Loop].ImageName;
Result:=S;
end;
finally
RtlDestroyQueryDebugBuffer(DbgBuffer);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text:=getProcessModule(GetCurrentProcessId);
end;
Интересно работает, заставляет процесс подгрузить все модули без сигнализирования события отладчику.
Решение сперто отсюда: http://forum.sources.ru/index.php?showtopic=324532
|