क्या इस तरह के एक समारोह को लागू करना संभव है?

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

मेरे पास निम्न कोड है (फ़ायरमोनकी एंड्रॉइड पर):

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

अपने योग्य प्रकार के नाम के बिना इंटरफ़ेस संदर्भ से आरटीटीआई कैसे प्राप्त करें?

उदाहरण के लिए, मेरे पास एक IInterface इंस्टेंस है जिसका नाम AInterface है। मान लें कि इसका वास्तविक प्रकार Androidapi.JNI.Embarcadero.JWebBrowser है, मैं इसका आरटीटीआई निम्न द्वारा प्राप्त कर सकता हूं:

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

मैं इसके योग्य प्रकार के नाम को जाने बिना इसका आरटीटीआई प्राप्त करना चाहता हूं।

TObject के उदाहरणों के लिए, मैं इसका उपयोग कर सकता हूं:

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

लेकिन इंटरफेस के उदाहरणों के लिए:

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

काम नहीं करता।

4
Chang 20 सितंबर 2016, 04:05

2 जवाब

सबसे बढ़िया उत्तर

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. इंटरफ़ेस डेल्फ़ी ऑब्जेक्ट से प्राप्त किया गया है। @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;
4
Stefan Glienke 30 सितंबर 2016, 14:13

आप जो मांग रहे हैं वह सीधा नहीं है, लेकिन यह संभव है।

सबसे पहले, इंटरफ़ेस पैरामीटर को उसके कार्यान्वयन ऑब्जेक्ट में वापस बदलें। डेल्फ़ी 2010 और बाद में, आप उस उद्देश्य के लिए as ऑपरेटर का उपयोग कर सकते हैं (पिछले संस्करणों के लिए, यह ब्लॉग बताता है कि इसे मैन्युअल रूप से कैसे किया जाता है)।

एक बार जब आपके पास कार्यान्वयन वस्तु हो जाती है, तो आप इसके आरटीटीआई का उपयोग सटीक इंटरफ़ेस प्रकार का पता लगाने के लिए कर सकते हैं, जिस पर आपका पैरामीटर इंगित कर रहा है, और फिर उससे आप उस प्रकार के लिए आरटीटीआई पा सकते हैं।

हालांकि, यह केवल तभी काम करता है जब इंटरफ़ेस 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;
3
Remy Lebeau 21 सितंबर 2016, 17:32