Delphi的RTTI&VMT

網上已經有很多關於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淺析

概念

VMT

詳細介紹

RTTI詳情

結束語

參考

vue項目獲取富文本編輯器wangEditor內容導出爲word（html轉word格式並下載）

dotnet C# 創建 X11 應用時設置窗口背景顏色

Navicat安裝與激活教程

TDengine docker安裝方法

vue3組件通信與props

sapui5

Alpine Linux apk add DNS lookup error

部分JDK版本的發佈時間

工作中用到的腳本合集

合併代碼時Beyond Compare設置

Delphi 環境下使用DirectDraw實現簡單的繪製

Delphi調用C++的對象

delphi strict final用途

c++實現大根堆

c++實現跳躍表

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結