Delphi 2009 反射增強：ObjAuto 單元獲取方法參數與返回值信息

突破 ObjAuto 限制：基於 VMT 手寫 GetParams/GetReturnInfo 獲取完整方法簽名

Delphi 2009 ObjAuto 單元僅提供 GetMethods 獲取方法列表，缺失參數與返回類型信息。通過解析 VMT (虛方法表) 結構，實現 GetParams 返回參數數組、GetReturnInfo 返回類型信息。

VMT 方法信息結構分析

• 每個方法包含：TMethodInfoHeader (頭) → TReturnInfo (返回值) → 多個 TParamInfo (參數)
• TMethodInfoHeader.Len 給出整個方法信息塊長度
• 參數數量未知，通過指針遍歷直到超過 Header + Len 邊界計數

關鍵結構定義

TMethodInfoHeader = record
  Len: Word;      Addr: Pointer;  Name: ShortString;
end;
{SizeOf = 262 字節，Name 實際長度 = Length(Name)+1，需修正偏移}

核心實現代碼

uses SysUtils, StrUtils, TypInfo, ObjAuto;
type TParamInfoArray = array of PParamInfo;

function GetReturnInfo(aObj: TObject; aMethodName: string): PReturnInfo;
var mi: PMethodInfoHeader;
begin
  mi := ObjAuto.GetMethodInfo(aObj, ShortString(aMethodName));
  if mi.Len <= SizeOf(TMethodInfoHeader) + Length(mi.Name) - 255 then Exit(nil);
  Result := PReturnInfo(Integer(mi) + SizeOf(TMethodInfoHeader) + Length(mi.Name) - 255);
end;

function GetParams(aObj: TObject; aMethodName: string): TParamInfoArray;
var mi: PMethodInfoHeader; miEnd: Pointer; param: PParamInfo; count: Integer;
begin
  SetLength(Result, 0);
  mi := ObjAuto.GetMethodInfo(aObj, ShortString(aMethodName));
  if mi.Len <= SizeOf(TMethodInfoHeader) + Length(mi.Name) - 255 then Exit;
  miEnd := Pointer(Integer(mi) + mi.Len);
  param := PParamInfo(Integer(mi) + SizeOf(TMethodInfoHeader) + Length(mi.Name) - 255 + SizeOf(TReturnInfo));
  count := 0;
  while Integer(param) < Integer(miEnd) do begin
    Inc(count); SetLength(Result, count); Result[count-1] := param;
    param := PParamInfo(Integer(param) + SizeOf(TParamInfo) + Length(param.Name) - 255);
  end;
end;

測試代碼與輸出

type {$METHODINFO ON} TTestClass = class
public function Test3: Integer; procedure Test2(a: string); function Test1(a: string; b: Single): Single; end; {$METHODINFO OFF}

procedure TestIt;
var miArr: TMethodInfoArray; mi: PMethodInfoHeader; t: TTestClass;
    retInfo: PReturnInfo; piArr: TParamInfoArray; pi: PParamInfo; i: Integer;
begin
  t := TTestClass.Create;
  miArr := GetMethods(TTestClass);
  for mi in miArr do begin
    WriteLn('Method: ' + mi.Name);
    retInfo := GetReturnInfo(t, mi.Name);
    if retInfo.ReturnType <> nil then WriteLn('ReturnType: ' + retInfo.ReturnType^.Name);
    piArr := GetParams(t, mi.Name);
    for pi in piArr do WriteLn('Param: ' + pi.Name + ' Type: ' + pi.ParamType^.Name);
  end;
  t.Free;
end;

輸出結果：

Method: Test1
ReturnType: Single
Param: a Type: String
Param: b Type: Single
Method: Test2
Param: a Type: String
Method: Test3
ReturnType: Integer

應用價值： 實現 JSON-RPC 自動序列化、動態代理、插件系統方法發現、文檔自動生成等反射密集型場景。