如何從Delphi中的接口引用獲取RTTI？

Question

是否可以實現這樣的功能？

function GetRttiFromInterface(AIntf: IInterface; out RttiType: TRttiType): Boolean; 

我有以下代碼（在Firemonkey安卓）：

// Get the FWeb field of AWebBrowser, then get FJWebBrowser field of FWeb. 
function GetNativeBrowserIntf(AWebBrowser: TWebBrowser): IInterface; 
var 
    LCtx: TRttiContext; 
    LWeb: TObject; 
begin 
    LWeb := (LCtx.GetType(TWebBrowser).GetField('FWeb').GetValue(AWebBrowser).AsInterface as TObject); 
    result := LCtx.GetType(LWeb.ClassInfo).GetField('FJWebBrowser').GetValue(LWeb).AsInterface; 
end; 

{ TODO : How to get rtti from an interface reference??? } 
function GetRttiFromInterface(AIntf: IInterface; out RttiType: TRttiType): Boolean; 
begin 
    //RttiType := TRttiContext.Create.FindType('Androidapi.JNI.Embarcadero.JWebBrowser'); 
    //I want to get rtti from AIntf without knowing the qulified type name 
    result := True; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    NativeBrowser: IInterface; 
    LIntfType: TRttiType; 
    LScale: Single; 
begin 
    // obtain native browser Interface (JWebBrowser) 
    NativeBrowser := GetNativeBrowserIntf(WebBrowser1); 
    // Get Rtti from this interface 
    if GetRttiFromInterface(NativeBrowser, LIntfType) then 
    begin 
    // Invoke the getScale method of Native Browser 
    LScale := LIntfType.GetMethod('getScale').Invoke(TValue.From<IInterface>(NativeBrowser), []).AsType <Single> ; 
    ShowMessage('Current scale is:' + LScale.ToString); 
    end; 
end;  

如何從一個接口引用得到RTTI沒有其限定的類型名稱？

例如，我有一個IInterface實例，名爲AInterface。假設它的實際類型Androidapi.JNI.Embarcadero.JWebBrowser， 我可以得到它的RTTI：

TRttiContext.Create.FindType('Androidapi.JNI.Embarcadero.JWebBrowser'); 

我想要做的就是獲得其RTTI不知道它限定的類型名稱。

對於TObject情況下，我可以使用：

RttiType := TRttiContext.Create.GetType(AObject.ClassType); 

但對於接口的實例：

RttiType := TRttiContext.Create.GetType(AInterface); 

不起作用。

Answer 1

看到的System.Rtti的源代碼和一些測試後，我終於得到它的工作。

據我所知，有四種可能性。

1.該接口來自OLE對象。在這種情況下，演員AIntf as Object將引發異常。該類型是IDispatch，我可以

TRttiContext.Create.GetType(TypeInfo(System.IDispatch)) 

2.接口讓它從TRawVirtualClass獲得，這是動態地創建一個類。 （例如，所有原生Android IOS和Mac界面）。 使用AIntf as TObject將接口轉換爲一個TRawVirtualClass對象，然後使用rtti獲取該對象的FIIDs字段，其​​類型爲TArray<TGUID>，第一個元素是此接口的GUID（接着是它的祖先接口）。我們可以通過GUID獲取它的RTTI。

3.界面從TVirtualInterface獲得。使用AIntf as TObject將其轉換爲TVirtualInterface實例，然後獲取其FIID字段（的TGUID類型）。

4.界面從Delphi對象中獲得。使用@Remy Lebeau的答案。

我寫了一個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. 

然後：

uses InterfaceHelper; 

function GetRttiFromInterface(AIntf: IInterface; out RttiType: TRttiType): Boolean; 
begin 
    RttiType := TInterfaceHelper.GetType(AIntf); 
    Result := Assigned(RttiType); 
end; 

Answer 2

你所要求的不是直截了當的，但它是可能的。

首先，將接口參數轉換回其實現對象。在Delphi 2010和更高版本中，您可以使用as運算符（對於早期版本，this blog解釋瞭如何手動執行）。

一旦你有了實現對象，你可以使用它的RTTI來確定你的參數指向的確切接口類型，然後你可以找到該類型的RTTI。

但是，這隻適用於接口由TObject衍生的類實現並具有分配給它的GUID。

例如：

uses 
    System.Rtti; 

function GetRttiFromInterface(AIntf: IInterface; out RttiType: TRttiType): Boolean; 
var 
    obj: TObject; 
    IntfType: TRttiInterfaceType; 
    ctx: TRttiContext; 
    tmpIntf: IInterface; 
begin 
    Result := False; 

    // get the implementing object... 
    obj := AIntf as TObject; 

    // enumerate the object's interfaces, looking for the 
    // one that matches the input parameter... 
    for IntfType in (ctx.GetType(obj.ClassType) as TRttiInstanceType).GetImplementedInterfaces do 
    begin 
    if obj.GetInterface(IntfType.GUID, tmpIntf) then 
    begin 
     if AIntf = tmpIntf then 
     begin 
     RttiType := IntfType; 
     Result := True; 
     Exit; 
     end; 
     tmpIntf := nil; 
    end; 
    end; 
end; 

驗證：

uses 
    System.Classes, Vcl.Dialogs; 

type 
    ITest1 = interface 
    ['{5AB029F5-31B0-4054-A70D-75BF8278716E}'] 
    procedure Test1; 
    end; 

    ITest2 = interface 
    ['{AAC18D39-465B-4706-9DC8-7B1FBCC05B2B}'] 
    procedure Test1; 
    end; 

    TTest = class(TInterfacedObject, ITest1, ITest2) 
    public 
    procedure Test1; 
    procedure Test2; 
    end; 

procedure TTest.Test1; 
begin 
    //... 
end; 

procedure TTest.Test2; 
begin 
    //... 
end; 

var 
    Intf1: ITest1; 
    Intf2: ITest2; 
    RttiType: TRttiType; 
begin 
    Intf1 := TTest.Create as ITest1; 
    Intf2 := TTest.Create as ITest2; 
    GetRttiFromInterface(Intf1, RttiType); 
    ShowMessage(RttiType.Name); // shows 'ITest1' 
    GetRttiFromInterface(Intf2, RttiType); 
    ShowMessage(RttiType.Name); // shows 'ITest2' 
end;