一、提出問題
在將json-rpc中JSONObject翻譯成Delphi代碼的時候，我碰到以下語句：
1 Method[] methods = klass.getMethods();
2 …
3 Method method = methods[i];
4 …
5 if (key.length() > 0 &&
6 Character.isUpperCase(key.charAt(0)) &&
7 method.getParameterTypes().length == 0) {
8 …
9 }
10
很明顯，這裡是通過反射得到類中包含的函數的信息及函數所包含的參數信息。當我在Delphi2009中興奮的引入ObjAuto文件時，我沮喪的發現，ObjAuto中只提供了GetMethods方法，沒有提供類似於Java中getParameterTypes方法的GetParams方法。沒關系，Delphi的SDK不提供，我們就根據VMT表，自己寫一個GetParams函數出來！
二、分析問題
我們知道，在Delphi中對象是在堆中存放的。而對象在堆中存放的前四個字節組成一個地址，這個地址指向的是此對象所對應的VMT所在堆中的地址。VMT可以理解為Delphi對象所對應的類在堆中存放的組成形式的描述，它是類的結構，不包含對象的數據。有關VMT的更多信息，請百度一下、Google一下，或查看以下兩篇文章：
1、Delphi中類的運行期TypeInfo信息結構說明
2、DELPHI的原子世界
類中的函數及函數的參數信息在VMT中也有存放，我們只要知道這些信息是如何存放的，所有事情都變得簡單了。下面我畫出在VMT中表示函數信息的那一塊結構：
從上圖我們可以看到，在VMT中每個函數結構都包含了一個TMethodInfoHeader頭，一個TReturnInfo返回值結構，若干個TParamInfo參數結構。參數的個數我們是沒有辦法直接獲取的，但是我們可以通過指針往下遍歷，直到指針的值大於TMethodInfoHeader.Len為止，累加參數的個數。
*1：為什麼是SizeOf(TMethodInfoHeader) – 255 + Length(mi1.Name)字節呢？
首先我們來看TMethodInfoHeader結構體：
1 TMethodInfoHeader = record
2 Len: Word;
3 Addr: Pointer;
4 Name: ShortString;
5 end;
我們來分析一下，結構體TMethodInfoHeader所占的字節（SizeOf(TMethodInfoHeader)）為SizeOf(Word) + SizeOf(Pointer) + SizeOf(ShortString) = 2 + 4 + 256 = 262。如果Name字段只占了3個字節，SizeOf(TMethodInfoHeader)仍然是262，不受Name字段長度的影響，但是下一個數據是緊挨著Name的3個字節存的，中間不會留空格。
所以，我們必須使用SizeOf(TMethodInfoHeader) – 256 + Length(Name)。另外，由於字符串第0個字節保存的是字符串的長度，我們-256把保存字符串長度的那一位也減掉了，所以得+1：
SizeOf(TMethodInfoHeader) – 256 + Length(Name) + 1 = SizeOf(TMethodInfoHeader) – 255 + Length(Name)
*2：mi1: TMethodInfoHeader的信息我們可以通過ObjAuto.GetMethodInfo方法獲取，我們只要關注如何得到參數信息就可以了。
三、解決問題
通過以上問題的分析，我們可以很容易的寫出兩個函數
1、GetParams：獲取方法所包含的參數信息集合
2、GetReturnInfo：獲取方法的返回參數信息
代碼如下：
uses
SysUtils,
StrUtils,
TypInfo,
ObjAuto;
type
TParamInfoArray = array of PParamInfo;
function GetParams(aObj: TObject; aMethodName: string): TParamInfoArray;
function GetReturnInfo(aObj: TObject; aMethodName: string): PReturnInfo;
implementation
const
SHORT_LEN = SizeOf(ShortString) - 1;
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) - SHORT_LEN then
Exit(nil);
Result := PReturnInfo(Integer(mi) + SizeOf(TMethodInfoHeader) +
Length(mi.Name) - SHORT_LEN);
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) - SHORT_LEN then
Exit;
// 獲取函數尾地址用於遍歷
miEnd := Pointer(Integer(mi) + mi.Len);
// 第一個參數的地址根據以下算法得來
param := PParamInfo(Integer(mi) + SizeOf(TMethodInfoHeader) +
Length(mi.Name) - SHORT_LEN + 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) - SHORT_LEN);
end;
end;
以下是測試代碼：
1program TestChar;
2
3{$APPTYPE CONSOLE}
4
5uses
6 SysUtils,
7 ObjAuto,
8 TypInfo,
9 AutoPtr in '..\..\Djson\common\AutoPtr.pas',
10 Utils in '..\..\Djson\common\Utils.pas';
11
12type
13{$METHODINFO ON}
14 TTestClass = class
15 public
16 function Test3: Integer;
17 procedure Test2(a: string);
18 function Test1(a: string; b: Single): Single;
19 end;
20{$METHODINFO OFF}
21
22var
23 t: TTestClass;
24
25{ TTestClass }
26
27function TTestClass.Test1(a: string; b: Single): Single;
28begin
29
30end;
31
32procedure TTestClass.Test2(a: string);
33begin
34
35end;
36
37function TTestClass.Test3: Integer;
38begin
39
40end;
41
42procedure TestIt;
43var
44 miArr: TMethodInfoArray;
45 mi: PMethodInfoHeader;
46 t: TTestClass;
47 retInfo: PReturnInfo;
48 piArr: TParamInfoArray;
49 pi: PParamInfo;
50 i: Integer;
51begin
52 t := TTestClass.Create;
53
54 miArr := GetMethods(TTestClass);
55 for mi in miArr do
56 begin
57 Writeln('Method: ' + mi.Name);
58
59 retInfo := GetReturnInfo(t, mi.Name);
60 if retInfo.ReturnType <> nil then
61 begin
62 Writeln('ReturnType: ' + retInfo.ReturnType^.Name);
63 end;
64
65 piArr := GetParams(t, mi.Name);
66 if piArr <> nil then
67 begin
68 for pi in piArr do
69 Writeln('Param Name: ' + pi.Name + ' Param Type: ' + pi.ParamType^.Name);
70 end;
71 end;
72
73 t.Free;
74end;
75
76begin
77 TestIt;
78 Readln;
79end.
代碼運行結果：
