Question

I’m trying to develop some code to make generic calls to methods by it’s name.
For example, some one from web send me a text as ‘TTest.MethodTest.Param1.Param2’, and I find the class and call it method by it’s name with the parameters.
Ok, I did this, I got some code from Andreas Hausladen did little adjusts to work where I need. But, the implementation of ExecuteAsyncCall, was create to cdecl functions I need to change it’s code to work with pascal convention methods.

Here is the code sample, if some one would like to test.
Some one can help me ? I’m studying to solve this but it’s complicated to me.

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: I’m working on Delphi 2007

Answer 1

The pascal calling convention passes parameters from left to right, whereas cdecl passes them right to left. To account for that difference, simply reverse the order that the parameters get pushed onto the stack:

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

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

Next, the Self parameter of a method gets passed last instead of first in the pascal convention. The net effect is that in both conventions, Self is the last parameter pushed onto the stack. You can add it to the end of your FArgs array, but if this were my code, I’d just push it manually after the main argument loop (which would also allow omitting the second argument array entirely):

asm
  push [MethodData]
end;

Finally, in the pascal convention, the receiver cleans up the stack, whereas in cdecl, the caller cleans it up. Remove this code:

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

// pascal => do nothing

The code also makes an allowance for calling functions with fewer parameters than the target function expects. It allocates a 40-byte buffer and fills it with zeros. That won’t work with a pascal function, though. A pascal function always pops the same number of parameters from the stack, so if you provide the wrong number of parameters when you call it, you’ll end up trashing the stack when the function returns. Remove the assembler block below the comment:

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

There’s nothing you can do to check whether you’ve received the correct number of parameters. All you can do is make sure the stack pointer upon return from the function is the same as it was before you started pushing parameters.