在DelphiXE3中，如何使用TypeInfo或RTTI将TVirtualInterface对象强制转换到其接口？

我正在尝试使用TVirtualInterface。我主要是在和上尝试遵循这些例子

然而，我试图做的与标准示例略有不同

我已经尽可能地简化了下面的示例代码，以说明我要做的事情。我省略了明显的验证和错误处理代码

program VirtualInterfaceTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Generics.Collections,
  System.Rtti,
  System.SysUtils,
  System.TypInfo;

type
  ITestData = interface(IInvokable)
    ['{6042BB6F-F30C-4C07-8D3B-C123CF1FF60F}']
    function  GetComment: string;
    procedure SetComment(const Value: string);
    property  Comment: string read GetComment write SetComment;
  end;

  IMoreData = interface(IInvokable)
    ['{1D2262CE-09F4-45EC-ACD8-3EEE6B2F1548}']
    function  GetSuccess: Boolean;
    procedure SetSuccess(const Value: Boolean);
    property  Success: Boolean read GetSuccess write SetSuccess;
  end;

  TDataHolder = class
  private
    FTestData: ITestData;
    FMoreData: IMoreData;
  public
    property TestData: ITestData read FTestData write FTestData;
    property MoreData: IMoreData read FMoreData write FMoreData;
  end;

  TVirtualData = class(TVirtualInterface)
  private
    FData: TDictionary<string, TValue>;
    procedure DoInvoke(Method: TRttiMethod; 
                       const Args: TArray<TValue>; 
                       out Result: TValue);
  public
    constructor Create(PIID: PTypeInfo);
    destructor Destroy; override;
  end;

constructor TVirtualData.Create(PIID: PTypeInfo);
begin
  inherited Create(PIID, DoInvoke);
  FData := TDictionary<string, TValue>.Create;
end;

destructor TVirtualData.Destroy;
begin
  FData.Free;
  inherited Destroy;
end;

procedure TVirtualData.DoInvoke(Method: TRttiMethod; 
                                const Args: TArray<TValue>; 
                                out Result: TValue);
var
  key: string;
begin
  if (Pos('Get', Method.Name) = 1) then
  begin
    key := Copy(Method.Name, 4, MaxInt);
    FData.TryGetValue(key, Result);
  end;

  if (Pos('Set', Method.Name) = 1) then
  begin
    key := Copy(Method.Name, 4, MaxInt);
    FData.AddOrSetValue(key, Args[1]);
  end;
end;

procedure InstantiateData(obj: TObject);
var
  rttiContext:  TRttiContext;
  rttiType:     TRttiType;
  rttiProperty: TRttiProperty;
  propertyType: PTypeInfo;
  data:         IInterface;
  value:        TValue;
begin
  rttiContext := TRttiContext.Create;
  try
    rttiType := rttiContext.GetType(obj.ClassType);
    for rttiProperty in rttiType.GetProperties do
    begin
      propertyType := rttiProperty.PropertyType.Handle;
      data := TVirtualData.Create(propertyType) as IInterface;
      value := TValue.From<IInterface>(data);
      //  TValueData(value).FTypeInfo := propertyType;
      rttiProperty.SetValue(obj, value);  //  <<====  EInvalidCast
    end;
  finally
    rttiContext.Free;
  end;
end;

procedure Test_UsingDirectInstantiation;
var
  dataHolder: TDataHolder;
begin
  dataHolder := TDataHolder.Create;
  try
    dataHolder.TestData := TVirtualData.Create(TypeInfo(ITestData)) as ITestData;
    dataHolder.MoreData := TVirtualData.Create(TypeInfo(IMoreData)) as IMoreData;

    dataHolder.TestData.Comment := 'Hello World!';
    dataHolder.MoreData.Success := True;

    Writeln('Comment:  ', dataHolder.TestData.Comment);
    Writeln('Success:  ', dataHolder.MoreData.Success);
  finally
    dataHolder.Free;
  end;
end;

procedure Test_UsingIndirectInstantiation;
var
  dataHolder: TDataHolder;
begin
  dataHolder := TDataHolder.Create;
  try
    InstantiateData(dataHolder);  //  <<====

    dataHolder.TestData.Comment := 'Hello World!';
    dataHolder.MoreData.Success := False;

    Writeln('Comment:  ', dataHolder.TestData.Comment);
    Writeln('Success:  ', dataHolder.MoreData.Success);
  finally
    dataHolder.Free;
  end;
end;

begin
  try
    Test_UsingDirectInstantiation;
    Test_UsingIndirectInstantiation;
  except on E: Exception do
    Writeln(E.ClassName, ':  ', E.Message);
  end;
  Readln;
end.

程序虚拟接口测试；
{$APPTYPE控制台}
{$R*.res}
使用
System.Generics.Collections，
系统,Rtti,，
System.SysUtils，
System.TypInfo；
类型
ITestData=接口（IInvokable）
[{6042BB6F-F30C-4C07-8D3B-C123CF1FF60F}]
函数GetComment:string；
过程SetComment（常量值：字符串）；
属性注释：字符串读取GetComment写入SetComment；
结束；
IMoreData=接口（IInvokable）
['{1D22262CE-09F4-45EC-ACD8-3EEE6B2F1548}']
函数GetSuccess:Boolean；
过程SetSuccess（常量值：布尔值）；
属性Success:Boolean read GetSuccess write SetSuccess；
结束；
TDataHolder=class
私有的
FTestData:ITestData；
FMoreData:伊莫雷达；
公众的
属性TestData:ITestData读取FTestData写入FTestData；
属性MoreData：IMoreData读取FMoreData写入FMoreData；
结束；
TVirtualData=类（TVirtualInterface）
私有的
FData:t词典；
程序DoInvoke（方法：TRTTI法；
常数Args:TArray；
输出结果：TValue）；
公众的
构造函数创建（PIID:PTypeInfo）；
毁灭者毁灭；推翻
结束；
构造函数TVirtualData.Create（PIID:PTypeInfo）；
开始
继承的创建（PIID、DoInvoke）；
FData:=TDictionary.Create；
结束；
析构函数TVirtualData.Destroy；
开始
自由数据；
继承性破坏；
结束；
程序TVirtualData.DoInvoke（方法：Trti方法；
常数Args:TArray；
输出结果：TValue）；
变量
键：字符串；
开始
如果（Pos（'Get'，Method.Name）=1），则
开始
key:=复制（Method.Name，4，MaxInt）；
FData.TryGetValue（键、结果）；
结束；
如果（Pos（'Set'，Method.Name）=1），则
开始
key:=复制（Method.Name，4，MaxInt）；
FData.AddOrSetValue（键，参数[1]）；
结束；
结束；
程序实例化数据（对象：TObject）；
变量
rttiContext:TRttiContext；
rttType:trtType；
rttiProperty:TRttiProperty；
propertyType:PTypeInfo；
数据：界面；
价值：TValue；
开始
rttiContext:=TRttiContext.Create；
尝试
rttiType:=rttiContext.GetType（obj.ClassType）；
对于rttiType.GetProperties中的rttiProperty，请执行以下操作：
开始
propertyType:=rttiProperty.propertyType.Handle；
数据：=TVirtualData.Create（propertyType）作为界面；
值：=TValue.From（数据）；
//TValueData（value）.FTypeInfo:=propertyType；
rttiProperty.SetValue（对象，值）；// 首先，必须将实例强制转换为正确的接口，而不是I接口。您仍然可以将其存储在IInterface变量中，但它确实包含对正确接口类型的引用

然后，您必须将其放入具有正确类型的TValue，而不是IInterface（RTTI对类型非常严格）

您添加的注释行只是为了解决第二个问题，但由于它确实包含IInterface引用（而不是ITestData或TMoreData引用），因此它在AV上产生

procedure InstantiateData(obj: TObject);
var
  rttiContext:  TRttiContext;
  rttiType:     TRttiType;
  rttiProperty: TRttiProperty;
  propertyType: PTypeInfo;
  data:         IInterface;
  value:        TValue;
begin
  rttiType := rttiContext.GetType(obj.ClassType);
  for rttiProperty in rttiType.GetProperties do
  begin
    propertyType := rttiProperty.PropertyType.Handle;
    Supports(TVirtualData.Create(propertyType), TRttiInterfaceType(rttiProperty.PropertyType).GUID, data);
    TValue.Make(@data, rttiProperty.PropertyType.Handle, value);
    rttiProperty.SetValue(obj, value);
  end;
end;

只是一个旁注——您不必创建TRttiContext的实例——它将在第一次使用时自动实例化。而且您也不需要释放它！谢谢你。很高兴知道。这绝对解决了我的问题。我几天前就该问了。