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

Question

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

假设我有以下界面：

  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 选择离开帕斯卡源以及优化的程序集）。我可能没有正确阅读它，但似乎存在偏移量为零的接口条目，在这种情况下，可以使用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;