我正在尝试开发一些代码来通过它的名称对方法进行泛型调用。 例如，某个来自网络的人发给我一个文本'TTest.MethodTest.Param1.Param2'，我找到了这个类，并用它的名字和参数调用它。 好吧，我这样做了，我从安德烈亚斯·豪斯拉登那里得到了一些代码，但是在我需要的地方做了很少的调整。但是，ExecuteAsyncCall的实现是为cdecl函数创建的，我需要更改它的代码以使用pascal约定方法。
以下是代码示例，如果有人想测试的话。 有人能帮帮我吗？我正在研究解决这个问题，但这对我来说很复杂。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
published
{ Public declarations }
procedure Test(AString: string; AInteger: Integer); cdecl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CopyVarRec(const Data: TVarRec): TVarRec;
begin
if (Data.VPointer <> nil) and
(Data.VType in [vtString, vtAnsiString, vtWideString,
{$IFDEF UNICODE}vtUnicodeString,{$ENDIF} vtExtended,
vtCurrency, vtInt64, vtVariant, vtInterface]) then
begin
Result.VType := Data.VType;
Result.VPointer := nil;
{ Copy and redirect TVarRec data to prevent conflicts with other threads,
especially the calling thread. Otherwise reference counted types could
be freed while this asynchron function is still executed. }
case Result.VType of
vtAnsiString: AnsiString(Result.VAnsiString) := AnsiString(Data.VAnsiString);
vtWideString: WideString(Result.VWideString) := WideString(Data.VWideString);
{$IFDEF UNICODE}
vtUnicodeString: UnicodeString(Result.VUnicodeString) := UnicodeString(data.VUnicodeString);
{$ENDIF UNICODE}
vtInterface : IInterface(Result.VInterface) := IInterface(Data.VInterface);
vtString : begin New(Result.VString); Result.VString^ := Data.VString^; end;
vtExtended : begin New(Result.VExtended); Result.VExtended^ := Data.VExtended^; end;
vtCurrency : begin New(Result.VCurrency); Result.VCurrency^ := Data.VCurrency^; end;
vtInt64 : begin New(Result.VInt64); Result.VInt64^ := Data.VInt64^; end;
vtVariant : begin New(Result.VVariant); Result.VVariant^ := Data.VVariant^; end;
end;
end
else
Result := Data;
end;
function ExecuteAsyncCall(AProc: Pointer; MethodData: TObject; const AArgs: array of const): Integer;
var
I: Integer;
V: ^TVarRec;
ByteCount: Integer;
FArgs: array of TVarRec;
FProc: function: Integer register;
begin
FProc := AProc;
SetLength(FArgs, 1 + Length(AArgs));
// insert "Self"
FArgs[0].VType := vtObject;
FArgs[0].VObject := MethodData;
for I := 0 to High(AArgs) do
FArgs[I + 1] := CopyVarRec(AArgs[I]);
ByteCount := Length(FArgs) * SizeOf(Integer) + $40;
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
xor eax, eax
mov ecx, $40 / 8
@@FillBuf:
push eax
push eax
// push eax
dec ecx
jnz @@FillBuf
end;
for I := High(FArgs) downto 0 do // cdecl => right to left
begin
V := @FArgs[I];
case V.VType of
vtInteger: // [const] Arg: Integer
asm
mov eax, V
push [eax].TVarRec.VInteger
end;
vtBoolean, // [const] Arg: Boolean
vtChar: // [const] Arg: AnsiChar
asm
mov eax, V
xor edx, edx
mov dl, [eax].TVarRec.VBoolean
push edx
end;
vtWideChar: // [const] Arg: WideChar
asm
mov eax, V
xor edx, edx
mov dx, [eax].TVarRec.VWideChar
push edx
end;
vtExtended: // [const] Arg: Extended
asm
add [ByteCount], 8 // two additional DWORDs
mov eax, V
mov edx, [eax].TVarRec.VExtended
movzx eax, WORD PTR [edx + 8]
push eax
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtCurrency, // [const] Arg: Currency
vtInt64: // [const] Arg: Int64
asm
add [ByteCount], 4 // an additional DWORD
mov eax, V
mov edx, [eax].TVarRec.VCurrency
push DWORD PTR [edx + 4]
push DWORD PTR [edx]
end;
vtString, // [const] Arg: ShortString
vtPointer, // [const] Arg: Pointer
vtPChar, // [const] Arg: PChar
vtObject, // [const] Arg: TObject
vtClass, // [const] Arg: TClass
vtAnsiString, // [const] Arg: AnsiString
{$IFDEF UNICODE}
vtUnicodeString, // [const] Arg: UnicodeString
{$ENDIF UNICODE}
vtPWideChar, // [const] Arg: PWideChar
vtVariant, // const Arg: Variant
vtInterface, // [const]: IInterface
vtWideString: // [const] Arg: WideString
asm
mov eax, V
push [eax].TVarRec.VPointer
end;
end;
end;
Result := FProc;
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecuteAsyncCall(Self.MethodAddress('Test'), Self, ['Test ', 1])
end;
procedure TForm1.Test(AString: string; AInteger: Integer);
begin
ShowMessage(AString + IntToStr(AInteger));
end;
end.
ATT。
Obs：我正在研究Delphi 2007
答案 0 :(得分：3)
pascal调用约定从左到右传递参数，而cdecl从右到左传递参数。为了解释这种差异，只需颠倒参数被推入堆栈的顺序：
for I := High(FArgs) downto 0 do // cdecl => right to left
for I := 0 to High(FArgs) do // pascal => left to right
接下来，方法的Self参数在pascal约定中传递 last 而不是第一个。实际效果是，在两个约定中，Self是推入堆栈的最后一个参数。你可以将它添加到FArgs数组的末尾，但如果这是我的代码，我只需在主参数循环后手动推送它（这也可以省略第二个完全参数数组：
asm
push [MethodData]
end;
最后，在pascal约定中，接收器清理堆栈，而在cdecl中，调用者清理它。删除此代码：
asm // cdecl => we must clean up
add esp, [ByteCount]
end;
// pascal => do nothing
该代码还允许使用更少的参数调用函数，而不是目标函数所期望的。它分配一个40字节的缓冲区并用零填充它。但是，这不适用于pascal函数。 pascal函数总是从堆栈中弹出相同数量的参数，因此如果在调用时提供了错误数量的参数，则在函数返回时最终会丢弃堆栈。删除注释下面的汇编程序块：
{ Create a zero filled buffer for functions that want more arguments than
specified. }
asm
...
end;
您无法检查是否收到了正确数量的参数。您所能做的就是确保从函数返回时的堆栈指针与开始推送参数之前的堆栈指针相同。
答案 1 :(得分：1)
我同意，但我认为Self必须被推到最后：
http://docwiki.embarcadero.com/RADStudio/en/Program_Control
// insert "Self"
for I := 0 to High(AArgs) do
FArgs[I] := CopyVarRec(AArgs[I]);
FArgs[High(AArgs)+1].VType := vtObject;
FArgs[High(AArgs)+1].VObject := MethodData;
但我不相信这段代码可以使用而且会崩溃：
1）所有方法的所有参数必须是变体
2）参数数量错误
3）参数的错误类型（或顺序）
我认为您必须找到其他解决方案。