【Delphi】简单测试虚拟方法表 VMT

来源：互联网发布：python 遍历嵌套字典编辑：程序博客网时间：2024/04/29 22:33

简单测试虚拟方法表 VMT。

创建一个空白窗体，再创建一个 TMemo（mmo1）和一个 TButton（btn1）代码如下：

unit Form1Unit;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls;type  TForm1 = class(TForm)    mmo1: TMemo;    btn1: TButton;    procedure btn1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end;var  Form1: TForm1;implementation{$R *.dfm}{ 将字符串延伸到指定长度 }function FormatStrLen(Str: string; Len: Cardinal = 25):string;begin  while Length(Str) < Len do Str := Str + ' ';  Result := Str;end;{ 获取对象的 VMT 地址 }function GetVmtAddr(aObj: TObject): Pointer; overload;begin  Result := PPointer(aObj)^;end;{ 获取类的 VMT 地址 }function GetVmtAddr(aClass: TClass): Pointer; overload;begin  Result := Pointer(aClass);end;{ 获取 VMT 项目的字符串名称，参考 System 单元第 222 行 }function GetVMTEntryName(const iEntry: Integer): string;begin  case iEntry of    vmtAddRef:            Result := 'vmtAddRef';    vmtAfterConstruction: Result := 'vmtAfterConstruction';    vmtAutoTable:         Result := 'vmtAutoTable';    vmtBeforeDestruction: Result := 'vmtBeforeDestruction';    vmtClassName:         Result := 'vmtClassName';    vmtCreateObject:      Result := 'vmtCreateObject';    vmtDefaultHandler:    Result := 'vmtDefaultHandler';    vmtDestroy:           Result := 'vmtDestroy';    vmtDispatch:          Result := 'vmtDispatch';    vmtDynamicTable:      Result := 'vmtDynamicTable';    vmtEquals:            Result := 'vmtEquals';    vmtFieldTable:        Result := 'vmtFieldTable';    vmtFreeInstance:      Result := 'vmtFreeInstance';    vmtGetHashCode:       Result := 'vmtGetHashCode';    vmtInitTable:         Result := 'vmtInitTable';    vmtInstanceSize:      Result := 'vmtInstanceSize';    vmtIntfTable:         Result := 'vmtIntfTable';    vmtMethodTable:       Result := 'vmtMethodTable';    vmtNewInstance:       Result := 'vmtNewInstance';    vmtParent:            Result := 'vmtParent';    vmtQueryInterface:    Result := 'vmtQueryInterface';    vmtRelease:           Result := 'vmtRelease';    vmtSafeCallException: Result := 'vmtSafeCallException';    vmtSelfPtr:           Result := 'vmtSelfPtr';    vmtToString:          Result := 'vmtToString';    vmtTypeInfo:          Result := 'vmtTypeInfo';  end;end;{ 获取 VMT 项目的内存地址 }function GetVMTEntryAddr(pVMTAddr: Pointer;  const iEntry: Integer): Pointer;begin  Result := Pointer(Integer(pVMTAddr) + iEntry);end;{ 获取 VMT 项目的数据 }function GetVMTEntryData(pVMTAddr: Pointer;  const iEntry: Integer): Longint;begin  Result := PInteger(GetVMTEntryAddr(pVMTAddr, iEntry))^;end;{ 显示单个 VMT 项目的地址 }function ShowVMTEntryAddr(pVMTAddr: Pointer; const iEntry: Integer): string;var  sEntryName: string;  pEntryAddr: Pointer;begin  sEntryName := FormatStrLen(GetVMTEntryName(iEntry));  pEntryAddr := GetVMTEntryAddr(pVMTAddr, iEntry);  Result := Format('%s : %x', [sEntryName, Integer(pEntryAddr)]);end;{ 显示单个 VMT 项目的数据 }function ShowVMTEntryData(pVMTAddr: Pointer; const iEntry: Integer): string;var  sEntryName: string;  iEntryData: LongInt;begin  sEntryName := FormatStrLen('(VMT + ' + GetVMTEntryName(iEntry) + ')^');  iEntryData := GetVMTEntryData(pVMTAddr, iEntry);  Result := Format('%s = %d', [sEntryName, Integer(iEntryData)]);end;{ 显示所有 VMT 项目的地址 }function ShowAllVMTEntryAddr(pVMTAddr: Pointer): string;begin  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtSelfPtr) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtIntfTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtAutoTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtInitTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtTypeInfo) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtFieldTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtMethodTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtDynamicTable) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtClassName) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtInstanceSize) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtParent) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtEquals) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtGetHashCode) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtToString) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtSafeCallException) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtAfterConstruction) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtBeforeDestruction) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtDispatch) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtDefaultHandler) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtNewInstance) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtFreeInstance) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtDestroy) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtQueryInterface) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtAddRef) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtRelease) + sLineBreak;  Result := Result + ShowVMTEntryAddr(pVMTAddr, vmtCreateObject);end;{ 通过 InstanceSize 来检测 VMT 地址是否获取正确 }procedure TForm1.btn1Click(Sender: TObject);  { 格式化显示输出 }  function ShowInfo(Str: string; Num: LongInt): string;  begin    Result := FormatStrLen(Str) + ' = ' + IntToStr(Num);  end;begin  mmo1.Clear;  mmo1.SetFocus;  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 Self 的所有 VMT 地址】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowAllVMTEntryAddr(GetVmtAddr(Self)));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 Self 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('Self.InstanceSize', Self.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(GetVmtAddr(Self), vmtInstanceSize));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 TForm1 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('TForm1.InstanceSize', TForm1.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(Pointer(TForm1), vmtInstanceSize));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 TForm 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('TForm.InstanceSize', TForm.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(Pointer(TForm), vmtInstanceSize));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 Button1 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('btn1.InstanceSize', btn1.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(GetVmtAddr(btn1), vmtInstanceSize));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 TButton 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('TButton.InstanceSize', TButton.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(Pointer(TButton), vmtInstanceSize));  mmo1.Lines.Add('');  mmo1.Lines.Add('--------------------------------------------------');  mmo1.Lines.Add('【显示 TObject 的 InstanceSize 信息】');  mmo1.Lines.Add('');  mmo1.Lines.Add(ShowInfo('TObject.InstanceSize', TObject.InstanceSize));  mmo1.Lines.Add(ShowVMTEntryData(Pointer(TObject), vmtInstanceSize));  mmo1.SelStart := 0;  mmo1.SelLength := 0;end;end.

执行结果如下：

--------------------------------------------------【显示 Self 的所有 VMT 地址】vmtSelfPtr                : 4B15E4vmtIntfTable              : 4B15E8vmtAutoTable              : 4B15ECvmtInitTable              : 4B15F0vmtTypeInfo               : 4B15F4vmtFieldTable             : 4B15F8vmtMethodTable            : 4B15FCvmtDynamicTable           : 4B1600vmtClassName              : 4B1604vmtInstanceSize           : 4B1608vmtParent                 : 4B160CvmtEquals                 : 4B1610vmtGetHashCode            : 4B1614vmtToString               : 4B1618vmtSafeCallException      : 4B161CvmtAfterConstruction      : 4B1620vmtBeforeDestruction      : 4B1624vmtDispatch               : 4B1628vmtDefaultHandler         : 4B162CvmtNewInstance            : 4B1630vmtFreeInstance           : 4B1634vmtDestroy                : 4B1638vmtQueryInterface         : 4B163CvmtAddRef                 : 4B1640vmtRelease                : 4B1644vmtCreateObject           : 4B1648--------------------------------------------------【显示 Self 的 InstanceSize 信息】Self.InstanceSize         = 916(VMT + vmtInstanceSize)^  = 916--------------------------------------------------【显示 TForm1 的 InstanceSize 信息】TForm1.InstanceSize       = 916(VMT + vmtInstanceSize)^  = 916--------------------------------------------------【显示 TForm 的 InstanceSize 信息】TForm.InstanceSize        = 908(VMT + vmtInstanceSize)^  = 908--------------------------------------------------【显示 btn1 的 InstanceSize 信息】btn1.InstanceSize         = 716(VMT + vmtInstanceSize)^  = 716--------------------------------------------------【显示 TButton 的 InstanceSize 信息】TButton.InstanceSize      = 716(VMT + vmtInstanceSize)^  = 716--------------------------------------------------【显示 TObject 的 InstanceSize 信息】TObject.InstanceSize      = 8(VMT + vmtInstanceSize)^  = 8