Delphi 作为泛型类型访问接口的属性

Question

I am trying to access the properties of an underlying object via an interface in a generic class that can take any type, ie NO constraints on the parameter. I can do this successfully for a class parameter but having trouble when the parameter is an interface. From reading many posts here I have come to the conclusion that the only way to access the RTTI data for an interface is casting back to a TObject (assumption is it came from an object to start with which is safe in my context).

My thought was to use supports to extract the interface then cast it back to a TObject and then test the RTTI to get the property information. My problem is that the supports function is looking for an instance of TObject, IInterface or TClass which I cannot get from the generic type T without a parameter constraint which defeats the purpose of the class that contains this method. I have produced the following code that shows my attempt at a solution.

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.RTTI,
  System.Typinfo;

Type
  ITestIntf = interface(IInvokable)
    ['{61E0E2FC-59FA-4300-BE84-068BC265376E}']
    function GetData: string;
    procedure SetData(const Value: string);
    property Data : string read GetData write SetData;
  end;

  TTestClass=class(TInterfacedObject, ITestIntf)
  private
    FData : string;
    function GetData: string;
    procedure SetData(const Value: string);
  public
    property Data : string read GetData write SetData;
  end;

  TAccess<T> = class
    Function CheckProperty(AInstance : T; APropName : string) : boolean;
  end;

var
  LAccIntf : TAccess<ITestIntf>;
  LAccClass : TAccess<TTestClass>;
  LTestCls : TTestClass;
  LTestIntf : ITestIntf;

{ TTestClass }

function TTestClass.GetData: string;
begin
  Result := FData;
end;

procedure TTestClass.SetData(const Value: string);
begin
  FData := Value;
end;

{ TAccess<T> }

function TAccess<T>.CheckProperty(AInstance : T; APropName : string) : boolean;

var
  LType, LInstType : TRTTIType;
  LIntf : IInterface;
  LGUID : TGUID;
  LContext : TRttiContext;
  LInstance : TObject;

begin
  Result := false;
  LType := LContext.GetType(Typeinfo(T));
  if LType.TypeKind = tkInterface then
  begin
    LGUID := GetTypeData(TypeInfo(T))^.Guid;
    If Supports(AInstance, LGUID, LIntf) then // <- Error here
    begin
      LInstance := LIntf as TObject;
      LInstType := LContext.GetType(LInstance.ClassType);
      Result := (LInstType.GetProperty(APropName) <> nil);
    end;
  end else
  if LType.TypeKind = tkClass then
  begin
    Result := (LType.GetProperty(APropName) <> nil);
  end;
end;

begin
  try
    LTestCls := TTestClass.create;
    LTestIntf := TTestClass.create;
    LAccClass := TAccess<TTestClass>.Create;
    if LAccClass.CheckProperty(LTestCls,'Data') then
      writeln('Class Success!')
    else
      writeln('Class Failed');

    LAccIntf := TAccess<ITestIntf>.Create;
    if LAccIntf.CheckProperty(LTestIntf, 'Data') then
      writeln('Intf Success!')
    else
      writeln('Intf Failed');
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end. 

When I compile this I get an error:

[dcc32 Error] Project1.dpr(68): E2250 There is no overloaded version of 'Supports' that can be called with these arguments

I am not sure this is possible or if it is, am I going about it the right way?

Thanks

Answer 1

Your compiler objects to this code because it AInstance is not constrained at compile time to be an interface variable. Your code tests for that at runtime, so it is safe to cast AInstance .

There are a variety of ways to do this. I'd probably do it like this:

Supports(PInterface(@AInstance)^, LGUID, LIntf)

where

PInterface = ^IInterface

---

Note that whilst this will make your code compile and run as you intend, it doesn't actually test whether the interface implements a property. For instance, if you remove the Data property from the implementing class definition, then the interface does indeed implement the Data property, but your function returns False .