销售管理软件版1楼: 如题

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

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; 如记账软件推荐

3楼: 在包里面不能这样调用的吧，这个只是调用另外一个窗体的pubished的方法， 我想要的是如在调用dll时的GetProcAddress

4楼: type
TFunc = function(fileName: Pchar):boolean;stdcall;
var
Func: TFunc;
dllHand: Cardinal;
fn:String;
begin
dllHand:= LoadLibrary(PChar(＇＇111.dll＇＇));//dll name
if dllhand > 0 then
begin
Func:= TFunc(GetProcAddr(dllHand,PChar(＇＇funcName＇＇))); //function name
if @Func <> nil then
begin
Func(fn);//call the function
...
end
else
showmessage(＇＇function not find＇＇);
end
else
showMessage(＇＇dll is wrong＇＇);
end;

5楼: to rabbitlzx
是调用bpl包里面的过程，不是调用dll的过程

6楼: procedure Tmainfrm.loadpkbyname(pkname:string);
var
pkobject:THandle;
CreateNewObject:TCreateNewObject;
begin
pkname:=＇＇PKlib＼＇＇+pkname; // package dir
pkobject:=Loadpackage(pkname);
@CreateNewObject:=GetprocAddress(pkobject,＇＇CreateObject＇＇);
if integer(@CreateNewObject)>0 then application.messagebox(＇＇包加载失败!＇＇,＇＇Load Package＇＇,48)
else
createnewobject;

end;

销售管理软件版7楼: TCreateNewObject是过程的定义吗？
我试了一下，找是能找到，不过执行createnewobject出现地址访问错误，
还有我是想调用静态包里面的过程
这句pkobject:=Loadpackage(pkname); 可不可以用其它的代替

8楼: 是我理解错了，应该是动态包中的过程或函数

9楼: 搞定，发分

10楼: 多人接受答案了。