Question

我正在尝试开发一些代码来通过它的名称对方法进行泛型调用。例如，某个来自网络的人发给我一个文本'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

Answer 1

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

您无法检查是否收到了正确数量的参数。您所能做的就是确保从函数返回时的堆栈指针与开始推送参数之前的堆栈指针相同。

Answer 2

我同意，但我认为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）参数的错误类型（或顺序）

我认为您必须找到其他解决方案。

将调用方法Cdecl约定转换为调用方法pascal约定

2 个答案: