为什么 Detours lib 不适用于虚拟方法？

Question

我正在尝试拦截我系统上每个对象的 construction/destruction。为此，我使用 Detours Lib to create the runtime patch. It seem to work the some way as FastCode 方法。而且我认为它应该具有相同的限制（无法修补操作码小于 5 字节的方法）。但是我选择这个库的原因是因为它创建了一个指向钩子方法的指针，我可以使用这个指针来调用它。

所以，为了制作我的补丁，我尝试使用 TObject.NewInstance 和 TObject.FreeInstance。

TObject.NewInstance 没问题，但是当我尝试对 TObject.FreeInstance、TObject.Free、TObject.BeforeDestruction 做同样的事情时（在这种情况下，我认为这是因为我上面描述的限制），我遇到了访问冲突。

这是一个代码示例：

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);

有人能看出我做错了什么吗？

Answer 1

FreeInstance 是一个实例方法而不是一个简单的过程。更何况它是一个虚方法，绕过虚方法通常会涉及修改vtable，据我了解。简而言之，尝试挂钩 FreeInstance 是检测实例销毁的错误方法。

相反，绕过System._ClassDestroy或TObject.CleanupInstance。前者的例子：

{$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.

输出

TThreadsIDList detour not yet installed
TIntercept detour not yet installed
TObject detour installed
TDictionary detour installed
TObject detour installed
@TList`1.Pack$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@9$ActRec detour installed
TDelegatedComparer detour installed
TObject detour installed
TObject detour installed
TObject detour installed
EInvalidPointer detour installed

为什么 Detours lib 不适用于虚拟方法？

Why is Detours lib not working on virtual methods?

delphi

hook

detours