In my library i'm invoking methods under specific conditions, which requires stdcall calling convention. Currently i'm using compiler static resolution, implemented as rather large list of well-known method signatures and corresponding overloaded versions of my subroutine. This works but looks quite fugly and doesnt 100% cover all possible methods. I would like to add a possibility to work with generic method pointer and assert proper calling convention by asking RTTI. And here i'm stuck, please advise.
Input: code/data pair of pointers as in TMethod
Output: boolean indicator, true if method is stdcall
I'd preferable use "classic" RTTI to create less version dependencies, however i cant find any calling convention indicator within "classic" RTTI...
NB: This question is UNRELATED to importing external functions
You can extract calling convention information from 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 "classic" RTTI read Sertac answer; the following works OK on 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;
Including Delphi 7 and up, when METHODINFO
directive is on, run-time generates information about, at least having public visibility, method parameters and return types and calling convention (TYPEINFO
should also be on).
Not sure if the below sample would help you directly since it works on an instance and method's name and not its address, but perhaps you can construct a look-up table for name-address of methods beforehand.
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;
Beware and do some testing though, tested on D2007 the working is somewhat unpredictable. For instance, if the above 'Proc1' is changed to procedure Proc1(i: Pointer; d: Double);
no detailed RTTI is generated.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With