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; ...