Tuesday, March 01, 2011

An ugly alternative to interface to object casting

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:

Jamie I said...

Hi Barry,

Out of curiosity: which recent versions of Delphi enabled the cast behaviour with "as"?

Barry Kelly said...

Delphi 2010, I believe.

Anonymous said...

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

Barry Kelly said...

Yes.

Sergey Antonov aka oxffff said...

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.

Unknown said...

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

Rudy Velthuis said...

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;

Anonymous said...

How can I notify Embarcadero of a source code leak?

http://delphihaters.blogspot.com/2011/05/tpc-source-code-leak.html

Barry Kelly said...

Anonymous - I wouldn't fear, several EMBT people follow DHB.

Anonymous said...

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 ?

Anonymous said...

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 ?