Delphi2009初体验 语言篇 反射单元ObjAuto的加强

一、提出问题

在将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结构体：

我们来分析一下，结构体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.

 代码运行结果：