Tuesday, June 08, 2004

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...

3 Comments:

Blogger Hallvard Vassbotn said...

Hehe, that's funny! I had actually started a blog post about this hack, then realized it was getting too long and decided to turn it into a The Delphi Magazine article instead. It will probably turn up in the September issue.

(and for the record; I don't mind that you posted the hack in your blog first:)).

12:12 AM  
Blogger Deepak Shenoy said...

Hey Hallvard, Cool - I don't get TDM here, but they seem to have an online subscription which I can check out. Will look forward to your article!

1:00 AM  
Blogger Hallvard Vassbotn said...

Update: the article will be in the October TDM issue...

12:45 AM  

Post a Comment

<< Home