Question

我试图拦截系统中每个对象的构造/破坏。为此，我使用Detours Lib来创建运行时补丁。它似乎在FastCode方法的某种方式起作用。我认为它应该有相同的限制（无法修补操作码小于5个字节的方法）。但是我选择这个lib的原因是因为它创建了一个指向钩子方法的指针，我可以使用这个指针来调用它。

所以，要做我的补丁，我正在尝试使用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$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

为什么Detours lib不能处理虚拟方法？

1 个答案: