Instances and Interfaces

I found this thread - and therefore a very interesting piece of code. It gets you the "implementing object" from an interface pointer. Here's the function (all credit to Hallvard here):

function GetImplementingObject(const I: IInterface): TObject;

const

  AddByte = $04244483; // opcode : ADD DWORD PTR [ESP+4], 

                       //          Shortint

  AddLong = $04244481; // opcode : ADD DWORD PTR [ESP+4], 

                       //          Longint

type

  PAdjustSelfThunk = ^TAdjustSelfThunk;

  TAdjustSelfThunk = packed record

    case AddInstruction: longint of

      AddByte : (AdjustmentByte: shortint);

      AddLong : (AdjustmentLong: longint);

  end;

  PInterfaceMT = ^TInterfaceMT;

  TInterfaceMT = packed record

    QueryInterfaceThunk: PAdjustSelfThunk;

  end;

  TInterfaceRef = ^PInterfaceMT;

var

  QueryInterfaceThunk: PAdjustSelfThunk;

begin

  Result := Pointer(I);

  if Assigned(Result) then

    try

      QueryInterfaceThunk := 

           TInterfaceRef(I)^.QueryInterfaceThunk;

      case QueryInterfaceThunk.AddInstruction of

        AddByte: Inc(PChar(Result), 

                    QueryInterfaceThunk.AdjustmentByte);

        AddLong: Inc(PChar(Result), 

                    QueryInterfaceThunk.AdjustmentLong);

        else     Result := nil;

      end;

    except

      Result := nil;

    end;

end;

The idea here is that if you have code like this:

  IMyInterface = interface

  [SOMEGUID]

    procedure DoSomething;

  end;



  TMyClass = class( TInterfacedObject, IMyInterface)

  protected

    procedure DoSomething;

  public    

    //note: This proc is not in interface

    procedure DoSomethingElse; 

  end;



...

var 

  MyInterface: IMyInterface;

  MyClass : TMyClass;

begin

  MyInterface := TMyClass.Create;

  MyInterface.DoSomething;



  // This will not work

  TMyClass(MyInterface).DoSomethingElse; // crash boom bang!



  // This is slightly better

  MyClass := TMyClass(GetImplementingObject(MyInterface));

  MyClass.DoSomethingElse;

end;

Now this may or may not work in future versions of Delphi, but this is the only option if you can't modify the code of the interface or the implementation. If you can, here's a better option:

  IMyInterface = interface

  [SOMEGUID]

    procedure DoSomething;

  end;



  TMyClass = class;



  IMyClassAccess = interface

  [SOMEGUID2]

    function GetMyClass : TMyClass;

  end;



  TMyClass = class( TInterfacedObject, IMyInterface, 

                    IMyClassAccess)

  protected

    procedure DoSomething;

    function GetMyClass : TMyClass ; // Result := Self;

  public    

    // note: This proc is not in interface

    procedure DoSomethingElse; 

  end;



var 

  MyInterface: IMyInterface;

  MyClass : TMyClass;

  obj : IMyClassAccess;

begin

  MyInterface := TMyClass.Create;

  MyInterface.DoSomething;



  // This is slightly better

  MyInterface.QueryInterface( SOMEGUID2, Obj);

  MyClass := Obj.GetMyClass;

  MyClass.DoSomethingElse;

end;

Better option, but requires you to modify the implementation class. All thanks to Hallvard...