Get the GUID of an interface reference.

[Cyrax]

See http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html

This is my attempt to achieve this goal:

Code: [Select]

function GetGUIDfromInterface(const AInterface : IInterface) : TGUID;
Type
  PInterfaceThunkProc = ^TInterfaceThunkProc;
  TInterfaceThunkProc = packed record
    AInterfaceOffset : Array [0..4] Of byte;
  end;
Var
  AObject : TObject;
  IOffset : PtrUint;
  APVmt : PVmt;
  I : Integer;
  AGUID : TGUID;
  APInterfaceThunkProc : PInterfaceThunkProc;
  AGUIDStr : String;
begin
  APInterfaceThunkProc := Pointer(Pointer(Pointer(AInterface)^)^);
  IOffset := APInterfaceThunkProc^.AInterfaceOffset[4];
  AObject := TObject(Pointer(PtrUint(AInterface) - IOffset));
  APVmt := PVmt(AObject.ClassType);
  For I := 0 To APVmt^.vIntfTable^.EntryCount - 1 Do
    If APVmt^.vIntfTable^.Entries[I].IOffset = IOffset Then Begin
      AGUID := APVmt^.vIntfTable^.Entries[I].IID^;
      AGUIDStr := GUIDToString(AGUID);
      Break;
    end;
end;

With this code, I can successfully acquire address to interface thunk code, get the offset and then get GUID from object's VMT table.

However I would like to get the offset in some more reliable way than hard coding it to one byte type and that means to disassemble some parts of interface thunk code at run time.

Excerpt from disassemly of test program:

Code: [Select]

WRPR_$INTERFACE_TEST_$$_TTEST_$_ITEST_$_0_$_CLASSES$_$TINTERFACEDPERSISTENT_$__$$_QUERYINTERFACE$TGUID$formal$$HRESULT
0042BA00 836c240414               subl   $0x14,0x4(%esp)
0042BA05 8b442404                 mov    0x4(%esp),%eax
0042BA09 8b08                     mov    (%eax),%ecx
0042BA0B ff6178                   jmp    *0x78(%ecx)
0042BA0E 0000                     add    %al,(%eax)

Does FPC come with a unit/package/library which allows to disassemble code in cross platform manner?

[marcov]

Probably some structure in rtl/inc/objpash.inc, like objpas.tinterfaceentry:

Looking at the code of lowlevel OO routines in rtl/inc/objpas.inc could also help