Sunday, June 04, 2006

Simple Interface RTTI

Delphi supports getting RTTI for all interfaces, but it does not include method information for “normal” interfaces.

type
{$M-}
IMyMMInterface = interface
procedure Foo;
end;

By using the built-in TypeInfo function on the interface type, we get a pointer to the RTTI structure the compiler has generated for it, a pointer to a TTypeInfo record. This record is defined in the TypInfo unit and looks like this:

  PPTypeInfo = ^PTypeInfo;
PTypeInfo = ^TTypeInfo;
TTypeInfo = record
Kind: TTypeKind;
Name: ShortString;
{TypeData: TTypeData}
end;

Just following the TTypeInfo record in memory is another variable-length variant record that contains different fields and information depending on the value of the Kind field above. The supported type kinds are defined like this:


type
TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);

For interfaces, we’re only interested in the tkInterface kind. The part of the TTypeData record that encodes the RTTI for normal interfaces look like this:

type
TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
TIntfFlagsBase = set of TIntfFlag;
// …
PTypeData = ^TTypeData;
TTypeData = packed record
case TTypeKind of
// …
tkInterface: (
IntfParent : PPTypeInfo; { ancestor }
IntfFlags : TIntfFlagsBase;
Guid : TGUID;
IntfUnit : ShortStringBase;
{PropData: TPropData});
// …
end;

From this we can se that we have access to the following type information for any interface:



  • A pointer to the parent interface (IntfParent)

  • Flags indicating if this interface has a GUID, if it is a dispintf interface and if it is a IDispatch interface (IntfFlags)

  • The GUID of the interface (if it has one) (Guid)

  • The unit the interface was declared in (IntfUnit)

  • The number of methods in the interface (PropData.Count)
We can write a simple function that dumps this information for a given interface.
type  
PExtraInterfaceData = ^TExtraInterfaceData;
TExtraInterfaceData = packed record
MethodCount: Word; { # methods }
end;

function SkipPackedShortString(Value: PShortstring): pointer;
begin
Result := Value;
Inc(PChar(Result), SizeOf(Value^[0]) + Length(Value^));
end;

procedure DumpSimpleInterface(InterfaceTypeInfo: PTypeInfo);
var
TypeData: PTypeData;
ExtraData: PExtraInterfaceData;
i: integer;
begin
Assert(Assigned(InterfaceTypeInfo));
Assert(InterfaceTypeInfo.Kind = tkInterface);
TypeData := GetTypeData(InterfaceTypeInfo);
ExtraData := SkipPackedShortString(@TypeData.IntfUnit);
writeln('unit ', TypeData.IntfUnit, ';');
writeln('type');
write(' ', InterfaceTypeInfo.Name, ' = ');
if not (ifDispInterface in TypeData.IntfFlags) then
begin
write('interface');
if Assigned(TypeData.IntfParent) then
write(' (', TypeData.IntfParent^.Name, ')');
writeln;
end
else
writeln('dispinterface');
if ifHasGuid in TypeData.IntfFlags then
writeln(' [''', GuidToString(TypeData.Guid), ''']');
for i := 1 to ExtraData.MethodCount do
writeln(' procedure UnknownName',i,';');
writeln(' end;');
writeln;
end;

The function expects a pointer to the type information of an interface. It digs out the generated interface RTTI and tries to write a pseudo interface type declaration inside a unit using the information available. It only knows the number of methods in the interface, so it just outputs some dummy names for them.

To test this we can define some plain vanilla ($M-} interfaces and then use the TypeInfo intrinsic function to get a RTTI pointer for each interface to send to the dumping function above.

program TestSimpleInterfaceRTTI;

{$APPTYPE CONSOLE}

uses
SysUtils,
TypInfo;

// ... Insert the code above here

type
{$M-}
IMyInterface = interface
procedure Foo(A: integer);
procedure Bar(const B: string);
procedure Nada(const C: array of integer; D: TObject);
end;
IMyDispatchInterface = interface(IDispatch)
['{9BC5459B-6C31-4F5B-B733-DCA8FC8C1345}']
procedure Foo; dispid 0;
end;
IMyDispInterface = dispinterface
['{8574E276-4671-49AC-B775-B299E6EF01C5}']
procedure Bar;
end;

begin
DumpSimpleInterface(TypeInfo(IMyInterface));
DumpSimpleInterface(TypeInfo(IMyDispatchInterface));
DumpSimpleInterface(TypeInfo(IMyDispInterface));
readln;
end.

Running this project produces the following output:

unit TestSimpleInterfaceRTTI;
type
IMyInterface = interface (IInterface)
procedure UnknownName1;
procedure UnknownName2;
procedure UnknownName3;
end;

unit TestSimpleInterfaceRTTI;
type
IMyDispatchInterface = interface (IDispatch)
['{9BC5459B-6C31-4F5B-B733-DCA8FC8C1345}']
procedure UnknownName1;
end;

unit TestSimpleInterfaceRTTI;
type
IMyDispInterface = dispinterface
['{8574E276-4671-49AC-B775-B299E6EF01C5}']
procedure UnknownName1;
end;

We are able to pick up the name of the unit (or program as it is in this case) the interface is declared in, the name of the interface and its parent interface and the GUID if it has one. We can also distinguish dispinterfaces that is used in the implementation of Automation servers (for dual interfaces that inherit from IDispatch).

As you can see we are missing the proper names of the interface methods and we don’t have any information about the parameters, return types or calling conventions. Compiling interfaces in the $M+ mode (or inheriting from IInvokable) changes all that – as we shall see in an upcoming article.

3 comments:

Anonymous said...

What about mulitple inheritance of interfaces ?

Anonymous said...

Can this be done with out using pointers ?If so how can it be done?

Anonymous said...

Hi Hallvard, great article. I'm trying to do some interface RTTI which I still cant see how to do. I have a routine:

function MyFindFirstInterface( AInterface : TGuid ) : TObject;
etc

This iterates through one my collections of classes until it finds a matching class, returning it. So far so simple. If it is not found, I'd like raise an exception with the interface name, thus I need to get from the GUID to its name. I can see how to do this if I have a class supporting it, but what if there are no classes supporting the interface? I can get TypeInfo to get me from a fixed GUID to the name, but how to get it from a passed parameter? Any ideas? Thanks. Brian.



Copyright © 2004-2007 by Hallvard Vassbotn