Delphi의 인터페이스 참조에서 RTTI를 얻는 방법은 무엇입니까?

Question

이와 같은 기능을 구현할 수 있습니까?

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

I이 (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입니다. 내가하여 RTTI를 얻을 수 있습니다, 실제 타입이 Androidapi.JNI.Embarcadero.JWebBrowser입니다 가정 : 내가하고 싶은 것은 그 자격을 갖춘 유형 이름을 몰라도 RTTI를 얻을

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

입니다.

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

을하지만 인터페이스의 인스턴스 :

TObject의 인스턴스의 경우, 내가 사용할 수 있습니다

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

이 작동하지 않습니다.

Answer 1

, 드디어 작동 얻을.

내가 아는 한, 네 가지 가능성이 있습니다.

1 인터페이스는 OLE 개체에서 obtianed입니다. 이 경우, 캐스트 AIntf as Object은 예외를 throw합니다. 유형은 내가이 동적으로 생성 된 클래스 인 TRawVirtualClass에서 얻을 수있다

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

2. 인터페이스를 얻을 수 IDispatch입니다. (예 : 모든 기본 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의 대답을 사용하십시오. 그런 다음

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; 

을 확인하려면 : System.Rtti의 소스 코드와 몇 가지 테스트를 들여다 후

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;