Блог

Я пытаюсь разработать некоторый код для выполнения общих вызовов методов по его имени. Например, кто-то из Интернета отправляет мне текст как ‘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

Соглашение о вызовах pascal передает параметры слева направо, тогда как cdecl передает их справа налево. Чтобы учесть это различие, просто измените порядок, в котором параметры помещаются в стек:

 for I := High(FArgs) downto 0 do // cdecl => right to left
  

 for I := 0 to High(FArgs) do // pascal => left to right
  

 asm
  push [MethodData]
end;
  

 asm // cdecl => we must clean up
  add esp, [ByteCount]
end;
  

 // pascal => do nothing
  

 { Create a zero filled buffer for functions that want more arguments than
  specified. }
asm
  ...
end;