(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Расширенная RTTI информация классов

Источник: gunsmoker
Hallvard Vassbotn

Расширенная RTTI информация классов

Как я упоминал ранее, Delphi (начиная с версии 7) поддерживает генерацию расширенной RTTI информации о методах класса - через компиляцию класса в режиме $METHODINFO ON. Эта RTTI информация включает в себя информацию о сигнатуре public и published методов. Delphi использует её для реализации поддержки скриптинга в фреймворке WebSnap - см. модуль ObjAuto и его друзей для более подробных сведений.

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

Пока я писал модуль HVMethodInfoClasses, я подправил и улучшил некоторый старый код и структуры, так что я могу использовать больше общего кода с HVIntefaceMethods и HVMethodSignature.

Мы уже привыкли раскапывать внутренние структуры RTTI, так что давайте лишь поверхностно пробежимся по новому коду. Итак, для начала у нас есть новые определения записей, описывающих приблизительную раскладку по памяти внутренних структур RTTI, генерируемых компилятором - выцарапанные из "официального" источника: ObjAuto:

type
  PReturnInfo = ^TReturnInfo;
  TReturnInfo = packed record
    Version: Byte; 
    CallingConvention: TCallConv;
    ReturnType: PPTypeInfo;
    ParamSize: Word;
  end;

  PParamInfo = ^TParamInfo;
  TParamInfo = packed record
    Flags: TParamFlags;
    ParamType: PPTypeInfo;
    Access: Word;
    Name: ShortString;
  end;
Как найти начала этих структур - это немного сложный вопрос. Помните статью Под капотом published методов? В то время я не знал про расширенную RTTI информацию и директиву $MethodInfo, поэтому написал:
Как вы можете видеть выше, таблица published методов теперь имеет тип PPmt. Это указатель на запись, которая содержит число published методов в классе, за которым следует массив из этого количества записей TPublishedMethod. Каждая запись содержит размер (используется для перехода к следующему элементу), указатель на точку входа метода и ShortString, содержащую имя метода.

Заметьте, что поле Size избыточно: во всех случаях значение Size равно:

Size :=  SizeOf(Size) + SizeOf(Address) + SizeOf(Name[0]) + Length(Name);
Другими словами, следующая запись TPublishedMethod начинается прямо за последним байтом текущей записи (т.е. последним байтом имени метода). Я не уверен, почему Borland решила добавить поле Size, но возможной причиной может быть расширение записи TPublishedMethod в будущем. Естественное расширение - добавить информацию по количеству и типам параметров, а также соглашению вызова метода. Тогда поле Size было бы увеличено, а старый код, который не в курсе новых возможностей, продолжал работать бы дальше.
Как оказалось сейчас, поле Size в самом деле используется для вставки дополнительных записей (TReturnInfo и TParamInfo) прямо за полем Name записи TPublishedMethod:
type
  PPublishedMethod = ^TPublishedMethod;
  TPublishedMethod = packed record
    Size: Word;  
    Address: Pointer;
    Name: {packed} ShortString;
  end;
Чтобы найти и декодировать сигнатуру метода, нам необходимо определить число дополнительных байт, указанных в поле Size. Мы скоро увидим код для этого.

Далее у нас есть структуры, которые могут хранить декодированную RTTI информацию одного класса, включая информацию по методам секций public/published со всеми их параметрами и возвращаемыми типами:

type
  // Просто-используемые структуры фиксированного размера
  PClassInfo = ^TClassInfo;
  TClassInfo = record
    UnitName: string; 
    Name: string;
    ClassType: TClass;
    ParentClass: TClass;
    MethodCount: Word;
    Methods: array of TMethodSignature;  
  end;
Это определение должно быть в большой степени само-документирующимся. Как вы можете видеть, мы использовали ту же запись TMethodSignature, которую мы использовали для интерфейсов. Ладно, теперь мы более-менее готовы к написанию кода для конвертирования информации типа класса в наши структуры выше. Это подразумевает испачкать наши руки итерацией по всем public/published методам и дополнительной RTTI информации. После нескольких неудачных попыток и подсматриваний в ObjAuto, я пришёл к такому коду:
function ClassOfTypeInfo(P: PPTypeInfo): TClass;
begin
  Result := nil;
  if Assigned(P) and (P^.Kind = tkClass) then
    Result := GetTypeData(P^).ClassType;
end;  
  
procedure GetClassInfo(ClassTypeInfo: PTypeInfo; var ClassInfo: TClassInfo);
// Конвертирует raw структуры RTTI в наши user-friendly структуры
var
  TypeData: PTypeData;
  i, j: integer;
  MethodInfo: PMethodSignature;
  PublishedMethod: PPublishedMethod;
  MethodParam: PMethodParam;
  ReturnRTTI: PReturnInfo;
  ParameterRTTI: PParamInfo;
  SignatureEnd: Pointer;
begin
  Assert(Assigned(ClassTypeInfo));
  Assert(ClassTypeInfo.Kind = tkClass);

  // Класс
  TypeData  := GetTypeData(ClassTypeInfo);
  ClassInfo.UnitName        := TypeData.UnitName;
  ClassInfo.ClassType       := TypeData.ClassType;
  ClassInfo.Name            := TypeData.ClassType.ClassName;
  ClassInfo.ParentClass     := ClassOfTypeInfo(TypeData.ParentInfo);  
  ClassInfo.MethodCount     := GetPublishedMethodCount(ClassInfo.ClassType);
  SetLength(ClassInfo.Methods, ClassInfo.MethodCount);

  // Методы
  PublishedMethod := GetFirstPublishedMethod(ClassInfo.ClassType);
  for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do
  begin
    // Метод
    MethodInfo := @ClassInfo.Methods[i];
    MethodInfo.Name       := PublishedMethod.Name;
    MethodInfo.Address    := PublishedMethod.Address;
    MethodInfo.MethodKind := mkProcedure; // Предположим процедуру по умолчанию
    
    // Возвращаемое значение и соглашение вызова
    ReturnRTTI := Skip(@PublishedMethod.Name);
    SignatureEnd := Pointer(Cardinal(PublishedMethod) + PublishedMethod.Size);
    if Cardinal(ReturnRTTI) >= Cardinal(SignatureEnd) then
    begin
      MethodInfo.CallConv := ccReg; // Предположим register
      MethodInfo.HasSignatureRTTI := False;
    end
    else  
    begin
      MethodInfo.ResultTypeInfo := Dereference(ReturnRTTI.ReturnType);
      if Assigned(MethodInfo.ResultTypeInfo) then 
      begin
        MethodInfo.MethodKind := mkFunction;
        MethodInfo.ResultTypeName := MethodInfo.ResultTypeInfo.Name;
      end  
      else 
        MethodInfo.MethodKind := mkProcedure;
      MethodInfo.CallConv := ReturnRTTI.CallingConvention;
      MethodInfo.HasSignatureRTTI := True;

      // Считаем параметры
      ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^));
      MethodInfo.ParamCount := 0;
      while Cardinal(ParameterRTTI) < Cardinal(SignatureEnd) do
      begin
        Inc(MethodInfo.ParamCount); // Предполагаем, что будет менее 255 параметров! ;)
        ParameterRTTI := Skip(@ParameterRTTI.Name);
      end;  

      // Читаем информацию о параметрах
      ParameterRTTI := Pointer(Cardinal(ReturnRTTI) + SizeOf(ReturnRTTI^));
      SetLength(MethodInfo.Parameters, MethodInfo.ParamCount);
      for j := Low(MethodInfo.Parameters) to High(MethodInfo.Parameters) do
      begin
        MethodParam := @MethodInfo.Parameters[j];

        MethodParam.Flags       := ParameterRTTI.Flags;
        if pfResult in MethodParam.Flags then
          MethodParam.ParamName := 'Result'
        else
          MethodParam.ParamName := ParameterRTTI.Name;
        MethodParam.TypeInfo    := Dereference(ParameterRTTI.ParamType);
        if Assigned(MethodParam.TypeInfo) then
          MethodParam.TypeName  := MethodParam.TypeInfo.Name;
        MethodParam.Location    := TParamLocation(ParameterRTTI.Access);

        ParameterRTTI := Skip(@ParameterRTTI.Name);
      end;  
    end;
    PublishedMethod := GetNextPublishedMethod(ClassInfo.ClassType, PublishedMethod);
  end;  
end;
Как обычно, мы тестируем код, определяя какой-то глупый класс и используя RTTI для реконструирования его объявления. Вот упрощённый тестовый проект:
program TestHVMethodInfoClasses;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  TypInfo,
  HVMethodSignature in 'HVMethodSignature.pas',
  HVMethodInfoClasses in 'HVMethodInfoClasses.pas';

procedure DumpClass(ClassTypeInfo: PTypeInfo);
var
  ClassInfo: TClassInfo;
  i: integer;
begin
  GetClassInfo(ClassTypeInfo, ClassInfo);
  WriteLn('unit ', ClassInfo.UnitName, ';');
  WriteLn('type');
  Write('  ', ClassInfo.Name, ' = '); 
    Write('class');
    if Assigned(ClassInfo.ParentClass) then
      Write(' (', ClassInfo.ParentClass.ClassName, ')');
    WriteLn;
  for i := Low(ClassInfo.Methods) to High(ClassInfo.Methods) do
    WriteLn('    ', MethodSignatureToString(ClassInfo.Methods[i]));
  WriteLn('  end;');
  WriteLn;
end;  

type
  {$METHODINFO OFF}
  TNormalClass = class
  end;
  TSetOfByte = set of byte;
  TEnum = (enOne, enTwo, enThree);

type
  {$METHODINFO ON}
  TMyClass = class
  public
    function Test1(const A: string): string; 
    function Test2(const A: string): byte;
    procedure Test3(R: integer);
    procedure Test4(R: TObject); 
    procedure Test5(R: TNormalClass); 
    procedure Test6(R: TSetOfByte); 
    procedure Test7(R: shortstring); 
    procedure Test8(R: openstring); 
    procedure Test9(R: TEnum); 
    function Test10: TNormalClass; 
    function Test11: integer; 
    function Test18: shortstring; 
    function Test19: TObject; 
    function Test20: IInterface; 
    function Test21: TSetOfByte; 
    function Test22: TEnum; 
  end;
 
// ... вырезаны реализации-пустышки методов класса TMyClass ...

procedure Test;
begin
  DumpClass(TypeInfo(TMyClass));
end;

begin
  try
    Test;
  except
    on E: Exception do
      WriteLn(E.Message);
  end;
  readln;
end.
И вывод тестового кода:
unit TestHVMethodInfoClasses;
type
  TMyClass = class (TObject)
    function Test1(A: String): String;
    function Test2(A: String): Byte;
    procedure Test3(R: Integer);
    procedure Test4(R: TObject);
    procedure Test5(R: TNormalClass);
    procedure Test6(R: TSetOfByte);
    procedure Test7(R: ShortString);
    procedure Test8(R: ShortString);
    procedure Test9(R: TEnum);
    function Test10(): TNormalClass;
    function Test11(): Integer;
    function Test18(): ShortString;
    function Test19(): TObject;
    function Test20(): IInterface;
    function Test21(): TSetOfByte;
    function Test22(): TEnum;
  end;
Полный исходный код доступен на CodeCentral.

Как отметил мой прилежный читатель, Ralf, вывод этой программы является дословной копией исходного кода. Помимо моей небрежности по не опусканию пустых скобок в функциях: строковые параметры пока не объявлены как const. Это потому, что RTTI для этих параметров не включает pfConst (duh!). Я думаю, что причина в том, что RTTI методов и параметров оптимизирована для получения возможности динамического вызова методов в run-time, а модификатор const на это не влияет (на вызывающего) - он влияет только на код метода, создаваемый компилятором (запрет изменения и опускание создания локальной копии).

Фактически я пытался (до сих пор - не успешно) уговорить Borland DevCo CodeGear Embarcadero упростить компилятор и разрешить ставить const в секции implementation и не ставить - в interface. Это может звучать, как запрос ленивого программиста, но на деле это позволило бы менять "константность" параметра, не затрагивая (не изменяя) интерфейс - что является более чем логичным поведением. Ох, ну и ладно, в любом случае, это история для другого раза.



 Распечатать »
 Правила публикации »
  Обсудить материал в конференции Embarcadero »
Написать редактору 
 Рекомендовать » Дата публикации: 02.08.2011 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Enterprise Connectors (1 Year term)
Delphi Professional Named User
TeeChart Pro VCL/FMX with source code single license
Raize Components 6
VideoStudio X9 ULTIMATE. Электронный ключ.
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
CASE-технологии
СУБД Oracle "с нуля"
Компьютерные книги. Рецензии и отзывы
Новые материалы
Вопросы и ответы по MS SQL Server
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
Обсуждения в форумах
Ставки на спорт через зеркало БК Пинакл (1)
Актуальное зеркало букмекерской конторы Пинакл https://superbet.guru/pinacle-mirror/ всегда...
 
работа на дому! (6)
Доброго времени суток дорогие друзья. Многоуровневый маркетинг окончательно признан...
 
Аналоги виагры (2)
Если мужчине, по каким либо причинам, не подходит виагра, существуют качественные аналоги...
 
Актуальные зеркала букмекерских контор (3)
Бетторы не всегда доверяют зеркалам БК, а зря, потому что эти «запасные аэродромы» запускают...
 
Отличается ли ДрифтКазино от беттинга? (13)
Друзья, давно заметил, что на Дрифте уже несколько месяцев во всю рекламируется и предлагается...
 
 
 



    
rambler's top100 Rambler's Top100