Delphi的RTTIVMT

网上已经有很多关于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

请看官方文档提供的例子：

varObjList1, ObjList2: TList;
beginObjList1 := TObjectList.Create(True);ObjList2 := TObjectList.Create(True);
end;

两个TList对象由子类给创建，下图给出了VMT详情：

对象的地址的前4字节是该类的VMT，VMT中又包含了父类VMT信息的引用。

详细介绍

所有的类都继承与TObject，具有TObject的所有特性。

TObject类中有这样两个方法：

1.ClassType，获取类的VMT信息

function TObject.ClassType: TClass;
beginPointer(Result) := PPointer(Self)^;
end;

可以看到，ClassType方法是对象的方法，self指向的是对象的地址空间，因此，取self的地址前4字节的内容刚好是类的VMT表。如：

//随意创建一个空项目
varForm1: TForm1;
...function test(): TClass;
beginresult := Form1.ClassType;        //TForm1
end;...

2.ClassName，获取类名信息

class function TObject.ClassName: ShortString;
beginResult := PShortString(PPointer(Integer(Self) + vmtClassName)^)^;
end;

这个类加上了class前缀，表示该方法是类方法，即使用类名直接调用， self指向的是VMT。代码意思是：Integer(self)取到self的地址，然后加上vmtClassName偏移，然后用shortString指针指向它，然后取到该地址里放的类名。

下面列出了VMT表中部分信息的负偏移的定义：

constvmtSelfPtr           = -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 = recordKind: TTypeKind;Name: ShortString;{TypeData: TTypeData}end;

TObjectt提供了类方法获取该结构的信息：

class function TObject.ClassInfo: Pointer;
beginResult := 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;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, TypInfo;type
{$M+}TBaseType = classpublicData: Variant;end;TMyType = classMyDefault: TBaseType;privateMyPublished: TBaseType;FID : Integer;protectedFMyProtected: TBaseType;publicMyPulbic: Variant;publishedproperty 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);varForm2: TForm2;implementation{$R *.dfm}procedure Visit(aList: TStrings);
varlTypeInfo: PTypeInfo;lTypeData: PTypeData;lPropList: PPropList;lcount: integer;i: integer;lkind, lname: string;
beginlTypeInfo := TMyType.ClassInfo;       //获取RTTI结构lTypeData := GetTypeData(lTypeInfo);lcount := lTypeData.PropCount;aList.Add(TMyType.ClassName);GetMem(lPropList, SizeOf(TPropInfo) * lcount);tryGetPropInfos(lTypeInfo, lPropList);         //获取属性列表for i := 0 to lcount - 1 dobeginlkind := InttoStr(Ord(lPropList[i]^.PropType^.Kind));lname := lPropList[i]^.PropType^.Name;aList.Add('kind:' + lkind + ' name:' + lname)end;finallyFreeMem(lPropList);     //记得释放数组的内容end;
end;procedure TForm2.btn1Click(Sender: TObject);
varlt: Tstringlist;i: integer;
beginlt := Tstringlist.Create;tryvisit(lt);mmo1.Lines.Clear;mmo1.Lines.AddStrings(lt);finallylt.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 recordPropCount: Word;     //属性个数PropList: record end;{PropList: array[1..PropCount] of TPropInfo}     //属性列表end;

TPropInfo结构如下：

  PPropInfo = ^TPropInfo;TPropInfo = packed recordPropType: 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;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, TypInfo;type
{$M+}TBaseType = classpublicData: Variant;end;TMyType = classMyDefault: TBaseType;privateMyPublished: TBaseType;FID: Integer;protectedFMyProtected: TBaseType;publicMyPulbic: Variant;publishedproperty 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:200PParamData = ^TParamData;TParamData = recordFlags: TParamFlags;ParamName: ShortString;TypeName: ShortString;end;TMyMethod = function(a: array of char; var b: TObject): Boolean of object;procedure GetMethodInfo(aTypeInfo: PTypeInfo; aList: TStrings);varForm2: TForm2;implementation{$R *.dfm}//根据给定的枚举，获得对应的枚举名称
function GetParamFlagsName(aParamFlags: TParamFlags): string;
vari: Integer;
beginResult := '';for i := 0 to Ord(High(TParamFlag)) dobeginif i = Integer(pfAddress) then Continue;if TParamFlag(i) in aParamFlags thenResult := Result + ' - ' + GetEnumName(TypeInfo(TParamFlag), i);end;
end;procedure GetMethodInfo(aTypeInfo: PTypeInfo; aList: TStrings);
varlTypeData: PTypeData;lParamCount: Integer;lpTypeStr : PShortString;lParamData : PParamData;i: Integer;
beginlTypeData := 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 dobegin//每次长度不确定，需要使用指针步进方式取内容lpTypeStr := Pointer(Integer(@lParamData^.ParamName) + Length(lParamData^.ParamName) + 1);aList.Add(Format('%s - %s : %s', [GetParamFlagsName(lParamData^.Flags), lParamData^.ParamName, lpTypeStr^]));//移到下一个datalParamData := PParamData(Integer(lParamData) + SizeOf(TParamFlags) +Length(lParamData^.ParamName) + Length(lpTypeStr^) + 2);end;aList.Add('--------------------');
end;procedure TForm2.btn2Click(Sender: TObject);
varlt : TStringList;
beginlt := TStringList.Create;tryGetMethodInfo(TypeInfo(TMyMethod), lt);       //将对应方法的typeInfo传进去GetMethodInfo(TypeInfo(TMouseEvent), lt);mmo1.Lines.Clear;mmo1.Lines.AddStrings(lt);finallylt.Free;end;
end;end.

输出结果如图：

结束语

亲身体会，在一个几十万行代码的项目中，每次修改东西都要找很久才能找到对应的类和方法。为了防止盲目的寻找，可以在交互界面上，在鼠标事件加上输出对应Sender的RTTI信息（如：点击某个按钮时，输出某个按钮的所属的类名，点击事件的方法名），这样寻找起来，一键定位，特别方便。

参考

http://pages.cs.wisc.edu/~rkennedy/vmt#vmtInstanceSize
Delphi RTTI浅析