![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#5
|
||||
|
||||
![]() Вот решение:
Код:
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 — Как тебя понимать? — Понимать меня не обязательно. Обязательно меня любить и кормить вовремя. На Delphi, увы, больше не программирую. Рекомендуемая литература по программированию |