加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 大数据 > 正文

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

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

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

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

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

解决方法

您可以从扩展的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;

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读