In Delphi is it possible to bind an interface to an object that doesn't implement it

Question

I know Delphi XE2 has the new TVirtualInterface for creating implementations of an interface at runtime. Unfortunately I am not using XE2 and I'm wondering what kind of hackery is involved in doing this sort of thing in older versions of Delphi.

Lets say I have the following interface:

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

Is it possible to bind to this interface at runtime without the help of the compiler?

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;

I've tried a simple hard cast:

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

but the compiler prevents this.

Then I tried an as cast and it at least compiled:

MyInterface := TMyClass.Create as IMyInterface;

So I imagine the key is to get QueryInterface to return a valid pointer to an Implementation of the interface being queried. How would I go about constructing one at runtime?

I've dug through System.pas so I'm at least vaguely familiar with how GetInterface, GetInterfaceEntry and InvokeImplGetter work. (thankfully Embacadero chose to leave the pascal source along with the optimized assembly). I may not be reading it right but it appears that there can be interface entries with an offset of zero in which case there is an alternative means of assigning the interface using InvokeImplGetter.

My ultimate goal is to simulate some of the abilities of dynamic proxies and mocks that are available in languages with reflection support. If I can successfully bind to an object that has the same method names and signatures as the interface it would be a big first step. Is this even possible or am I barking up the wrong tree?

Answer 1

Adding support for an interface to an existing class at runtime can theoretically be done, but it would be really tricky, and it would require D2010 or later for RTTI support.

Each class has a VMT, and the VMT has an interface table pointer. (See the implementation of TObject.GetInterfaceTable.) The interface table contains interface entries, which contain some metadata, including the GUID, and a pointer to the interface vtable itself. If you really wanted to, you could create a copy of the interface table, (DO NOT do this the original one; you're likely to end up corrupting memory!) add a new entry to it containing a new interface vtable with the pointers pointing to the correct methods, (which you could match by looking them up with RTTI,) and then change the class's interface table pointer to point to the new table.

Be very careful. This sort of work is really not for the faint of heart, and it seems to me it's of kind of limited utility. But yes, it's possible.

Answer 2

I'm not sure, what you want to accomplish and why you want to dynamically bind that interface, but here is a way to do it (don't know if it fits your need):

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;

And this is the corresponding test code:

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;