I was answering a question on Stack Overflow, but the user didn't have the latest version of Delphi. My answer included converting an interface to an object instance, which is made possible with the as cast on interfaces in recent Delphi versions. But there is another way of doing it, exploiting the regularity Delphi interface vtable implementations:
{$apptype console} function Intf2Obj(x: IInterface): TObject; type TStub = array[0..3] of Byte; const // ADD [ESP+$04], imm8; [ESP+$04] in stdcall is Self argument, after return address add_esp_04_imm8: TStub = ($83, $44, $24, $04); // ADD [ESP+$04], imm32 add_esp_04_imm32: TStub = ($81, $44, $24, $04); function Match(L, R: PByte): Boolean; var i: Integer; begin for i := 0 to SizeOf(TStub) - 1 do if L[i] <> R[i] then Exit(False); Result := True; end; var p: PByte; begin p := PPointer(x)^; // get to vtable p := PPointer(p)^; // load stub address from vtable if Match(p, @add_esp_04_imm8) then begin Inc(p, SizeOf(TStub)); Result := TObject(PByte(Pointer(x)) + PShortint(p)^); end else if Match(p, @add_esp_04_imm32) then begin Inc(p, SizeOf(TStub)); Result := TObject(PByte(Pointer(x)) + PLongint(p)^); end else raise Exception.Create('Not a Delphi interface implementation?'); end; type ITest = interface procedure P; end; TTest = class(TInterfacedObject, ITest) F: array[0..200] of Byte; procedure P; end; procedure TTest.P; begin Writeln('Hello'); end; procedure Go; var orig: TTest; i: ITest; o: TObject; begin orig := TTest.Create; i := orig; i.P; o := Intf2Obj(i); Writeln(o = orig); end; begin Go; end.
This approach is predicated on the idea that the stub code that Delphi produces for turning the implicit interface argument into an instance argument is predictable. It generally only has two forms, depending on how much of an adjustment it needs to make (which itself depends on how much instance data there is). It ought to work for almost all 32-bit Delphi interfaces that have been implemented by instances, where the vtable was created by the compiler. If not, other stub variations can be analyzed (in the IDE CPU view) and handled too. It ought to be pretty safe, as only this specific code is permitted. It could be made even safer by ensuring that the stub ends with a JMP and that the instance returned has a ClassType descending from TClass.
Update: After a Google search I note that Hallvard also wrote about this some time ago. His code is a little tighter than mine (using Integer constants rather than byte-by-byte comparison); in my defense, I only spent a few minutes on this...
11 comments:
Hi Barry,
Out of curiosity: which recent versions of Delphi enabled the cast behaviour with "as"?
Delphi 2010, I believe.
Barry, does the "is" operator also work for this? i.e. can I do this?
var iObj: IInterface;
...
if IObj is TObject then with IObj as TObject
Yes.
Hi Barry,
So an other idea.
For ensuring safety you may use a ability of yours :) (Delphi) Memory Manager.
Just check the interface reference for to be in MM allocated range.
So if in range the the first byte of allocated block is the the object instance. Of course this true for normally allocated objects via standart Newintance.
:)
As for other much rarely case for example in the case of overrided Newintance may be checking the stub signature is the best way.
Sergey.
Don't you love the first hit on the http://www.google.com/search?q=delphi+interface+to+object search ;-)
The cool thing is that the research that Hallvard Vassbotn did in 2004 shows how stable the interface implementation has been over the years.
But I do like the way that 'is' and 'as' now just 'work'.
--jeroen
In the component installer, which is now part of the XE IDE, I did it this way (sorry for the lack of indentation, but I found no way to format source code in comments):
TStub = packed record
case Byte of
0: (LongAdd: Byte; // Must be $05
LongOffset: Integer);
1: (ShortAdd: Word; // Must be $C083
ShortOffset: Shortint);
end;
PStub = ^TStub;
...
var
Stub: PStub;
Configs: IOTAProjectOptionsConfigurations;
...
begin
...
Stub := PPInterface(Configs)^^.Method;
if Stub^.LongAdd = $05 then
Offset := Stub^.LongOffset
else if Stub^.ShortAdd = $C083 then
Offset := Stub^.ShortOffset
else
begin
MessageDlg(SProjectOptionsNotFound, mtError, [mbOK], 0);
Exit;
end;
How can I notify Embarcadero of a source code leak?
http://delphihaters.blogspot.com/2011/05/tpc-source-code-leak.html
Anonymous - I wouldn't fear, several EMBT people follow DHB.
I tried this code but it cannot was compiled in my machine.
Array type required error in the line below :
if L[i] <> R[i] then
How do I fix it ?
I tried this code but it cannot was compiled in my machine.
Array type required error in the line below :
if L[i] <> R[i] then
How do I fix it ?
Post a Comment