2

I'm trying to intercept the construction/destruction of every object on my system. For this I'm using Detours Lib to create the runtime patch. It seem to work the some way as FastCode approach does. And I think it should have the same limitation (could not patch methods with opcode smaller than 5 bytes). But the reason I choose this lib is because it creates a pointer to the hooked method, and I can call it using this pointer.

So, to do my patches I'm trying to use TObject.NewInstance, and TObject.FreeInstance.

It's all ok with TObject.NewInstance, but when I try to do the same for TObject.FreeInstance, TObject.Free, TObject.BeforeDestruction (in this case I think it is because the limitation I described above), I get access violation.

Here is a code example:

var
  TrampolineGetMemory: function: TObject;
  TrampolineFreeInstance: procedure = nil;

implementation

type
  TObjectHack = class(TObject)
    function NNewInstanceTrace: TObject;
    procedure NFreeInstance;
  end;

procedure TObjectHack.NFreeInstance;
begin
  TrampolineFreeInstance; {ERROR: apparently the jmp does not go to a valid addr}
end;

function TObjectHack.NNewInstanceTrace: TObject;
begin
  Result := TrampolineGetMemory; {everything ok here}
end;

initialization
  @TrampolineGetMemory := InterceptCreate(@TObject.NewInstance, @TObjectHack.NNewInstanceTrace);
  @TrampolineFreeInstance := InterceptCreate(@TObject.FreeInstance, @TObjectHack.NFreeInstance);

finalization
  InterceptRemove(@TrampolineGetMemory);
  InterceptRemove(@TrampolineFreeInstance);

Some one can see something I'm doing wrong ?

Johan
  • 74,508
  • 24
  • 191
  • 319
Rodrigo Farias Rezino
  • 2,687
  • 3
  • 33
  • 60
  • `TrampolineFreeInstance...` should be: `TrampolineFreeInstance: procedure of object = nil;` and I think you should use the vmt hook, because freeinstance is a virtual method, but I'm not 100% sure. – Johan Apr 13 '15 at 15:02
  • @Johan That won't work. That's a two pointer type, and `InterceptCreate` returns a single pointer. – David Heffernan Apr 13 '15 at 15:03

1 Answers1

4

FreeInstance is an instance method rather than a simple procedure. What's more, it is a virtual method, and detouring a virtual method typically involves vtable modification, as I understand it. Simply put, trying to hook FreeInstance is the wrong way to instrument instance destruction.

Instead, make a detour of System._ClassDestroy or TObject.CleanupInstance. An example of the former:

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  DDetours;

var
  TrampolineClassDestroy: procedure(const Instance: TObject);

procedure DetouredClassDestroy(const Instance: TObject);
begin
  // this is called from inside InterceptCreate, hence the test for
  // TrampolineClassDestroy being assigned
  if Assigned(TrampolineClassDestroy) then begin
    TrampolineClassDestroy(Instance);
    Writeln(Instance.ClassName, ' detour installed');
  end else begin
    Writeln(Instance.ClassName, ' detour not yet installed');
  end;
end;

function System_ClassDestroy: Pointer;
asm
  MOV     EAX, offset System.@ClassDestroy
end;

procedure Main;
begin
  TrampolineClassDestroy := InterceptCreate(System_ClassDestroy, @DetouredClassDestroy);
  TObject.Create.Free;
end;

begin
  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Output

TThreadsIDList detour not yet installed
TIntercept detour not yet installed
TObject detour installed
TDictionary detour installed
TObject detour installed
@TList`1.Pack$23$ActRec detour installed
TMoveArrayManager detour installed
TList detour installed
TRegGroup detour installed
TMoveArrayManager detour installed
TList detour installed
TObject detour installed
TThreadList detour installed
TMoveArrayManager detour installed
TList detour installed
TObject detour installed
TThreadList detour installed
TMoveArrayManager detour installed
TObjectList detour installed
TRegGroups detour installed
TOrdinalIStringComparer detour installed
TThreadLocalCounter detour installed
TMultiReadExclusiveWriteSynchronizer detour installed
TComponent.Create@$929$ActRec detour installed
TDelegatedComparer detour installed
TObject detour installed
TObject detour installed
TObject detour installed
EInvalidPointer detour installed
David Heffernan
  • 601,492
  • 42
  • 1,072
  • 1,490
  • Tks once more David, it worked. I'll write it to work together with BoehmGc, and no modifications on code will be needed to GC. – Rodrigo Farias Rezino Apr 13 '15 at 15:44
  • Yes he did. But we need to go to every class creator and destructor to mark and unmark objects to GC. I'm using his wrapper, I just odd this implementation to don't make necessary the mark step. – Rodrigo Farias Rezino Apr 13 '15 at 16:11