【问题标题】:How to obtain RTTI from an interface reference in Delphi?如何从 Delphi 的接口引用中获取 RTTI?
【发布时间】:2016-09-20 01:05:48
【问题描述】:

这样的功能可以实现吗?

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

我有以下代码(在 Firemonkey Android 上):

// 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?

例如,我有一个名为 AInterfaceIInterface 实例。假设它的实际类型是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);   

没用。

【问题讨论】:

  • 您希望退回什么?
  • 我们应该在该云端硬盘链接中找到什么?请注意,谨慎的人不会打开从陌生人那里下载的 rar 文件。在您的问题中发布必要的代码。
  • 我不确定您是如何在评论中弄清楚代码格式的,但在您的问题本身中却无法做到。我开始尝试为您修复它,但是由于缺少间距和包含的所有 HTML,您已经把它弄得一团糟,我不想破坏任何东西。不要在您的帖子中使用 HTML。在 IDE 的编辑器中正确格式化代码,将其复制并粘贴到此处,全选,然后使用 Ctrl+K 或 {} 工具栏按钮将其格式化为代码。
  • 假设你有一个支持多个接口的接口。然后呢?
  • 我们在使用接口时不是从类型中抽象出来的吗?为什么我们要回到具体的类?但是对于 WEIRD 方式,您可以使用 RttiType := TRttiContext.Create.GetType(TObject(AInterface));但那不安全……

标签: delphi interface


【解决方案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&lt;TGUID&gt;,第一个元素为该接口的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;

【讨论】:

    【解决方案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;
    

    【讨论】:

    • 感谢您的回答。 obj := AIntf as TObject; 这不适用于非 Delphi 接口。 (如原生Android&IOS接口,取自TRawVirtualClass)。例如,代码:AJWebBrowserInterfaceRef as TObject 将返回一个 TJavaImport 实例,该实例继承自 TRawVirtualClass。而且我无法获得它实现的接口。
    • @Chang,那么你是 SOL,对不起。为您的问题找到另一种解决方案。
    • 我终于解决了这个问题。请看我上面的回答。但我不确定它是否涵盖所有可能性。
    猜你喜欢
    • 1970-01-01
    • 2011-03-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-07-06
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多