Показать сообщение отдельно
  #5  
Старый 05.07.2012, 10:37
Аватар для M.A.D.M.A.N.
M.A.D.M.A.N. M.A.D.M.A.N. вне форума
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
__________________
— Как тебя понимать?
— Понимать меня не обязательно. Обязательно меня любить и кормить вовремя.


На Delphi, увы, больше не программирую.
Рекомендуемая литература по программированию