Delphi按名字调用方法高级解决方案

转帖于https://lfzhs.iteye.com/blog/980200

按名字调用方法似乎一直以来都是大家比较关注的技术，在论坛上有一个经典的答复：

type
    TProcedure = procedure(Test: string) of object;
 
  procedure ExecuteRoutine(Obj: TObject; Name, Param: string);
  var
    PMethod: TMethod;
    AProcedure: TProcedure;
  begin
    PMethod.Data := Pointer(Obj);
    PMethod.Code := Obj.MethodAddress(Name);
    if Assigned(PMethod.Code) then
    begin
      AProcedure := TProcedure(PMethod);
      AProcedure(Param);
    end;
  end;

使用：待调用方法声明为某个类的 published 方法，Obj 为拥有待调用方法的类的
实例，Name 和 Param 分别为待调用方法的名字和参数。

但是这个办法有一个很大的局限性：一旦 TProcedure 声明定了下来，待调用方法的参
数表也就一定了。要是我定义了多个待调用方法，且参数个数、类型、返回值均不同，
则这个办法也就无能为力了。另：用 GetProcAddress 代替 MethodAddress 也可以实
现类似的效果，不过我们今天讨论的是调用类的“方法”，而它所返回的不是“方法”，
因为 GetProcAddress 仅能取得应用程序的输出（exports）了的过程或函数，这些过
程或函数不属于任何类，也就称不上“方法”。当然，效果类似，但是局限也类似 :-(

那么要是参数的个数、类型均可变就无法解决了吗？（要是这样就不会有本文了）通过
研究，我发现了一种行之有效的办法：Format 函数（注意，不是 DOS 命令，呵呵）相
信大家都不陌生吧，传入它的参数的个数和类型不都是可变的吗？只要声明如下：

procedure AProc(Param: array of const);

即可这样调用：

 AProc([123, 'X', True, 'hello'...]);

有朋友可能要说了，那不就简单了，这样不就可以了：

type
    TProcedure = procedure(Params: array of const) of object;
 
  procedure ExecuteRoutine(Obj: TObject; Name: string; Params: array of const);
  var
    ...
  begin
    ...
      AProcedure(Params);
    ...
  end;

别急，问题才刚刚出现呢，你运行试一试？出问题了吧。（为方便起见，暂时称我们的
 ExecuteRoutine 函数，为控制函数；待调用方法简称为待调方法）这个形参表的声明
办法的确适合我们的控制函数，但是不适合待调方法。为什么？因为待调方法的形参表
的确不是这样（array of const）的啊。当然了，你说你把所有待调方法的形参表都改
成这个样子不就可以了？且不说你需要改动多少东西（包括待调函数的参数表和内部实
现，关键是内部实现部分），就看看你改了过后的待调方法的形参表，全部都成了一个
模样。说不定到时候你自己都不知道到底应该传什么参数进去了。因此，我们应该尽量
保持待调方法的形参表。

现在问题转化为了在控制函数中已知待调方法的地址及其参数列表（存放在一个
 TVarRec 的数组中），如何在调用它的时候将参数传进去。这需要几点预备知识：

1. 首先我们来看看传进来的这个参数表：Params。它的类型被 Delphi 称作可变开
放数组（Variant open array），等价于 array of TVarRec，也就是说 Params 是一
个成员为 TVarRec 的数组。换句话说，在参数被传进 Params 的时候，各种类型都被
 Delphi 自动转化为了 TVarRec（参见帮助中的 Variant open array parameters 一
节）。看一下 TVarRec 的定义可知，它实际储存的数据域为 4 Bytes，超过 4 Bytes 
的只存指针，需要注意的是 TVarRec 的大小是 8 Bytes（经研究发现前 4 Bytes 存放
数据，第 5 Byte 为类型）。

2. 调用函数时的参数传递的一般情况（未使用 stdcall 的情况）。对于一般的函数
或过程，前三个参数分别放在 EAX、EDX、ECX，后面如果还有更多参数的话，就在堆栈
里面；对于类的方法，EAX 固定用于存放类实例的地址，EDX、ECX 分别存放前两个参
数，其余参数进栈。在堆栈中每个元素占用 4 Bytes，而前面说了，TVarRec 中储存的
数据也是 4 Bytes，刚好一个参数在堆栈里面占一个位子，处理方便。另外，结果返回
到 EAX 中。

3. 对于调用类的方法，其实有一个默认的隐藏参数 Self 作为第一个参数传入，放
入 EAX 寄存器。因此我们看到的第一参数其实是第二个，因此我们处理的时候要注意。

4. 用 ObjectPascal 语法调用方法，Delphi 会自动帮我们处理参数的传递问题，而
在汇编里面调用任何函数之前都需要先手动设置各参数。

因此，我决定用内嵌汇编的办法来解决参数传递问题：如果是一个参数，放入 EDX；若
为两个参数，分别放入 EDX，ECX；对多于两个参数的情况，用 参数个数 - 2 个循环依
次将后续参数进栈。然后将拥有待调方法的实例地址传入 EAX，就可以 CALL 了。

function ExecuteRoutine(AObj: TObject; AName: string;
    Params: array of const): DWord;
  const
    RecSize = SizeOf(TVarRec); // 循环处理参数列表时递增的字节数
  var
    PFunc: Pointer;
    ParCount: DWord;
  begin
    if not Assigned(AObj) then
      raise Exception.Create ('你确定传进来的是一个对象？');
    PFunc := AObj.MethodAddress(AName); // 获取方法地址
    if not Assigned(PFunc) then
      raise Exception.CreateFmt('找不到 %s 的 Method: %s', [AObj.ClassName,
        AName]);
 
    ParCount := High(Params) + 1; // 获取参数个数
 
    asm
      PUSH        ESI                 // 保存 ESI，我们待会儿要用到它
 
      MOV         ESI, Params         // ESI 指向参数表首址
      CMP         ParCount, 1         // 判断参数个数
      JB          @NoParam
      JE          @OneParam
      CMP         ParCount, 2
      JE          @TwoParams
 
    @ManyParams: // 超过两个参数
      CLD                             // 清空方向标志
      MOV         ECX, ParCount
      SUB         ECX, 2              // 循环 ParCount - 2 次
      MOV         EDX, RecSize        // EDX 依次指向每个参数的首址，每次递增 8 Bytes
      ADD         EDX, RecSize        // 跳过前两个参数
    @ParamLoop:
      MOV         EAX, [ESI][EDX]     // 用基址变址寻址方式取得一个参数
      PUSH        EAX                 // 参数进栈
      ADD         EDX, RecSize        // EDX 指向下一个参数首址
      LOOP        @ParamLoop
 
    @TwoParams: // 两个参数
      MOV         ECX, [ESI] + RecSize
 
    @OneParam: // 一个参数
      MOV         EDX, [ESI]
 
    @NoParam:
      MOV         EAX, AObj           // 传入实例地址（即，隐藏参数 Self）
      CALL        PFunc               // 调用方法
      MOV         Result, EAX         // 返回值放入 Result
 
      POP         ESI                 // 记得还原
    end;
  end;

前面已经说过了，任何类型都可以塞进 4 Bytes，因此将返回值定义为 DWord，你可以
根据自己的需要进行类型转换。这个办法最大限度地保护了待调方法，但也不是完全不
用修改，只有一个地方需要作出适当调整：与 DLL 中的函数返回值一样（别告诉我引用
 ShareMem，那不属于本文讨论的范畴），如果要返回一个长 string，请改为 PChar，
并注意申请必要的空间。

以下是一个使用的例子（再次提醒一下，待调方法必须是某个类的 published 方法）：

TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  published // 几个待调方法
    function TowInt(I, J: Integer): Integer;
    function ThreeInt(I, J, K: Integer): Integer;
    function FiveInt(X1, X2, X3, X4, X5: Integer): Integer;
    function ThreeChar(I, J, K: Char): PChar;
    function TwoStr(X, Y: string): PChar;
    function IntNBool(I: Integer; B: Boolean): Boolean;
  end;
 
  ...
 
  function ExecuteRoutine(AObj: TObject; AName: string;
    Params: array of const): DWord;
  ...
 
  function TForm1.TowInt(I, J: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d', [I, J]));
    Result := I + J;
  end;
 
  function TForm1.ThreeInt(I, J, K: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d + %d', [I, J, K]));
    Result := I + J + K;
  end;
 
  function TForm1.FiveInt(X1, X2, X3, X4, X5: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d + %d + %d + %d', [X1, X2, X3, X4, X5]));
    Result := X1 + X2 + X3 + X4 + X5;
  end;
 
  function TForm1.ThreeChar(I, J, K: Char): PChar;
  var
    Res: string;
  begin
    ShowMessage(Format('%s + %s + %s', [I, J, K]));
    Res := I + J + K;
    Result := AllocMem(Length(Res) + 1);
    StrPCopy(Result, Res);
  end;
 
  function TForm1.TwoStr(X, Y: string): PChar;
  var
    Res: string;
  begin
    ShowMessage(Format('%s + %s', [X, Y]));
    Res := X + Y;
    Result := AllocMem(Length(Res) + 1);
    StrPCopy(Result, Res);
  end;
 
  function TForm1.IntNBool(I: Integer; B: Boolean): Boolean;
  begin
    if B then
      ShowMessage(IntToStr(I) + ' and True')
    else
      ShowMessage(IntToStr(I) + ' and False');
 
    Result := B;
  end;
 
  procedure TForm1.Button1Click(Sender: TObject);
  var
    i: Integer;
    b: Boolean;
    s: string;
  begin
    i := ExecuteRoutine(Self, 'ThreeInt', [10, 23, 17]);
    ShowMessage('Result: ' + IntToStr(i));
 
    i := ExecuteRoutine(Self, 'FiveInt', [1, 2, 3, 4, 5]);
    ShowMessage('Result: ' + IntToStr(i));
 
    b := Boolean(ExecuteRoutine(Self, 'IntNBool', [10, False]));
    if b then
      ShowMessage('Result: True')
    else
      ShowMessage('Result: False');
 
    s := PChar(ExecuteRoutine(Self, 'ThreeChar', ['a', 'b', 'c']));
    ShowMessage('Result: ' + s);
 
    s := PChar(ExecuteRoutine(Self, 'TwoStr', ['hello', ' world']));
    ShowMessage('Result: ' + s);
  end;
 
  ...

我之所以称该办法为高级解决方案，而非终极，因为它仍然有一个问题没有解决：变参
问题。但是这不是什么大问题，因为完全可以用函数返回值代替变参。啊？你要返回多
个值？那建议返回一个指向结构体的指针，或一个最简单的对象。

TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  published // 几个待调方法
    function TowInt(I, J: Integer): Integer;
    function ThreeInt(I, J, K: Integer): Integer;
    function FiveInt(X1, X2, X3, X4, X5: Integer): Integer;
    function ThreeChar(I, J, K: Char): PChar;
    function TwoStr(X, Y: string): PChar;
    function IntNBool(I: Integer; B: Boolean): Boolean;
  end;
 
  ...
 
  function ExecuteRoutine(AObj: TObject; AName: string;
    Params: array of const): DWord;
  ...
 
  function TForm1.TowInt(I, J: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d', [I, J]));
    Result := I + J;
  end;
 
  function TForm1.ThreeInt(I, J, K: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d + %d', [I, J, K]));
    Result := I + J + K;
  end;
 
  function TForm1.FiveInt(X1, X2, X3, X4, X5: Integer): Integer;
  begin
    ShowMessage(Format('%d + %d + %d + %d + %d', [X1, X2, X3, X4, X5]));
    Result := X1 + X2 + X3 + X4 + X5;
  end;
 
  function TForm1.ThreeChar(I, J, K: Char): PChar;
  var
    Res: string;
  begin
    ShowMessage(Format('%s + %s + %s', [I, J, K]));
    Res := I + J + K;
    Result := AllocMem(Length(Res) + 1);
    StrPCopy(Result, Res);
  end;
 
  function TForm1.TwoStr(X, Y: string): PChar;
  var
    Res: string;
  begin
    ShowMessage(Format('%s + %s', [X, Y]));
    Res := X + Y;
    Result := AllocMem(Length(Res) + 1);
    StrPCopy(Result, Res);
  end;
 
  function TForm1.IntNBool(I: Integer; B: Boolean): Boolean;
  begin
    if B then
      ShowMessage(IntToStr(I) + ' and True')
    else
      ShowMessage(IntToStr(I) + ' and False');
 
    Result := B;
  end;
 
  procedure TForm1.Button1Click(Sender: TObject);
  var
    i: Integer;
    b: Boolean;
    s: string;
  begin
    i := ExecuteRoutine(Self, 'ThreeInt', [10, 23, 17]);
    ShowMessage('Result: ' + IntToStr(i));
 
    i := ExecuteRoutine(Self, 'FiveInt', [1, 2, 3, 4, 5]);
    ShowMessage('Result: ' + IntToStr(i));
 
    b := Boolean(ExecuteRoutine(Self, 'IntNBool', [10, False]));
    if b then
      ShowMessage('Result: True')
    else
      ShowMessage('Result: False');
 
    s := PChar(ExecuteRoutine(Self, 'ThreeChar', ['a', 'b', 'c']));
    ShowMessage('Result: ' + s);
 
    s := PChar(ExecuteRoutine(Self, 'TwoStr', ['hello', ' world']));
    ShowMessage('Result: ' + s);
  end;
 
  ...