网上已经有很多关于RTTI的博客，最近刚好看到这里，以前没弄懂的东西，这次一起搞明白一下，写个博客，算是做个笔记。
这里有一篇英文文档，说的很详细：
Delphi Q&A
概念
每个Delphi的类都有一张虚拟方法表（virtual-method table），或者说，Delphi的类是由它来定义的。从编译器角度来看，一个类就是指向VMT的指针。
一个虚拟方法表从指针所指地址的负偏移76 处开始，长度动态分配（由虚拟方法的个数确定）。虚拟方法表被分为很多小段，每段占4 个字节，也就是一系列指针的列表。每个指针指向一个虚拟方法的入口地址。
一个VMT包含
- 基础信息区
VMT负偏移区（-76-0）即为基础信息区。存储了基础数据（如实例大小）、基础数据的指针（如接口表、运行时类型信息表、字段表、方法表、类名和父类虚拟方法表等）和所有基础性虚拟方法的指针。这个区域的数据和指针帮助实现对象的构造和析构、运行时类型信息存取、字段和方法解析等。大小是固定的。
- 用户定义虚拟方法区
VMT正偏移区即为用户定义虚拟方法（即所有非Object定义的虚拟方法）区。每4个字节存储一个用户定义的虚拟方法指针。这些虚拟方法包括本类中定义的虚拟方法以及从TObject一直到本类的所有中间类定义的所有虚拟方法。
这些内容，在编译的时候就已经被确认了，VMT最重要的用途在于，保存了类的虚方法的指针。。
值得注意的是：
类的方法分为两种：对象级别的方法和类方法，两者的self指针意义不同。对象的self指针指向对象的地址空间，只能访问对象的成员函数。而类的self，指向类的VMT，可以访问VMT中的信息。
VMT
请看官方文档提供的例子：
var
ObjList1, ObjList2: TList;
begin
ObjList1 := TObjectList.Create(True);
ObjList2 := TObjectList.Create(True);
end;
两个TList对象由子类给创建，下图给出了VMT详情：
对象的地址的前4字节是该类的VMT，VMT中又包含了父类VMT信息的引用。
详细介绍
所有的类都继承与TObject，具有TObject的所有特性。
TObject类中有这样两个方法：
1.ClassType，获取类的VMT信息
function TObject.ClassType: TClass;
begin
Pointer(Result) := PPointer(Self)^;
end;
可以看到，ClassType方法是对象的方法，self指向的是对象的地址空间，因此，取self的地址前4字节的内容刚好是类的VMT表。如：
//随意创建一个空项目
var
Form1: TForm1;
...
function test(): TClass;
begin
result := Form1.ClassType; //TForm1
end;
...
2.ClassName，获取类名信息
class function TObject.ClassName: ShortString;
begin
Result := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;
这个类加上了class前缀，表示该方法是类方法，即使用类名直接调用， self指向的是VMT。代码意思是：Integer(self)取到self的地址，然后加上vmtClassName偏移，然后用shortString指针指向它，然后取到该地址里放的类名。
下面列出了VMT表中部分信息的负偏移的定义：
const
vmtSelfPtr = -76;
vmtIntfTable = -72;
vmtAutoTable = -68;
vmtInitTable = -64;
vmtTypeInfo = -60;
vmtFieldTable = -56;
vmtMethodTable = -52;
vmtDynamicTable = -48;
vmtClassName = -44;
vmtInstanceSize = -40;
vmtParent = -36;
3.Delphi还提供了几个函数获取RTTI。
//在System.pas单元内
TObject = class
...
class function ClassNameIs(const Name: string): Boolean;
class function ClassParent: TClass;
class function ClassInfo: Pointer;
class function InstanceSize: Longint;
class function InheritsFrom(AClass: TClass): Boolean;
class function MethodAddress(const Name: ShortString): Pointer;
class function MethodName(Address: Pointer): ShortString;
...
end
RTTI详情
结构如下（TypInfo.pas单元中）：
PPTypeInfo = ^PTypeInfo;
PTypeInfo = ^TTypeInfo;
TTypeInfo = record
Kind: TTypeKind;
Name: ShortString;
{TypeData: TTypeData}
end;
TObjectt提供了类方法获取该结构的信息：
class function TObject.ClassInfo: Pointer;
begin
Result := PPointer(Integer(Self) + vmtTypeInfo)^;
end;
其中，TTypeKind类型，枚举了所有的RTTI信息的数据类型：
TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
1.获取类的属性信息
修改于网上的代码：
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TypInfo;
type
{$M+}
TBaseType = class
public
Data: Variant;
end;
TMyType = class
MyDefault: TBaseType;
private
MyPublished: TBaseType;
FID : Integer;
protected
FMyProtected: TBaseType;
public
MyPulbic: Variant;
published
property MyPublish: TBaseType read MyPublished write MyPublished;
property MyProtected: TBaseType read FMyProtected write FMyProtected;
property ID : Integer read FID write FID;
end;
{$M-}
TForm2 = class(TForm)
mmo1: TMemo;
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure Visit(aList: TStrings);
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure Visit(aList: TStrings);
var
lTypeInfo: PTypeInfo;
lTypeData: PTypeData;
lPropList: PPropList;
lcount: integer;
i: integer;
lkind, lname: string;
begin
lTypeInfo := TMyType.ClassInfo; //获取RTTI结构
lTypeData := GetTypeData(lTypeInfo);
lcount := lTypeData.PropCount;
aList.Add(TMyType.ClassName);
GetMem(lPropList, SizeOf(TPropInfo) * lcount);
try
GetPropInfos(lTypeInfo, lPropList); //获取属性列表
for i := 0 to lcount - 1 do
begin
lkind := InttoStr(Ord(lPropList[i]^.PropType^.Kind));
lname := lPropList[i]^.PropType^.Name;
aList.Add('kind:' + lkind + ' name:' + lname)
end;
finally
FreeMem(lPropList); //记得释放数组的内容
end;
end;
procedure TForm2.btn1Click(Sender: TObject);
var
lt: Tstringlist;
i: integer;
begin
lt := Tstringlist.Create;
try
visit(lt);
mmo1.Lines.Clear;
mmo1.Lines.AddStrings(lt);
finally
lt.Free;
end;
end;
end.
//输出内容：
//TMyType
//kind:7 name:TBaseType
//kind:7 name:TBaseType
//kind:1 name:Integer
其中，TTypeData是个变体结构：
PTypeData = ^TTypeData;
TTypeData = packed record
...
tkClass: (
ClassType: TClass;
ParentInfo: PPTypeInfo;
PropCount: SmallInt;
UnitName: ShortStringBase;
{PropData: TPropData}); //属性信息
...
end
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; //与属性stored关键字相关
Index: Integer; //属性的index值
Default: Longint; //属性的default值
NameIndex: SmallInt;
Name: ShortString; //属性名
end;
使用GetPropInfos方法获取属性列表
procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
2.获取方法的信息
直接上代码：
注释都写在代码中了，对照着数据的结构看会清晰很多，入口在TForm2.btn2Click中。
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TypInfo;
type
{$M+}
TBaseType = class
public
Data: Variant;
end;
TMyType = class
MyDefault: TBaseType;
private
MyPublished: TBaseType;
FID: Integer;
protected
FMyProtected: TBaseType;
public
MyPulbic: Variant;
published
property MyPublish: TBaseType read MyPublished write MyPublished;
property MyProtected: TBaseType read FMyProtected write FMyProtected;
property ID: Integer read FID write FID;
end;
{$M-}
TForm2 = class(TForm)
mmo1: TMemo;
btn2: TButton;
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
//ParamList: array[1..ParamCount] of TParamData
//TypIinfo.pas line:200
PParamData = ^TParamData;
TParamData = record
Flags: TParamFlags;
ParamName: ShortString;
TypeName: ShortString;
end;
TMyMethod = function(a: array of char; var b: TObject): Boolean of object;
procedure GetMethodInfo(aTypeInfo: PTypeInfo; aList: TStrings);
var
Form2: TForm2;
implementation
{$R *.dfm}
//根据给定的枚举，获得对应的枚举名称
function GetParamFlagsName(aParamFlags: TParamFlags): string;
var
i: Integer;
begin
Result := '';
for i := 0 to Ord(High(TParamFlag)) do
begin
if i = Integer(pfAddress) then Continue;
if TParamFlag(i) in aParamFlags then
Result := Result + ' - ' + GetEnumName(TypeInfo(TParamFlag), i);
end;
end;
procedure GetMethodInfo(aTypeInfo: PTypeInfo; aList: TStrings);
var
lTypeData: PTypeData;
lParamCount: Integer;
lpTypeStr : PShortString;
lParamData : PParamData;
i: Integer;
begin
lTypeData := GetTypeData(aTypeInfo); //获得运行时信息
lParamCount := lTypeData^.ParamCount; //参数个数
aList.Add('name-->' + aTypeInfo^.Name); //方法名
aList.Add('kind-->' + GetEnumName(TypeInfo(TMethodKind), Integer(lTypeData^.MethodKind))); //方法类型
aList.Add('method count-->' + IntToStr(lParamCount));
aList.Add('method data list -->');
lParamData := PParamData(@lTypeData^.ParamList); //参数列表：包含参数的修饰符（如var,out），参数名称，参数类型
for i := 0 to lParamCount - 1 do
begin
//每次长度不确定，需要使用指针步进方式取内容
lpTypeStr := Pointer(Integer(@lParamData^.ParamName) + Length(lParamData^.ParamName) + 1);
aList.Add(Format('%s - %s : %s', [GetParamFlagsName(lParamData^.Flags), lParamData^.ParamName, lpTypeStr^]));
//移到下一个data
lParamData := PParamData(Integer(lParamData) + SizeOf(TParamFlags) +
Length(lParamData^.ParamName) + Length(lpTypeStr^) + 2);
end;
aList.Add('--------------------');
end;
procedure TForm2.btn2Click(Sender: TObject);
var
lt : TStringList;
begin
lt := TStringList.Create;
try
GetMethodInfo(TypeInfo(TMyMethod), lt); //将对应方法的typeInfo传进去
GetMethodInfo(TypeInfo(TMouseEvent), lt);
mmo1.Lines.Clear;
mmo1.Lines.AddStrings(lt);
finally
lt.Free;
end;
end;
end.
输出结果如图：
结束语
亲身体会，在一个几十万行代码的项目中，每次修改东西都要找很久才能找到对应的类和方法。为了防止盲目的寻找，可以在交互界面上，在鼠标事件加上输出对应Sender的RTTI信息（如：点击某个按钮时，输出某个按钮的所属的类名，点击事件的方法名），这样寻找起来，一键定位，特别方便。
参考
http://pages.cs.wisc.edu/~rkennedy/vmt#vmtInstanceSize
Delphi RTTI浅析
扫一扫
1983
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
