Тут я расскажу про некоторые возможности 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).
Читать дальше......
