Кому интересно накидал код, выводит имена создаваемых классов.
<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
type
PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
EXCEPTION_POINTERS = packed record
ExceptionRecord :^EXCEPTION_RECORD;
ContextRecord :PCONTEXT;
end;
function AddVectoredExceptionHandler(FirstHandler:ULONG; VectoredHandler:Pointer):pointer;stdcall; external 'kernel32.dll';
var
Ref:integer = 0;
function OnAfterConstruction(obj:TObject): TObject;
begin
if ( Ref = 0 ) then
begin
Inc(Ref);
obj.AfterConstruction;
ShowMessage(obj.ClassName);
Dec(Ref);
end;
result:=obj;
end;
FUNCTION VectoredHandler( ExceptionInfo:PEXCEPTION_POINTERS):ULONG;stdcall;
var
p:Pointer;
begin
Result:=0;
if ( ExceptionInfo^.ExceptionRecord^.ExceptionCode = EXCEPTION_SINGLE_STEP ) then
begin
p :=PWORD( ExceptionInfo^.ContextRecord^.Eip);
if ( PBYTE(PChar(p)-1)^ = $F1) and ( PBYTE(PChar(p))^ = $C3) then
begin
ExceptionInfo^.ContextRecord^.Eip := Cardinal(@OnAfterConstruction);
result:=$ffffffff;
end;
end;
end;
var
ptr:pointer;
Attr:Cardinal;
ObjRef:TObjectRef;
begin
FindTypeInfoObject( pointer($401000),ObjRef );
ptr:= GetVMTItem(ObjRef.VMT,MetodAfterConstruction);
AddVectoredExceptionHandler(1,@VectoredHandler);
VirtualProtect(ptr,sizeof(ptr),PAGE_EXECUTE_READWRITE,@Attr);
PWord(ptr)^ := $C3F1;
VirtualProtect(ptr,sizeof(ptr),Attr,@Attr);
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Projects.rar (, : 252)
Добавлено
Версия однопоточная, для нескольких потоков нужно юзать TLS для переменной Ref.
Работает для 7 версии дельфи.
При запущенном отладчике дельфи работать не будет.