Question

我知道Delphi XE2有新的TVirtualInterface，用于在运行时创建接口的实现。不幸的是我没有使用XE2，我想知道在旧版本的Delphi中做这种事情会涉及到什么样的hackery。

假设我有以下界面：

  IMyInterface = interface
  ['{8A827997-0058-4756-B02D-8DCDD32B7607}']
    procedure Go;
  end;

是否可以在没有编译器帮助的情况下在运行时绑定到此接口？

TMyClass = class(TObject, IInterface)
public
  function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; stdcall;
  procedure Go; //I want to dynamically bind IMyInterface.Go here
end;

我尝试了一个简单的强硬演员：

var MyInterface: IMyInterface;
begin
  MyInterface := IMyInterface(TMyClass.Create);
end;

但编译器阻止了这一点。

然后我尝试了as强制转换，至少编译了：

MyInterface := TMyClass.Create as IMyInterface;

所以我想，关键是让QueryInterface返回一个指向正在查询的接口的实现的有效指针。我如何在运行时构建一个？

我已经通过System.pas进行了挖掘，因此我至少对GetInterface，GetInterfaceEntry和InvokeImplGetter的工作方式非常熟悉。（幸运的是，Embacadero选择将pascal源与优化的组件一起留下）。我可能没有正确读取它，但似乎可以有偏移量为零的接口条目，在这种情况下，有一种使用InvokeImplGetter分配接口的替代方法。

我的最终目标是模拟具有反射支持的语言中可用的动态代理和模拟的一些功能。如果我可以成功绑定到具有与接口相同的方法名称和签名的对象，那么这将是一个很大的第一步。这甚至可能还是我在错误的树上咆哮？

Answer 1

理论上可以在运行时添加对现有类的接口的支持，但这将非常棘手，并且需要D2010或更高版本才能支持RTTI。

每个类都有一个VMT，而VMT有一个接口表指针。（请参阅TObject.GetInterfaceTable的实现。）接口表包含接口条目，其中包含一些元数据，包括GUID和指向接口vtable本身的指针。如果你真的想要，你可以创建一个接口表的副本，（不要这样做原来的;你可能最终破坏内存！）添加一个新的条目包含一个新的接口vtable与指针指向正确的方法（通过RTTI查找它们可以匹配），然后将类的接口表指针更改为指向新表。

要非常小心。这种工作真的不适合胆小的人，而且在我看来它的实用性有限。但是，是的，这是可能的。

Answer 2

我不确定，您想要完成什么以及为什么要动态绑定该接口，但这是一种方法（不知道它是否符合您的需要）：

type
  IMyInterface = interface
  ['{8A827997-0058-4756-B02D-8DCDD32B7607}']
    procedure Go;
  end;

  TMyClass = class(TInterfacedObject, IInterface)
  private
    FEnabled: Boolean;
  protected
    property Enabled: Boolean read FEnabled;
  public
    constructor Create(AEnabled: Boolean);
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    procedure Go; //I want to dynamically bind IMyInterface.Go here
  end;

  TMyInterfaceWrapper = class(TAggregatedObject, IMyInterface)
  private
    FMyClass: TMyClass;
  protected
    property MyClass: TMyClass read FMyClass implements IMyInterface;
  public
    constructor Create(AMyClass: TMyClass);
  end;

constructor TMyInterfaceWrapper.Create(AMyClass: TMyClass);
begin
  inherited Create(AMyClass);
  FMyClass := AMyClass;
end;

constructor TMyClass.Create(AEnabled: Boolean);
begin
  inherited Create;
  FEnabled := AEnabled;
end;

procedure TMyClass.Go;
begin
  ShowMessage('Go');
end;

function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if Enabled and (IID = IMyInterface) then begin
    IMyInterface(obj) := TMyInterfaceWrapper.Create(Self);
    result := 0;
  end
  else begin
    if GetInterface(IID, Obj) then
      Result := 0
    else
      Result := E_NOINTERFACE;
  end;
end;

这是相应的测试代码：

var
  intf: IInterface;
  my: IMyInterface;
begin
  intf := TMyClass.Create(false);
  if Supports(intf, IMyInterface, my) then
    ShowMessage('wrong');

  intf := TMyClass.Create(true);
  if Supports(intf, IMyInterface, my) then
    my.Go;
end;

在Delphi中，可以将接口绑定到不实现它的对象

2 个答案: