Get the GUID of an interface reference in Delphi

Question

I would like to get information of an interface reference.

The IDE can display for example 'TMyObject($5864933A) as IMyInterface' when I move the mouse over an interface reference while debugging and I would like to print out something similar of my references (which seem to go haywire).

So, basically, I would like to call

type
  IMyInterface = interface
    ['{ABDA7685-DB67-43C1-947F-4B9535142355}']
  end;
  TMyObject = class(TInterfacedObject, IMyInterface)
  end;  
var
  T: PTypeInfo;
  I: IMyInterface;
begin
  I := TMyObject.Create;
  T := TypeInfo(I);
  ...

and use the TypeInfo to find out more about the interface type.

In real world, 'I' would be just any interface pointer. Since TypeInfo requires a type and not an instance, this is not possible.

So, I tried to use the old hack by Hallvard as described at http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html

That would give me the IID, which I could then use to fetch more information. However, while running the code in Delphi 10.2, it doesn't seem to work any more.

First problem I encountered is that when I call the following method:

function GetInterfaceIID(const I: IInterface; var IID: TGUID): boolean;
var
  InterfaceEntry: PInterfaceEntry;
begin
  InterfaceEntry := GetInterfaceEntry(I);
  Result := Assigned(InterfaceEntry);
  if Result then
    IID := InterfaceEntry.IID;
end;

the reference 'I' is always 'IInterface' no matter with which variable I call the method.

Second, the test application

var
  MyInterface: IMyInterface;
  Unknown: IUnknown;
  Instance: TObject;
  IID: TGUID;
begin
  MyInterface := TMyObject.Create;
  // Instance := GetImplementingObject(MyInterface); // not necessary since D2010
  // Writeln(Instance.ClassName);
  if GetInterfaceIID(MyInterface, IID) then // Results in Access Violation
    writeln('MyInterface IID = ', GUIDToString(IID));

  ...

gives me an access violations.

Apparently, the details of the class and interface internals have changed since 2006.

So could anyone provide a working version of that code or some other means to get out information about the interface reference?

E: Clarified the target and what fails

FYI, since D2010, you don't need the old GetImplementingObject() hack anymore, an IInterface can be type-casted directly to its implementing TObject, eg: Writeln((MyInterface as TObject).ClassName); — Remy Lebeau
You give a lot of information on what you did to accomplish ‘something’. But what are you exactly trying to accomplish, because that’s not clear... Your title suggests you want the GUID of an interface, but the code at the end suggests you want the object reference of the interface... — R. Hoek
@R.Hoek I would like to debug as much about the interface reference that I can get, mostly the interface type - and the instance implementing it, if possible. So TypeInfo(I) that I mentioned first was the main target. I figured I need the GUID after all, following Hallvard's example, but since his example failed, I wasn't sure what is the correct approach. — Jouni Aro

Jouni Aro Jouni Aro · Accepted Answer · 2021-01-29T10:11:45

OK, I managed to put it together, including the method I was searching for:

function InterfaceTypeInfo(const Intf: IInterface): PTypeInfo;

The following is a complete test program, including the routines

program TestInterfaceTypeInfo;

{$APPTYPE CONSOLE}

{$IF CompilerVersion >= 20.0}
// Requires TDictionary, which was introduced in Delphi 2009
{$DEFINE INTF_TYPEINFO_CACHE}
{$IFEND}

uses
  SysUtils,
  TypInfo,
  Rtti,
{$IFDEF INTF_TYPEINFO_CACHE}
  System.Generics.Collections,
{$ENDIF}
  Classes;

// *** A set of routines to help finding the TypeInfo for an interface reference

// The following functionality is slightly modified version of
// http://hallvards.blogspot.com/2006/09/hack11-get-guid-of-interface-reference.html

{$IFDEF INTF_TYPEINFO_CACHE}
var
  // Optimized mapping of TGUID to TypeInfo
  IntfTypeInfoCache: TDictionary<TGUID, PTypeInfo> = nil;
{$ENDIF}

function GetPIMTOffset(const I: IInterface): integer;
// PIMT = Pointer to Interface Method Table
const
  AddByte = $04244483; // opcode for ADD DWORD PTR [ESP+4], Shortint
  AddLong = $04244481; // opcode for 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 := -1;
  if Assigned(Pointer(I)) then
    try
      QueryInterfaceThunk := TInterfaceRef(I)^.QueryInterfaceThunk;
      case QueryInterfaceThunk.AddInstruction of
        AddByte: Result := -QueryInterfaceThunk.AdjustmentByte;
        AddLong: Result := -QueryInterfaceThunk.AdjustmentLong;
      end;
    except
      // Protect against non-Delphi or invalid interface references
    end;
end;

{$IF CompilerVersion < 21.0}
function GetImplementingObject(const I: IInterface): TObject;
var
  Offset: integer;
begin
  Offset := GetPIMTOffset(I);
  if Offset > 0
  then Result := TObject(PChar(I) - Offset)
  else Result := nil;
end;
{$IFEND}

function GetInterfaceEntry(const I: IInterface): PInterfaceEntry;
var
  Offset: integer;
  Instance: TObject;
  InterfaceTable: PInterfaceTable;
  j: integer;
  CurrentClass: TClass;
begin
  Offset := GetPIMTOffset(I);
  Instance :=
{$IF CompilerVersion >= 21.0}
    I as TObject;
{$ELSE}
    GetImplementingObject(I);
{$IFEND}
  if (Offset >= 0) and Assigned(Instance) then
  begin
    CurrentClass := Instance.ClassType;
    while Assigned(CurrentClass) do
    begin
      InterfaceTable := CurrentClass.GetInterfaceTable;
      if Assigned(InterfaceTable) then
        for j := 0 to InterfaceTable.EntryCount-1 do
        begin
          Result := @InterfaceTable.Entries[j];
          if Result.IOffset = Offset then
            Exit;
        end;
      CurrentClass := CurrentClass.ClassParent
    end;
  end;
  Result := nil;
end;

// Finds the IID of an interface
function GetInterfaceIID(const I: IInterface; var IID: TGUID): Boolean;
var
  InterfaceEntry: PInterfaceEntry;
begin
  InterfaceEntry := GetInterfaceEntry(I);
  Result := Assigned(InterfaceEntry);
  if Result then
    IID := InterfaceEntry.IID;
end;

// Finds the TypeInfo corresponding to IID of an interface
function InterfaceTypeInfoOfGUID(const IID: TGUID): PTypeInfo;
var
  Context : TRttiContext;
  ItemType : TRttiType;
  T: TRttiInterfaceType;
begin
  Result := nil;
{$IFDEF INTF_TYPEINFO_CACHE}
  if not Assigned(IntfTypeInfoCache) then
  begin
    IntfTypeInfoCache := TDictionary<TGUID, PTypeInfo>.Create;
{$ENDIF}
    for ItemType in Context.GetTypes do
    begin
      if ItemType is TRttiInterfaceType then
      begin
       T := TRttiInterfaceType(ItemType);
       if T.GUID = IID then
{$IFDEF INTF_TYPEINFO_CACHE}
         Result := T.Handle;
       IntfTypeInfoCache.AddOrSetValue(T.GUID, T.Handle);
{$ELSE}
         Exit(T.Handle);
{$ENDIF}
      end
    end;
{$IFDEF INTF_TYPEINFO_CACHE}
  end;
  if not Assigned(Result) then
    IntfTypeInfoCache.TryGetValue(IID, Result);
{$ENDIF}
end;

// Finds the TypeInfo for an interface reference
function InterfaceTypeInfo(const Intf: IInterface): PTypeInfo;
var
  IID: TGUID;
begin
  if GetInterfaceIID(Intf, IID) then
    Result := InterfaceTypeInfoOfGUID(IID)
  else
    Result := nil;
end;

// Test with an interface that is globally defined, such as
// IInterfaceComponentReference

var
  MyInterface: IInterfaceComponentReference;
  Unknown: IUnknown;
  Instance: TObject;
  IID: TGUID;
  T: PTypeInfo;
begin
  MyInterface := TComponent.Create(nil);
  if GetInterfaceIID(MyInterface, IID) then
    writeln('MyInterface IID = ', GUIDToString(IID));
  Unknown := MyInterface;
  if GetInterfaceIID(Unknown, IID) then
    writeln('Derived IUnknown IID = ', GUIDToString(IID));
  Unknown := TComponent.Create(nil);
  if GetInterfaceIID(Unknown, IID) then
    writeln('Pure IUnknown IID = ', GUIDToString(IID));
  T := InterfaceTypeInfo(MyInterface);
  if Assigned(T) then
  begin
    writeln('TypeInfo = ', T.Name, GUIDToString(T.TypeData.GUID));
    writeln(Format('%s($%x) as %s',
      // will also need to use GetImplementingObject instead of 'as' prior to Delphi 2010
      [(MyInterface as TObject).ClassName, NativeInt(MyInterface), T.Name])); 
  end;
  readln;
{$IFDEF INTF_TYPEINFO_CACHE}
  IntfTypeInfoCache.Free;
{$ENDIF}
end.

which prints out

MyInterface IID = {E28B1858-EC86-4559-8FCD-6B4F824151ED}
Derived IUnknown IID = {E28B1858-EC86-4559-8FCD-6B4F824151ED}
Pure IUnknown IID = {00000000-0000-0000-C000-000000000046}
TypeInfo = IInterfaceComponentReference{E28B1858-EC86-4559-8FCD-6B4F824151ED}
TComponent($20067E8) as IInterfaceComponentReference

E: Introduced IntfTypeInfoCache to optimize the search.

E: NativeInt(MyInterface), instead of Integer(MyInterface) in test code

Get the GUID of an interface reference in Delphi

1 Answers