Простая RTTI информация интерфейсов

Это перевод Simple Interface RTTI. Автор: Hallvard Vassbotn.

Delphi поддерживает получение RTTI информации для всех интерфейсов, но она не включает (не генерирует) информацию о методах для "нормальных" интерфейсов:

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

Используя встроенную функцию TypeInfo на типе-интерфейсе, мы можем получить указатель на RTTI-структуры, сгенерированные компилятором для интерфейса: указатель на запись TTypeInfo. Она объявлена в модуле TypInfo и выглядит так:

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

Запись TTypeInfo является очередной записью переменного размера с варьирующимся содержанием, которое зависит от значения поля Kind. Поддерживаемыми "видами" являются (прим.пер.: этот список расширен в последних версиях Delphi - см. модуль TypInfo):

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

Для интерфейсов нам интересно только значение tkInterface. Часть записи TTypeData, соответствующая кодированию RTTI для обычных интерфейсов, выглядит так:

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

С этого момента мы видим, что у нас есть доступ к такой информации о типе для любого интерфейса:

• Указатель на информацию родительского интерфейса (IntfParent)
• Флаги, указывающие на то, имеет ли интерфейс GUID, является ли он интерфейсом dispintf или IDispatch (IntfFlags)
• GUID интерфейса, если он есть (Guid)
• Модуль, в котором был объявлен интерфейс (IntfUnit)
• Число методов интерфейса (PropData.Count)

Мы можем написать простую функцию, которая будет дампить эту информацию для заданного интерфейса:

type  
  PExtraInterfaceData = ^TExtraInterfaceData;
  TExtraInterfaceData = packed record
    MethodCount: Word;   { число методов }
  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;

Функция ожидает указатель на информацию типа от интерфейса. Она копается во внутренних структурах RTTI, пытаясь составить объявление псевдо-интерфейса, используя доступную RTTI информацию. Поскольку она знает лишь число методов, то она даёт им сфабрикованные имена.

Чтобы протестировать этот код, мы можем определить простой ванильный ({$M-}) интерфейс, а затем использовать функцию TypeInfo для получения указателя на RTTI информацию интерфейса и отправить его на дамп в функцию выше:

program TestSimpleInterfaceRTTI;
  
{$APPTYPE CONSOLE}
  
uses
  SysUtils,
  TypInfo;
 
// ... сюда вставьте код выше
 
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.

Запуск этого проекта даёт нам такой вывод:

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;

Вы смогли показать имя модуля (ну, в нашем случае - программы), в котором объявлен интерфейс, имя интерфейса и его предка, а также GUID, при его наличии. Мы также отличаем dispinterface, объявляемые в реализации Automation серверов (для dual-интерфейсов, наследуемых от IDispatch).

Как вы можете видеть, мы не можем показать имена методов и у нас нет никакой информации о их параметрах, возвращаемом значении или соглашении вызова. Но сборка интерфейса в режиме $M+ (или наследование его от IInvokable) всё меняет – как мы увидим в следующей статье.