如何斷言給定的方法指針使用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中提取調用約定信息（自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答案;以下作品於2010年德爾福OK：

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; 

Answer 2

看到這裏就如何找出：

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

IOW，您可以簡單地嘗試它是否工作，或者您可以查看導出的名稱（_name @ 17或類似名稱），或者查看反彙編（例如，在CPU視圖中。

Answer 3

德爾福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。