delphi - 具有接口(interface)类型约束的泛型类型的 RTTI

Question

是否可以检查具有接口(interface)类型约束的泛型类型实例的 RTTI 信息？这个问题可能有点含糊，所以我创建了一个示例控制台应用程序来展示我想要做什么:

program Project3;

{$APPTYPE CONSOLE}

uses
  RTTI,
  SysUtils,
  TypInfo;

type
  TMyAttribute = class(TCustomAttribute)
  strict private
    FName: string;
  public
    constructor Create(AName: string);
    property Name: string read FName;
  end;

  IMyObjectBase = interface
  ['{E063AD44-B7F1-443C-B9FE-AEB7395B39DE}']
    procedure DoSomething;
  end;

  TMyObjectBase = class(TInterfacedObject, IMyObjectBase)
  public
    procedure DoSomething; virtual;
  end;

  [TMyAttribute('First')]
  TMyFirstRealClass = class(TMyObjectBase)
  public
    procedure DoSomethingDifferent;
  end;

  [TMyAttribute('Second')]
  TMySecondRealClass = class(TMyObjectBase)
  public
    procedure BeSomethingDifferent;
  end;

  TGenericClass<I: IMyObjectBase> = class
  public
    function GetAttributeName(AObject: I): string;
  end;


{ TMyAttribute }

constructor TMyAttribute.Create(AName: string);
begin
  FName := AName;
end;

{ TMyObjectBase }

procedure TMyObjectBase.DoSomething;
begin
end;

{ TMyFirstRealClass }

procedure TMyFirstRealClass.DoSomethingDifferent;
begin
end;

{ TMySecondRealClass }

procedure TMySecondRealClass.BeSomethingDifferent;
begin
end;

{ TGenericClass<I> }

function TGenericClass<I>.GetAttributeName(AObject: I): string;
var
  LContext: TRttiContext;
  LProp: TRttiProperty;
  LAttr: TCustomAttribute;
begin
  Result := '';
  LContext := TRttiContext.Create;
  try
    for LAttr in LContext.GetType(AObject).GetAttributes do
    // ----> [DCC Error] E2250 There is no overloaded version of 'GetType' that can be called with these arguments
      if LAttr is TMyAttribute then
      begin
        Result := TMyAttribute(LAttr).Name;
        Break;
      end;
  finally
    LContext.Free;
  end;
end;

var
  LFirstObject: IMyObjectBase;
  LSecondObject: IMyObjectBase;
  LGeneric: TGenericClass<IMyObjectBase>;
begin
  try
    LFirstObject := TMyFirstRealClass.Create;
    LSecondObject := TMySecondRealClass.Create;

    LGeneric := TGenericClass<IMyObjectBase>.Create;

    Writeln(LGeneric.GetAttributeName(LFirstObject));
    Writeln(LGeneric.GetAttributeName(LSecondObject));

    LGeneric.Free;

    LFirstObject := nil;
    LSecondObject := nil;

    Readln;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

我需要检查传入的对象 (AObject)，而不是通用接口(interface) (I)。(德菲 2010)。感谢您的任何建议。

Answer 1

两种可能的解决方案如下:

1)我对此进行了测试并且它有效(XE4):

for LAttr in LContext.GetType((AObject as TObject).ClassType).GetAttributes do

2)我对此进行了测试并且它有效(XE4):

for LAttr in LContext.GetType(TMyObjectBase(AObject).ClassType).GetAttributes do

3)在返回对象的接口(interface)上创建方法并使用它来检查对象:

IMyObjectBase = interface
['{E063AD44-B7F1-443C-B9FE-AEB7395B39DE}']
  procedure DoSomething;
  function GetObject: TObject;
end;

TMyObjectBase = class(TInterfacedObject, IMyObjectBase)
public
  procedure DoSomething; virtual;
  function GetObject: TObject;
end;

{ TMyObjectBase }

function TMyObjectBase.GetObject: TObject;
begin
  Result := Self;
end;

然后这样调用它:

for LAttr in LContext.GetType(AObject.GetObject.ClassType).GetAttributes do