一：获得对象的RTTI（以下代码基于Delphi 6/7）
RTTI(Runtime Type Information
运行时类型信息)指的是对象在编译的时候，将其属性、方法的类型信息编译进特殊的区域，使得应用程序可以运行时，动态的查找对象的成员（fields）和
属性（properties），以及定位函数（methods）。能够编译进RTTI的成员主要是被声明在对象的published部分，对象
published部分的成员与public部分的成员具有相同的可见性，但区别就在于此。当在持久化和反持久化的时候，RTTI被用来访问属性的值、在
对象浏览器（Object Inspector）中显示属性，以及关联事件（Event）和事件句柄函数（Event
Handler）。Published部分的属性类型被限定在几种特殊的类型中，只能是Ordinal（有序类型）、string、class、
interface、variant和函数指针类型，数组属性是不能被声明为published。当然也不是每一个被声明在published部分的成员
都可以被持久化下来，比如record、array，同时声明在published部分的函数不支持overload。任何一个类希望拥有RTTI，需要
在其类声明的时候加上编译开关{$M+}，或者其父类在声明的时候有{$M+}，所以最简单的方式获得RTTI就是从TPersistent继承。
对象属性的RTTI
特别注意，并不是所有类型的属性都可以被编译到RTTI中。
以下是获得属性、类型的方法
function GetObjProps(AObj: TPersistent): String;
var
StrList: TStringList;
PropCount, I: Integer;
PropList: PPropList;
begin
StrList:= TStringList.Create;
try
PropCount:= GetPropList(AObj, PropList);
try
if PropCount>0 then
for I := 0 to PropCount-1 do
StrList.Append(Format('Property %s : %s ;',[PropList[I]^.Name, PropList[I]^.PropType^^.Name]));
finally
if PropCount>0 then FreeMem(PropList,PropCount*SizeOf(Pointer));
end;
Result:= StrList.Text;
finally
StrList.Free;
end;
end;
当自己制作一个属性浏览器的时候，就可以通过TypInfo单元中的各种方法，获得属性名称、类型、值的读写。
对象函数的RTTI
之所在很早的时候函数就被编译进RTTI中，并不是为了在Delphi中实现反射，因为反射的概念只是Java、.NET这种基于VM的语言的一个小特
性，而基于VM产生出的各种特性，包括垃圾回收、平台无关这些都是编译型语言的硬伤，所以Delphi不会特地为了反射而反射，只是用在一些特殊的领域。
Delphi中支持函数的RTTI最早是为了实现事件句柄（EventHandler）的持久化。在Delphi语言创建之初就确定了对
Property-Event的支持，这个特性也是Delphi最富魅力的特性之一。所谓的Event（事件），是消息或内部逻辑中发出的特定的请
求，Event的定义需要明确特定的事件意义以及特定的编程接口，它是基于消息机制的一种逻辑扩展接口，Event本身并不直接包含逻辑，它只是一个锚
点，真正的执行逻辑在EventHandler中，EventHandler依赖于外部的注入。
例如：
对象声明了一个处理消息WM_LBUTTONDBLCLK的函数，在接收到该消息后执行
if Assigned(FOnDblClick) then FOnDblClick(Self);
则外部就可以通过在EventOnDBClick属性上挂接处理函数，来实现对事件的响应，注入逻辑。我们知道，在IDE和持久化机制中，针对事件属性关
联的EventHandler是声明在窗体对象published部分的函数（准确的说，由于EventHandler关联关系是需要持久化的，所以在
Delphi的持久化机制中，EventHandler一定要是TReader/TWriter的Root下published中声明的函数），这是一种
比较古老也过时的设计，现在由于AOP（Aspect-Oriented
program面向方面编程）概念的发展，受其影响已将EventHandler发展为委托对象，事件的发起者只需要将自己注册在委托对象上，事件的处理
逻辑也不直接响应事件，而也是注册在委托对象上，这样设计的好处是由于中间存在了一个delegation，也就提供了更方便更灵活的注入逻辑的机制，在
后期加入和改变事件处理逻辑的时候也最大限度的保障了原有逻辑的稳定。这也是.Net中发展出委托的原因。当然，在很多国内的书籍中介绍到.Net的委托
的时候，都会提到『不必关心具体的执行者，只要知道你的消息交给哪一个委托就好了』，这样的解释并没有切题，因为无论是Delphi中比较古老的设计，还
是现今的委托，消息的发起者都不需要关心接收者的处理。
下面看一段持久化机制中的代码：
procedure WriteMethodProp;
var
Value: TMethod;
begin
Value := GetMethodProp(Instance, PropInfo);
WritePropPath;
if Value.Code = nil then
WriteValue(vaNil)
else
WriteIdent(FLookupRoot.MethodName(Value.Code));
end;
这段是TWriter.WriteProperty中持久化Event的子函数，基本逻辑就是：根据函数地址，在LookupRoot中找寻到函数名称，将其持久化。这里的LookupRoot就等于Root。而在TReader中反持久化的时候，代码如下：
tkMethod:
if NextValue = vaNil then
begin
ReadValue;
SetMethodProp(Instance, PropInfo, NilMethod);
end
else
begin
Method.Code := FindMethod(Root, ReadIdent);
Method.Data := Root;
if Method.Code <> nil then SetMethodProp(Instance, PropInfo, Method);
end;
这下就一目了然了，Data是Root，Code是根据函数名称在Root下找寻到函数地址。
如果我们想在Delphi中实现委托对象的话，可以在委托对象持久化的时候记录下Event的关联关系，例如，可以是以下的dfm文件：
...
delegation: TNotifydelegation
Events=<
item
host = Button1
Event = 'OnClick'
end>
end
而不必拘泥于一定要生成如下形式，
...
Button1: TButton
OnClick = delegation.OnNotify
end
因为如果生成这种形式的话，需要改写VCL中的一些代码。
最简单的情况下，函数的RTTI是通过如下形式获得到的：
var
VMT: Pointer;
MethodInfo: PMethodInfoHeader;
begin
VMT := PPointer(AObj)^;
MethodInfo := PPointer(Integer(VMT) + vmtMethodTable)^;
...
end；
这是一段摘自VCL中的代码，其意义是对象首地址负偏移vmtMethodTable（vmtMethodTable=-56在单元System中有相关
常量值的定义）是RTTI方法表的入口地址，注意，方法表入口首先存储的当前对象的方法数量，然后首地址偏移2
Byte后才是所有函数的名称。在单元ObjAuto中相关结构体定义了方法表的内存结构。
当只有{$M+}的时候，方法表的内存布局是以下结构：
TMethodInfoHeader = packed record
Len: Word;
Addr: Pointer;
Name: ShortString;
end;
其中Len是该函数信息结构的大小（当只有{$M+}时，Len=TMethodInfoHeader结构体的大小，注意Name是变体；当有{$M+}
{$METHODINFO
ON}时，Len=TMethodInfoHeader+TReturnInfo+TParamInfo+...+TParamInfo），Addr指向
代码段函数地址，Name为函数名。
当有{$M+}{$$METHODINFO ON}时，内存布局如下：
TMethodInfoHeader = packed record
Len: Word;
Addr: Pointer;
Name: ShortString;
end;
+
TReturnInfo = packed record
Version: Byte; // Must be 1
CallingConvention: TCallingConvention;
ReturnType: ^PTypeInfo;
ParamSize: Word;
end;
+
TParamInfo = packed record
Flags: TParamFlags;
ParamType: ^PTypeInfo;
Access: Word;
Name: ShortString;
end;
+
...
+
TParamInfo = packed record
Flags: TParamFlags;
ParamType: ^PTypeInfo;
Access: Word;
Name: ShortString;
end;
其中，函数有多少参数就有多少TParamInfo结构体。任何对象函数，都包含第一个隐式参数Self，所以任何函数都至少包含一个TParamInfo结构体。
在最新版的Delphi中，为了更好的支持反射，于是默认情况扩展了RTTI信息，所以函数表内容变成了不但含有函数头信息，还包含了返回值和参数信息，故而编译后可执行程序的体积也变得庞大。
以下函数是获得published部分声明的函数名称，不包含参数和返回值，引用单元ObjAuto。AObj声明时包含编译开关{$M+}。（代码修改
自D7VCL中一段，虽然TObject中有MethodName和MethodAddress两个函数，但是使用汇编撰写的，翻译成Pascal代码，
也差不多就是下面这段的意思）：
function GetObjMethodNames(AObj: TPersistent): String;
var
VMT: Pointer;
MethodInfo: Pointer;
Count: Integer;
begin
VMT := PPointer(AObj)^;
repeat
MethodInfo := PPointer(Integer(VMT) + vmtMethodTable)^;
if MethodInfo <> nil then
begin
Count := PWord(MethodInfo)^;
Inc(Integer(MethodInfo), 2);
while Count > 0 do
begin
Result:= Result+ PMethodInfoHeader(MethodInfo)^.Name+#13+#10;
Inc(Integer(MethodInfo), PMethodInfoHeader(MethodInfo)^.Len);
Dec(Count);
end;
end;
VMT := PPointer(Integer(VMT) + vmtParent)^;
if VMT = nil then
begin
Exit;
end;
VMT := PPointer(VMT)^;
until False;
end;
以下代码是获取函数及其参数和返回值，引用单元ObjAuto。AObj声明时包含编译开关{$M+}{$METHODINFO ON}：
function TForm1.GetObjMethods(AObj: TPersistent): String;
const
ConventionName: array [Low(TCallingConvention)..High(TCallingConvention)] of String =
('Register', 'Cdecl', 'Pascal', 'StdCall', 'SafeCall');
var
StrList: TStringList;
VMT: Pointer;
MethodInfo: PMethodInfoHeader;
Count: Integer;
RoutinPrefix, MethodName, ReturnName, Params: String;
MethodAddr, MethodEnd: Pointer;
ReturnAddr: PReturnInfo;
begin
StrList:= TStringList.Create;
try
VMT := PPointer(AObj)^;
repeat
MethodInfo := PPointer(Integer(VMT) + vmtMethodTable)^;
if MethodInfo <> nil then
begin
// Scan method table for the method
Count := PWord(MethodInfo)^;
Inc(Integer(MethodInfo), 2);
while Count > 0 do
begin
RoutinPrefix:= '';
ReturnName:= ';';
Params:= '';
//now methodinfo points to head of method
MethodName:= MethodInfo^.Name;
MethodEnd := Pointer(Integer(MethodInfo) + MethodInfo^.Len);
ReturnAddr:= Pointer(Integer(MethodInfo)+SizeOf(TMethodInfoHeader)-
SizeOf(ShortString)+1+Length(MethodName));
MethodAddr:=Pointer(Integer(ReturnAddr)+SizeOf(TReturnInfo));
// RTTI involves methodinfo
if Integer(MethodAddr) < Integer(MethodEnd) then
begin
if ReturnAddr^.ReturnType= nil then RoutinPrefix:='Procedure'
else
begin
RoutinPrefix:= 'Function';
ReturnName:= ': '+ReturnAddr^.ReturnType^^.Name+ ';';
end;
//add routin's convention type
ReturnName:= ReturnName+ ' '+ConventionName[ReturnAddr^.CallingConvention];
//the first parameter is self pointer and be hidden
Inc(Integer(MethodAddr), SizeOf(TParamInfo) -SizeOf(ShortString) + 1 +
Length(PParamInfo(MethodAddr)^.Name));
while Integer(MethodAddr) < Integer(MethodEnd) do
begin
Params:= Params+ PParamInfo(MethodAddr)^.Name+': '+
PParamInfo(MethodAddr)^.ParamType^^.Name;
Inc(Integer(MethodAddr), SizeOf(TParamInfo) -SizeOf(ShortString) + 1 +
Length(PParamInfo(MethodAddr)^.Name));
end;
end;
//output information
StrList.Append(Format(RoutinPrefix+' %s(%s)%s;', [MethodName,Params, ReturnName]));
//jump to the next method
Inc(Integer(MethodInfo),PMethodInfoHeader(MethodInfo)^.Len);
Dec(Count);
end;
end;
// Find the parent VMT
VMT := PPointer(Integer(VMT) + vmtParent)^;
if VMT = nil then
begin
Break;
end;
VMT := PPointer(VMT)^;
until False;
Result:= StrList.Text;
finally
StrList.Free;
end;
end;
［作者：Savetime 转贴自：Delphibbs.com 点击数：1560 更新时间：2004-12-28 文章录入：aleyn］
目录
===============================================================================
⊙ RTTI 简介
⊙ 类(class) 和 VMT 的关系
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
⊙ TObject.ClassType 和 TObject.ClassInfo
⊙ is 和 as 运算符的原理
⊙ TTypeInfo – RTTI 信息的结构
⊙ 获取类(class)的属性(property)信息
⊙ 获取方法(method)的类型信息
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
⊙ 获取其它数据类型的 RTTI 信息
===============================================================================
本文排版格式为：
正文由窗口自动换行；所有代码以 80 字符为边界；中英文字符以空格符分隔。
(作者保留对本文的所有权利，未经作者同意请勿在在任何公共媒体转载。)
正文
===============================================================================
⊙ RTTI 简介
===============================================================================
RTTI(Run-Time Type Information) 翻译过来的名称是“运行期类型信息”，也就是说可以在运行期获得数据类型或类(class)的信息。这个 RTTI 到底有什么用处，我现在也说不清楚。我是在阅读 Delphi 持续机制的代码中发现了很多 RTTI 的运用，只好先把 RTTI 学习一遍。下面是我的学习笔记。如果你发现了错误请告诉我。谢谢！
Delphi 的 RTTI 主要分为类(class)的 RTTI 和一般数据类型的 RTTI，下面从类(class)开始。
===============================================================================
⊙ 类(class) 和 VMT 的关系
===============================================================================
一个类(class)，从编译器的角度来看就是一个指向 VMT 的指针(在后文用 VMTptr 表示)。在类的 VMTptr 的负地址方向存储了一些类信息的指针，这些指针的值和指针所指的内容在编译后就确定了。比如 VMTptr - 44 的内容是指向类名称(ClassName)的指针。不过一般不使用数值来访问这些类信息，而是通过 System.pas 中定义的以 vmt 开头的常量，如 vtmClassName、vmtParent 等来访问。
类的方法有两种：对象级别的方法和类级别的方法。两者的 Self 指针意义是不同的。在对象级别的方法中 Self 指向对象地址空间，因此可以用它来访问对象的成员函数；在类级别的方法中 Self 指向类的 VMT，因此只能用它来访问 VMT 信息，而不能访问对象的成员字段。
===============================================================================
⊙ 类(class)、类的类(class of class)、类变量(class variable) 的关系
===============================================================================
上面说到类(class) 就是 VMTptr。在 Delphi 中还可以用 class of 关键字定义类的类，并且可以使用类的类定义类变量。从语法上理解这三者的关键并不难，把类当成普通的数据类型来考虑就可以了。在编译器级别上表现如何呢？
为了简化讨论，我们使用 TObject、TClass 和 TMyClass 来代表上面说的三种类型：
type
TClass = class of TObject;
var
TMyClass: TClass;
MyObject: TObject;
begin
TMyClass := TObject;
MyObject := TObject.Create;
MyObject := TClass.Create;
MyObject := TMyClass.Create;
end;
在上面的例子中，三个 TObject 对象都被成功地创建了。编译器的实现是：TObject 是一个 VMTPtr 常量。TClass 也是一个 VMTptr 常量，它的值就是 TObject。TMyClass 是一个 VMTptr 变量，它被赋值为 TObject。TObject.Create 与 TClass.Create 的汇编代码完全相同。但 TClass 不仅缺省代表一个类，而且还(主要)代表了类的类型，可以用它来定义类变量，实现一些类级别的操作。
===============================================================================
⊙ TObject.ClassType 和 TObject.ClassInfo
===============================================================================
function TObject.ClassType: TClass;
begin
Pointer(Result) := PPointer(Self)^;
end;
TObject.ClassType 是对象级别的方法，Self 的值是指向对象内存空间的指针，对象内存空间的前 4 个字节是类的 VMTptr。因此这个函数的返回值就是类的 VMTptr。
class function TObject.ClassInfo: Pointer;
begin
Result := PPointer(Integer(Self) + vmtTypeInfo)^;
end;
TObject.ClassInfo 使用 class 关键字定义，因此是一个类级别的方法。该方法中的 Self 指针就是 VMTptr。所以这个函数的返回值是 VMTptr 负方向的 vmtTypeInfo 的内容。
TObject.ClassInfo 返回的 Pointer 指针，实际上是指向类的 RTTI 结构的指针。但是不能访问 TObject.ClassInfo 指向的内容(TObject.ClassInfo 返回值是 0)，因为 Delphi 只在 TPersistent 类及 TPersistent 的后继类中产生 RTTI 信息。(从编译器的角度来看，这是在 TPersistent 类的声明之前使用 {$M+} 指示字的结果。)
TObject 还定义了一些获取类 RTTI 信息的函数，列举在下，就不一一分析了：
TObject.ClassName: ShortString; 类的名称
TObject.ClassParent: TClass; 对象的父类
TObject.InheritsFrom: Boolean; 是否继承自某类
TObject.InstanceSize: Longint; 对象实例的大小
===============================================================================
⊙ is 和 as 运算符的原理
===============================================================================
我们知道可以在运行期使用 is 关键字判断一个对象是否属于某个类，可以使用 as 关键字把某个对象安全地转换为某个类。在编译器的层次上，is 和 as 的操作是由 System.pas 中两个函数完成的。
{ System.pas }
function _IsClass(Child: TObject; Parent: TClass): Boolean;
begin
Result := (Child <> nil) and Child.InheritsFrom(Parent);
end;
_IsClass 很简单，它使用 TObject 的 InheritsForm 函数判断该对象是否是从某个类或它的父类中继承下来的。每个类的 VMT 中都有一项 vmtParent 指针，指向该类的父类的 VMT。TObject.InheritsFrom 实际上是通过[递归]判断父类 VMT 指针是否等于自己的 VMT 指针来判断是否是从该类继承的。
{ System.pas }
class function TObject.InheritsFrom(AClass: TClass): Boolean;
var
ClassPtr: TClass;
begin
ClassPtr := Self;
while (ClassPtr <> nil) and (ClassPtr <> AClass) do
ClassPtr := PPointer(Integer(ClassPtr) + vmtParent)^;
Result := ClassPtr = AClass;
end;
as 操作符实际上是由 System.pas 中的 _AsClass 函数完成的。它简单地调用 is 操作符判断对象是否属于某个类，如果不是就触发异常。虽然 _AsClass 返回值为 TObject 类型，但编译器会自动把返回的对象改变为 Parent 类，否则返回的对象没有办法使用 TObject 之外的方法和数据。
{ System.pas }
function _AsClass(Child: TObject; Parent: TClass): TObject;
begin
Result := Child;
if not (Child is Parent) then
Error(reInvalidCast); // loses return address
end;
===============================================================================
⊙ TTypeInfo – RTTI 信息的结构
===============================================================================
RTTI 信息的结构定义在 TypInfo.pas 中：
TTypeInfo = record // TTypeInfo 是 RTTI 信息的结构
Kind: TTypeKind; // RTTI 信息的数据类型
Name: ShortString; // 数据类型的名称
{TypeData: TTypeData} // RTTI 的内容
end;
TTypeInfo 就是 RTTI 信息的结构。TObject.ClassInfo 返回指向存放 class TTypeInfo 信息的指针。Kind 是枚举类型，它表示 RTTI 结构中所包含数据类型。Name 是数据类型的名称。注意，最后一个字段 TypeData 被注释掉了，这说明该处的结构内容根据不同的数据类型有所不同。
TTypeKind 枚举定义了可以使用 RTTI 信息的数据类型，它几乎包含了所有的 Delphi 数据类型，其中包括 tkClass。
TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
TTypeData 是个巨大的记录类型，在此不再列出，后文会根据需要列出该记录的内容。
===============================================================================
⊙ 获取类(class)的属性(property)信息
===============================================================================
这一段是 RTTI 中最复杂的部分，努力把本段吃透，后面的内容都是非常简单的。
下面是一个获取类的属性的例子：
procedure GetClassProperties(AClass: TClass; AStrings: TStrings);
var
PropCount, I: SmallInt;
PropList: PPropList;
PropStr: string;
begin
PropCount := GetTypeData(AClass.ClassInfo).PropCount;
GetPropList(AClass.ClassInfo, PropList);
for I := 0 to PropCount - 1 do
begin
case PropList[I]^.PropType^.Kind of
tkClass : PropStr := '[Class] ';
tkMethod : PropStr := '[Method]';
tkSet : PropStr := '[Set] ';
tkEnumeration: PropStr := '[Enum] ';
else
PropStr := '[Field] ';
end;
PropStr := PropStr + PropList[I]^.Name;
PropStr := PropStr + ': ' + PropList[I]^.PropType^.Name;
AStrings.Add(PropStr);
end;
FreeMem(PropList);
end;
你可以在表单上放置一个 TListBox ，然后执行以下语句观察执行结果：
GetClassProperties(TForm1, ListBox1.Items);
该函数先使用 GetTypeData 函数获得类的属性数量。GetTypeData 是 TypInfo.pas 中的一个函数，它的功能是返回 TTypeInfo 的 TypeData 数据的指针：
{ TypInfo.pas }
function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
class 的 TTypeData 结构如下：
TTypeData = packed record
case TTypeKind of
tkClass: (
ClassType: TClass; // 类 (VMTptr)
ParentInfo: PPTypeInfo; // 父类的 RTTI 指针
PropCount: SmallInt; // 属性数量
UnitName: ShortStringBase; // 单元的名称
{PropData: TPropData}); // 属性的详细信息
end;
其中的 PropData 又是一个大小可变的字段。TPropData 的定义如下：
TPropData = packed record
PropCount: Word; // 属性数量
PropList: record end; // 占位符，真正的意义在下一行
{PropList: array[1..PropCount] of TPropInfo}
end;
每个属性信息在内存中的结构就是 TPropInfo，它的定义如下：
PPropInfo = ^TPropInfo;
TPropInfo = packed record
PropType: PPTypeInfo; // 属性类型信息指针的指针
GetProc: Pointer; // 属性的 Get 方法指针
SetProc: Pointer; // 属性的 Set 方法指针
StoredProc: Pointer; // 属性的 StoredProc 指针
Index: Integer; // 属性的 Index 值
Default: Longint; // 属性的 Default 值
NameIndex: SmallInt; // 属性的名称索引(以 0 开始计数)
Name: ShortString; // 属性的名称
end;
为了方便访问属性信息，TypInfo.pas 中还定义了指向 TPropInfo 数组的指针：
PPropList = ^TPropList;
TPropList = array[0..16379] of PPropInfo;
我们可以使用 GetPropList 获得所有属性信息的指针数组，数组用完以后要记得用 FreeMem 把数组的内存清除。
{ TypInfo.pas }
function GetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer;
GetPropList 传入类的 TTypeInfo 指针和 TPropList 的指针，它为 PropList 分配一块内存后把该内存填充为指向 TPropInfo 的指针数组，最后返回属性的数量。
上面的例子演示了如何获得类的所有属性信息，也可以根据属性的名称单独获得属性信息：
{ TypInfo.pas }
function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
GetPropInfo 根据类的 RTTI 指针和属性的名称字符串，返回属性的信息 TPropInfo 的指针。如果没有找到该属性，则返回 nil。GetPropInfo 很容易使用，举个例子：
ShowMessage(GetPropInfo(TForm, 'Name')^.PropType^.Name);
这句调用显示了 TForm 类的 Name 属性的类型名称：TComponentName。
===============================================================================
⊙ 获取方法(method)的类型信息
===============================================================================
所谓方法就是以 of object 关键字声明的函数指针，下面的函数可以显示一个方法的类型信息：
procedure GetMethodTypeInfo(ATypeInfo: PTypeInfo; AStrings: TStrings);
type
PParamData = ^TParamData;
TParamData = record // 函数参数的数据结构
Flags: TParamFlags; // 参数传递规则
ParamName: ShortString; // 参数的名称
TypeName: ShortString; // 参数的类型名称
end;
function GetParamFlagsName(AParamFlags: TParamFlags): string;
var
I: Integer;
begin
Result := '';
for I := Integer(pfVar) to Integer(pfOut) do begin
if I = Integer(pfAddress) then Continue;
if TParamFlag(I) in AParamFlags then
Result := Result + ' ' + GetEnumName(TypeInfo(TParamFlag), I);
end;
end;
var
MethodTypeData: PTypeData;
ParamData: PParamData;
TypeStr: PShortString;
I: Integer;
begin
MethodTypeData := GetTypeData(ATypeInfo);
AStrings.Add('---------------------------------');
AStrings.Add('Method Name: ' + ATypeInfo^.Name);
AStrings.Add('Method Kind: ' + GetEnumName(TypeInfo(TMethodKind),
Integer(MethodTypeData^.MethodKind)));
AStrings.Add('Params Count: '+ IntToStr(MethodTypeData^.ParamCount));
AStrings.Add('Params List:');
ParamData := PParamData(@MethodTypeData^.ParamList);
for I := 1 to MethodTypeData^.ParamCount do
begin
TypeStr := Pointer(Integer(@ParamData^.ParamName) +
Length(ParamData^.ParamName) + 1);
AStrings.Add(Format(' [%s] %s: %s',[GetParamFlagsName(ParamData^.Flags),
ParamData^.ParamName, TypeStr^]));
ParamData := PParamData(Integer(ParamData) + SizeOf(TParamFlags) +
Length(ParamData^.ParamName) + Length(TypeStr^) + 2);
end;
if MethodTypeData^.MethodKind = mkFunction then
AStrings.Add('Result Value: ' + PShortString(ParamData)^);
end;
作为实验，在表单上放置一个 TListBox，然后执行以下代码，观察执行结果：
type
TMyMethod = function(A: array of Char; var B: TObject): Integer of object;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetMethodTypeInfo(TypeInfo(TMyMethod), ListBox1.Items);
GetMethodTypeInfo(TypeInfo(TMouseEvent), ListBox1.Items);
GetMethodTypeInfo(TypeInfo(TKeyPressEvent), ListBox1.Items);
GetMethodTypeInfo(TypeInfo(TMouseWheelEvent), ListBox1.Items);
end;
由于获取方法的类型信息比较复杂，我尽量压缩代码也还是有这么长，让我们看看它的实现原理。GetMethodTypeInfo 的第一个参数是 PTypeInfo 类型，表示方法的类型信息地址。第二个参数是一个字符串列表，可以使用任何实现 TStrings 操作的对象。我们可以使用 System.pas 中的 TypeInfo 函数获得任何类型的 RTTI 信息指针。TypeInfo 函数像 SizeOf 一样，是内置于编译器中的。
GetMethodTypeInfo 还用到了 TypInfo.pas 中的 GetEnumName 函数。这个函数通过枚举类型的整数值得到枚举类型的名称。
function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
与获取类(class)的属性信息类似，方法的类型信息也在 TTypeData 结构中
TTypeData = packed record
case TTypeKind of
tkMethod: (
MethodKind: TMethodKind; // 方法指针的类型
ParamCount: Byte; // 参数数量
ParamList: array[0..1023] of Char // 参数详细信息，见下行注释
{ParamList: array[1..ParamCount] of
record
Flags: TParamFlags; // 参数传递规则
ParamName: ShortString; // 参数的名称
TypeName: ShortString; // 参数的类型
end;
ResultType: ShortString}); // 返回值的名称
end;
TMethodKind 是方法的类型，定义如下：
TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
mkClassProcedure, mkClassFunction,
{ Obsolete }
mkSafeProcedure, mkSafeFunction);
TParamsFlags 是参数传递的规则，定义如下：
TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
TParamFlags = set of TParamFlag;
由于 ParamName 和 TypeName 是变长字符串，不能直接取用该字段的值，而应该使用指针步进的方法，取出参数信息，所以上面的代码显得比较长。
===============================================================================
⊙ 获取有序类型(ordinal)、集合(set)类型的 RTTI 信息
===============================================================================
讨论完了属性和方法的 RTTI 信息之后再来看其它数据类型的 RTTI 就简单多了。所有获取 RTTI 的原理都是通过 GetTypeData 函数得到 TTypeData 的指针，再通过 TTypeInfo.TypeKind 来解析 TTypeData。任何数据类型的 TTypeInfo 指针可以通过 TypeInfo 函数获得。
有序类型的 TTypeData 定义如下：
TTypeData = packed record
tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
OrdType: TOrdType; // 有序数值类型
case TTypeKind of
case TTypeKind of
tkInteger, tkChar, tkEnumeration, tkWChar: (
MinValue: Longint; // 类型的最小值
MaxValue: Longint; // 类型的最大值
case TTypeKind of
tkInteger, tkChar, tkWChar: ();
tkEnumeration: (
BaseType: PPTypeInfo; // 指针的指针，它指向枚举的 PTypeInfo
NameList: ShortStringBase; // 枚举的名称字符串(不能直接取用)
EnumUnitName: ShortStringBase)); // 所在的单元名称(不能直接取用)
tkSet: (
CompType: PPTypeInfo)); // 指向集合基类 RTTI 指针的指针
end;
下面是一个获取有序类型和集合类型的 RTTI 信息的函数：
procedure GetOrdTypeInfo(ATypeInfo: PTypeInfo; AStrings: TStrings);
var
OrdTypeData: PTypeData;
I: Integer;
begin
OrdTypeData := GetTypeData(ATypeInfo);
AStrings.Add('------------------------------------');
AStrings.Add('Type Name: ' + ATypeInfo^.Name);
AStrings.Add('Type Kind: ' + GetEnumName(TypeInfo(TTypeKind),
Integer(ATypeInfo^.Kind)));
AStrings.Add('Data Type: ' + GetEnumName(TypeInfo(TOrdType),
Integer(OrdTypeData^.OrdType)));
if ATypeInfo^.Kind <> tkSet then begin
AStrings.Add('Min Value: ' + IntToStr(OrdTypeData^.MinValue));
AStrings.Add('Max Value: ' + IntToStr(OrdTypeData^.MaxValue));
end;
if ATypeInfo^.Kind = tkSet then
GetOrdTypeInfo(OrdTypeData^.CompType^, AStrings);
if ATypeInfo^.Kind = tkEnumeration then
for I := OrdTypeData^.MinValue to OrdTypeData^.MaxValue do
AStrings.Add(Format(' Value %d: %s', [I, GetEnumName(ATypeInfo, I)]));
end;
在表单上放置一个 TListBox，运行以下代码查看结果：
type TMyEnum = (EnumA, EnumB, EnumC);
procedure TForm1.FormCreate(Sender: TObject);
begin
GetOrdTypeInfo(TypeInfo(Char), ListBox1.Items);
GetOrdTypeInfo(TypeInfo(Integer), ListBox1.Items);
GetOrdTypeInfo(TypeInfo(TFormBorderStyle), ListBox1.Items);
GetOrdTypeInfo(TypeInfo(TBorderIcons), ListBox1.Items);
GetOrdTypeInfo(TypeInfo(TMyEnum), ListBox1.Items);
end;
(如果枚举元素没有按缺省的 0 基准定义，那么将不能产生 RTTI 信息，为什么？)
===============================================================================
⊙ 获取其它数据类型的 RTTI 信息
===============================================================================
上面讨论了几个典型的 RTTI 信息的运行，其它的数据类型的 RTTI 信息的获取方法与上面类似。由于这些操作更加简单，就不一一讨论。下面概述其它类型的 RTTI 信息的情况：
LongString、WideString 和 Variant 没有 RTTI 信息；
ShortString 只有 MaxLength 信息；
浮点数类型只有 FloatType: TFloatType 信息；
TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
Int64 只有最大值和最小值信息(也是 64 位整数表示)；
Interface 和动态数组不太熟悉，就不作介绍了。
===============================================================================
⊙ 结束
===============================================================================