如何断言给定的方法指针使用stdcall调用约定？

Question

在我的库中,我在特定条件下调用方法,这需要stdcall调用约定.目前我正在使用编译器静态解析,实现为相当大的众所周知的方法签名列表和我子例程的相应重载版本.这有效,但看起来很脏,并没有100%覆盖所有可能的方法.我想增加使用泛型方法指针的可能性,并通过询问RTTI来断言正确的调用约定.在这里我被卡住了,请指教.

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

我最好使用"经典"RTTI来创建更少的版本依赖,但是我无法在"经典"RTTI中找到任何调用约定指示符...

---

注意:这个问题与导入外部功能无关

Answer 1

您可以从扩展 RTTI（自 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;

更新

对于“经典”RTTI，请阅读 Sertac 答案；以下内容在 Delphi 2010 上运行正常：

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;