After look into the source code of System.Rtti and some tests , I finally get it work.
As far as I know, there are four possibities.
1.The interface is obtianed from OLE object. In this case, the cast AIntf as Object will throw an exception. The type is IDispatch, I can get it by
TRttiContext.Create.GetType(TypeInfo(System.IDispatch))
2.The interface is obtained from TRawVirtualClass, which is a class created dynamicly. (for example, all native Android IOS and Mac interfaces).
use AIntf as TObject convert the interface to a TRawVirtualClass object, then use rtti get the FIIDs field of this object, It's type is TArray<TGUID>, the first element is the GUID of this interface.(Then is it's ancestor interfaces). The we can get it's RTTI by GUID.
3.The interface is obtained from TVirtualInterface. Use AIntf as TObject cast it to TVirtualInterface instance, then get its FIID field (of TGUID type).
4.The interface is obtained from Delphi object. Use @Remy Lebeau 's Answer.
I wrote a TInterfaceHelper:
unit InterfaceHelper;
interface
uses System.Rtti, System.TypInfo, System.Generics.Collections, System.SysUtils;
type
TInterfaceHelper = record
strict private
type
TInterfaceTypes = TDictionary<TGUID, TRttiInterfaceType>;
class var FInterfaceTypes: TInterfaceTypes;
class var Cached: Boolean;
class var Caching: Boolean;
class procedure WaitIfCaching; static;
class procedure CacheIfNotCachedAndWaitFinish; static;
class constructor Create;
class destructor Destroy;
public
// refresh cached RTTI in a background thread (eg. when new package is loaded)
class procedure RefreshCache; static;
// get RTTI from interface
class function GetType(AIntf: IInterface): TRttiInterfaceType;
overload; static;
class function GetType(AGUID: TGUID): TRttiInterfaceType; overload; static;
class function GetType(AIntfInTValue: TValue): TRttiInterfaceType;
overload; static;
// get type name from interface
class function GetTypeName(AIntf: IInterface): String; overload; static;
class function GetTypeName(AGUID: TGUID): String; overload; static;
class function GetQualifiedName(AIntf: IInterface): String;
overload; static;
class function GetQualifiedName(AGUID: TGUID): String; overload; static;
// get methods
class function GetMethods(AIntf: IInterface): TArray<TRttiMethod>; static;
class function GetMethod(AIntf: IInterface; const MethodName: String)
: TRttiMethod; static;
// Invoke method
class function InvokeMethod(AIntf: IInterface; const MethodName: String;
const Args: array of TValue): TValue; overload; static;
class function InvokeMethod(AIntfInTValue: TValue; const MethodName: String;
const Args: array of TValue): TValue; overload; static;
end;
implementation
uses System.Classes,
System.SyncObjs, DUnitX.Utils;
{ TInterfaceHelper }
class function TInterfaceHelper.GetType(AIntf: IInterface): TRttiInterfaceType;
var
ImplObj: TObject;
LGUID: TGUID;
LIntfType: TRttiInterfaceType;
TempIntf: IInterface;
begin
Result := nil;
try
// As far as I know, the cast will fail only when AIntf is obatined from OLE Object
// Is there any other cases?
ImplObj := AIntf as TObject;
except
// for interfaces obtained from OLE Object
Result := TRttiContext.Create.GetType(TypeInfo(System.IDispatch))
as TRttiInterfaceType;
Exit;
end;
// for interfaces obtained from TRawVirtualClass (for exmaple IOS & Android & Mac interfaces)
if ImplObj.ClassType.InheritsFrom(TRawVirtualClass) then
begin
LGUID := ImplObj.GetField('FIIDs').GetValue(ImplObj).AsType < TArray <
TGUID >> [0];
Result := GetType(LGUID);
end
// for interfaces obtained from TVirtualInterface
else if ImplObj.ClassType.InheritsFrom(TVirtualInterface) then
begin
LGUID := ImplObj.GetField('FIID').GetValue(ImplObj).AsType<TGUID>;
Result := GetType(LGUID);
end
else
// for interfaces obtained from Delphi object
// The code is taken from Remy Lebeau's answer at http://stackoverflow.com/questions/39584234/how-to-obtain-rtti-from-an-interface-reference-in-delphi/
begin
for LIntfType in (TRttiContext.Create.GetType(ImplObj.ClassType)
as TRttiInstanceType).GetImplementedInterfaces do
begin
if ImplObj.GetInterface(LIntfType.GUID, TempIntf) then
begin
if AIntf = TempIntf then
begin
Result := LIntfType;
Exit;
end;
end;
end;
end;
end;
class constructor TInterfaceHelper.Create;
begin
FInterfaceTypes := TInterfaceTypes.Create;
Cached := False;
Caching := False;
RefreshCache;
end;
class destructor TInterfaceHelper.Destroy;
begin
FInterfaceTypes.DisposeOf;
end;
class function TInterfaceHelper.GetQualifiedName(AIntf: IInterface): String;
var
LType: TRttiInterfaceType;
begin
Result := string.Empty;
LType := GetType(AIntf);
if Assigned(LType) then
Result := LType.QualifiedName;
end;
class function TInterfaceHelper.GetMethod(AIntf: IInterface;
const MethodName: String): TRttiMethod;
var
LType: TRttiInterfaceType;
begin
Result := nil;
LType := GetType(AIntf);
if Assigned(LType) then
Result := LType.GetMethod(MethodName);
end;
class function TInterfaceHelper.GetMethods(AIntf: IInterface)
: TArray<TRttiMethod>;
var
LType: TRttiInterfaceType;
begin
Result := [];
LType := GetType(AIntf);
if Assigned(LType) then
Result := LType.GetMethods;
end;
class function TInterfaceHelper.GetQualifiedName(AGUID: TGUID): String;
var
LType: TRttiInterfaceType;
begin
Result := string.Empty;
LType := GetType(AGUID);
if Assigned(LType) then
Result := LType.QualifiedName;
end;
class function TInterfaceHelper.GetType(AGUID: TGUID): TRttiInterfaceType;
begin
CacheIfNotCachedAndWaitFinish;
Result := FInterfaceTypes.Items[AGUID];
end;
class function TInterfaceHelper.GetTypeName(AGUID: TGUID): String;
var
LType: TRttiInterfaceType;
begin
Result := string.Empty;
LType := GetType(AGUID);
if Assigned(LType) then
Result := LType.Name;
end;
class function TInterfaceHelper.InvokeMethod(AIntfInTValue: TValue;
const MethodName: String; const Args: array of TValue): TValue;
var
LMethod: TRttiMethod;
LType: TRttiInterfaceType;
begin
LType := GetType(AIntfInTValue);
if Assigned(LType) then
LMethod := LType.GetMethod(MethodName);
if not Assigned(LMethod) then
raise Exception.Create('Method not found');
Result := LMethod.Invoke(AIntfInTValue, Args);
end;
class function TInterfaceHelper.InvokeMethod(AIntf: IInterface;
const MethodName: String; const Args: array of TValue): TValue;
var
LMethod: TRttiMethod;
begin
LMethod := GetMethod(AIntf, MethodName);
if not Assigned(LMethod) then
raise Exception.Create('Method not found');
Result := LMethod.Invoke(TValue.From<IInterface>(AIntf), Args);
end;
class function TInterfaceHelper.GetTypeName(AIntf: IInterface): String;
var
LType: TRttiInterfaceType;
begin
Result := string.Empty;
LType := GetType(AIntf);
if Assigned(LType) then
Result := LType.Name;
end;
class procedure TInterfaceHelper.RefreshCache;
var
LTypes: TArray<TRttiType>;
begin
WaitIfCaching;
FInterfaceTypes.Clear;
Cached := False;
Caching := True;
TThread.CreateAnonymousThread(
procedure
var
LType: TRttiType;
LIntfType: TRttiInterfaceType;
begin
LTypes := TRttiContext.Create.GetTypes;
for LType in LTypes do
begin
if LType.TypeKind = TTypeKind.tkInterface then
begin
LIntfType := (LType as TRttiInterfaceType);
if TIntfFlag.ifHasGuid in LIntfType.IntfFlags then
begin
FInterfaceTypes.AddOrSetValue(LIntfType.GUID, LIntfType);
end;
end;
end;
Caching := False;
Cached := True;
end).Start;
end;
class procedure TInterfaceHelper.WaitIfCaching;
begin
if Caching then
TSpinWait.SpinUntil(
function: Boolean
begin
Result := Cached;
end);
end;
class procedure TInterfaceHelper.CacheIfNotCachedAndWaitFinish;
begin
if Cached then
Exit
else if not Caching then
begin
RefreshCache;
WaitIfCaching;
end
else
WaitIfCaching;
end;
class function TInterfaceHelper.GetType(AIntfInTValue: TValue)
: TRttiInterfaceType;
var
LType: TRttiType;
begin
Result := nil;
LType := AIntfInTValue.RttiType;
if LType is TRttiInterfaceType then
Result := LType as TRttiInterfaceType;
end;
end.
Then:
uses InterfaceHelper;
function GetRttiFromInterface(AIntf: IInterface; out RttiType: TRttiType): Boolean;
begin
RttiType := TInterfaceHelper.GetType(AIntf);
Result := Assigned(RttiType);
end;
