如何在Delphi中从接口引用获取RTTI？

Question

如何在Delphi中从接口引用获取RTTI？

4

有没有可能实现这样的函数？

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？

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

无法工作。

- Chang

4

我们应该在那个Drive链接中找到什么？请注意，谨慎的人不会打开从陌生人下载的rar文件。请将必要的代码发布在您的问题中，无需解释或提供额外内容。 - Rob Kennedy

1

我不确定你是如何在评论中找出代码格式问题，但为什么却无法在你的问题中这样做。我曾试图帮你修复它，但由于缺少间距和包含大量HTML而弄乱了一切，我不想破坏任何东西。请勿在您的帖子中使用HTML。正确地在IDE编辑器中格式化代码，将其复制并粘贴到此处，选择所有内容，然后使用Ctrl+K或{}工具栏按钮将其格式化为代码。 - Ken White

假设您有一个支持多接口的接口。那么接下来呢？ - David Heffernan

1

当我们使用接口时，我们不是抽象出了类型吗？为什么要回到具体类呢？但是，有一种奇怪的方式可以使用RttiType := TRttiContext.Create.GetType(TObject(AInterface))；但这并不安全... - Z.B.

@DavidHeffernan，当声明类型为基类（在这种情况下为IInterface）时就不是这样了。 - Remy Lebeau

显示剩余8条评论

2个回答

3

你所要求的并不是一件简单的事情，但是这是可能的。

首先，将接口参数转换回其实现对象。在Delphi 2010及更高版本中，您可以使用as运算符来完成此操作（对于早期版本，此博客解释了如何手动完成此操作）。

一旦您拥有了实现对象，就可以使用其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;

- Remy Lebeau

感谢您的回答。对于非Delphi接口（例如从TRawVirtualClass获取的本机Android和IOS接口），此代码不起作用： obj := AIntf as TObject;例如，代码： AJWebBrowserInterfaceRef as TObject 将返回一个TJavaImport实例，该实例继承自TRawVirtualClass。我无法获取它实现的接口。 - Chang

@Chang，如果这样的话，很抱歉您只能自求多福了。请另寻他法解决您的问题。 - Remy Lebeau

我终于解决了这个问题。请看上面的答案。但我不确定它是否涵盖了所有可能性。 - Chang

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Chang · Accepted Answer

经过查看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 https://dev59.com/RZrga4cB1Zd3GeqPtuff
  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;