How do I claim that a given method pointer uses the stdcall calling convention?

In my library, I call methods under certain conditions, which requires a stdcall calling convention. I am currently using static compiler resolution, implemented as a fairly large list of known method signatures and corresponding overloaded versions of my routine. This works, but it looks pretty ugly and doesn't cover all possible methods 100%. I would like to add the ability to work with a universal method pointer and assert the correct calling convention by specifying RTTI. And so I'm stuck, please advise.

Input: code/data pair of pointers as in TMethod 
Output: boolean indicator, true if method is stdcall

I would prefer to use the “classic” RTTI to create smaller version dependencies, however I cannot find any call convention indicator in the “classic” RTTI ...


NB: this question is FIXING to import external functions

+5
source share
3 answers

You can extract call information from the extended RTTI (available since Delphi 2010).

uses RTTI, TypInfo;

function GetMethCallConv(AMeth: TMethod; out Conv: TCallConv): Boolean;
var
  Ctx: TRttiContext;
  Meth: TRttiMethod;
  Typ: TRttiType;

begin
  Ctx:= TRttiContext.Create;
  try
    Typ:= Ctx.GetType(TObject(AMeth.Data).ClassType);
    for Meth in Typ.GetMethods do begin
      if Meth.CodeAddress = AMeth.Code then begin
        Conv:= Meth.CallingConvention;
        Exit(True);
      end;
    end;
    Exit(False);
  finally
    Ctx.Free;
  end;
end;

//test

type
  TMyObj = class
  public
    procedure MyMeth(I: Integer); stdcall;
  end;

procedure TMyObj.MyMeth(I: Integer);
begin
  ShowMessage(IntToStr(I));
end;
procedure TForm2.Button2Click(Sender: TObject);
var
  Conv: TCallConv;
  Meth: TMethod;
  MyObj: TMyObj;

begin
  MyObj:= TMyObj.Create;
  Meth.Code:= @TMyObj.MyMeth;
  Meth.Data:= MyObj;
  if GetMethCallConv(Meth, Conv) then begin
    case Conv of
      ccReg: ShowMessage('Register');
      ccCdecl: ShowMessage('cdecl');
      ccPascal: ShowMessage('Pascal');
      ccStdCall: ShowMessage('StdCall');
      ccSafeCall: ShowMessage('SafeCall');
    end;
  end;
  MyObj.Free;
end;

Update

For a “classic” RTTI, read Sertac's answer; On Delphi 2010 OK works:

uses ObjAuto;

function GetMethCallConv2(AMeth: TMethod; out Conv: TCallingConvention): Boolean;
var
  Methods: TMethodInfoArray;
  I: Integer;
  P: PMethodInfoHeader;

begin
  Result:= False;
  Methods:= GetMethods(TObject(AMeth.Data).ClassType);
  if not Assigned(Methods) then Exit;

  for I:= Low(Methods) to High(Methods) do begin
    P:= Methods[I];
    if P^.Addr = AMeth.Code then begin
      Inc(Integer(P), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
        Length(PMethodInfoHeader(P)^.Name));
      Conv:= PReturnInfo(P).CallingConvention;
      Result:= True;
      Exit;
    end;
  end;
end;

{$TYPEINFO ON}
{$METHODINFO ON}
type
  TMyObj = class
  public
    procedure MyMeth(I: Integer);
  end;

procedure TMyObj.MyMeth(I: Integer);
begin
  ShowMessage(IntToStr(I));
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  Conv: TCallingConvention;
  Meth: TMethod;
  MyObj: TMyObj;

begin
  MyObj:= TMyObj.Create;
  Meth.Code:= @TMyObj.MyMeth;
  Meth.Data:= MyObj;
  if GetMethCallConv2(Meth, Conv) then begin
    case Conv of
      ccRegister: ShowMessage('Register');
      ccCdecl: ShowMessage('cdecl');
      ccPascal: ShowMessage('Pascal');
      ccStdCall: ShowMessage('StdCall');
      ccSafeCall: ShowMessage('SafeCall');
    end;
  end;
  MyObj.Free;
end;
+3
source

Delphi 7 , METHODINFO, , , , (TYPEINFO ).

, , , , , , - .

type
{$METHODINFO ON}
  TSomeClass = class
  public
    procedure Proc1(i: Integer; d: Double); stdcall;
    procedure Proc2;
  end;
{$METHODINFO OFF}

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    FSomeClass: TSomeClass;

  ..

uses
  objauto;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSomeClass := TSomeClass.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Info: Pointer;
begin
  Info := GetMethodInfo(FSomeClass, 'Proc1');
  if Assigned(Info) then begin
    Inc(Integer(Info), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
      Length(PMethodInfoHeader(Info).Name));
    if PReturnInfo(Info).CallingConvention = ccStdCall then
      // ...

  end;


, , D2007, . , " Proc1" procedure Proc1(i: Pointer; d: Double);, RTTI.

+3

. , :

http://rvelthuis.de/articles/articles-convert.html#cconvs

IOW, you can just try if it works, or take a look at the exported name (_name @ 17 or the like) or take a look at a disassembly, for example. in the CPU view.

+1
source

All Articles