RTTI

Тут я расскажу про некоторые возможности RTTI (run-time type information, информация о типах во время выполнения), которыми сам активно пользуюсь.

Самое простое и всем хорошо известное - это оператор is для проверки принадлежности класса определенному типа, и функция ClassName, возвращающая строку с именем класса.

Чуть по-сложнее - метаклассы:


type
  TMyClass = class
    constructor Create; virtual;
    class function GetValue: Integer;
  end;

  constructor TMyClass.Create;
  begin
  end;

  class function TMyClass.GetValue: Integer;
  begin
    Result := 5050;
  end;

type
  TMyClass2 = class(TMyClass)
  end;

  CMyClass = class of TMyClass;

var
  MyClass: CMyClass;

begin
  // присваиваем наш базовый класс
  MyClass := TMyClass;
  // можем обращаться ко всем классовым функциям
  Writeln(MyClass.GetValue);
  // можем создать экземпляр класса TMyClass
  Writeln(MyClass.Create.ClassName);
  // можем присвоить наследника
  MyClass := TMyClass2;
  // т.к. конструктор сделан виртуальным, следующий вызов приведет к созданию
  // экземпляра TMyClass2
  Writeln(MyClass.Create.ClassName);
end.


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

В классах помимо секций private, protected и public есть еще и четвертая - published. Все, что в ней содержится (методы и свойства), при компиляции сохраняется вместе с названиями. (Модуль для этого нужно компилировать с ключем $M+, иначе published не будет отличаться от public.) Для доступа к этой информации предусмотрено два метода (взято из док-ции на fpc):


public function TObject.MethodAddress(const name: shortstring): pointer;
public function TObject.MethodName(address: pointer): shortstring;


Указатель, который возвращает первая функция, нельзя сразу использовать, нужно сперва заполнить им структуру TMethod:


{$M+}
type
  TMyClass = class
   published
    function GetValue: Integer;
  end;

  TGetValue = function (): Integer of object;

function TMyClass.GetValue: Integer;
begin
  Result := 5050;
end;

var
  I: Integer;
  Obj: TMyClass;
  Method: TMethod;

begin
  Obj := TMyClass.Create;
  Method.Code := Obj.MethodAddress('GetValue');
  Method.Data := Obj;
  I := TGetValue(Method);
  Writeln(I);
  Obj.Free;
end.


Этих двух функций мне оказалось недостаточно. Представим себе, что нужно прочитать xml-файл и на каждый тэг мы прописали метод чтения, и хочется, чтобы эти методы регистрировались автоматически. Для этого нужно как-то извлечь массив со всеми published-методами и их названиями. После изучения модуля System, я написал следующий код


type
TMethodName = record
  Name: TString;
  Method: TMethod;
end;
TArrayOfMethodName = array of TMethodName;

{$IFDEF FLAG_FPC}
  // Версия для Free Pascal (2.2.4)
  // Отличается от Delphi только форматом хранения RTTI
  function GetMethodArray(Obj: TObject): TArrayOfMethodName;
    type
      tmethodnamerec = packed record
        name : pshortstring;
        addr : pointer;
      end;
      tmethodnametable = packed record
        count : Cardinal;
        entries : packed array[0..0] of tmethodnamerec;
      end;
      pmethodnametable =  ^tmethodnametable;
      var
        I: Integer;
        Table: PMethodNameTable;
  begin
    Table := pmethodnametable((Pointer(Obj.ClassType) + vmtMethodTable)^);
    SetLength(Result, Table^.Count);
    for I := 0 to High(Result) do begin
      Result[I].Name := Table^.entries[I].name^;
      Result[I].Method.Code := Table^.entries[I].addr;
      Result[I].Method.Data := Obj;
    end;
  end;
{$ELSE}
  // Версия для Delphi (2009)
  function GetMethodArray(Obj: TObject): TArrayOfMethodName;
    type
      TMethodtableEntry = packed Record
        len: Word;
        addr: Pointer;
        name: ShortString;
      end;
    var
      pp: ^Pointer;
      pMethodTable: Pointer;
      pMethodEntry: ^TMethodTableEntry;
      i, numEntries: Word;
  begin
    pp := Pointer(Integer(Obj.ClassType) + vmtMethodtable);
    pMethodTable := pp^;
    if pMethodTable = nil then begin
      SetLength(Result, 0);
      Exit;
    end;
    SetLength(Result, PWord(pMethodTable)^);
    pMethodEntry := Pointer(Integer( pMethodTable ) + 2);
    for I := 0 to High(Result) do begin
      Result[I].Name := pMethodEntry.name;
      Result[I].Method.Code := pMethodEntry.addr;
      Result[I].Method.Data := Obj;
      pMethodEntry := Pointer(Integer( pMethodEntry ) + pMethodEntry^.len);
    end;
  end;
{$ENDIF}


Функция GetMethodArray возвращает список из уже почти готовых для вызова методов и их названий. После этого можно, например, найти все те, которые содержат в начале слово XML и использовать их для обработки xml-файла.

TString - это псевдокод на обычную ascii-строку (не unicode).