gpt4 book ai didi

delphi - 在 Delphi XE3 中,如何使用 TypeInfo 或 RTTI 将 TVirtualInterface 对象强制转换为其接口(interface)?

转载 作者:行者123 更新时间:2023-12-03 14:59:26 24 4
gpt4 key购买 nike

我正在尝试使用 TVirtualInterface。我主要尝试遵循 Embarcadero doc wiki 中的示例。并在 Nick Hodges' blog .

但是,我想做的与标准示例有点不同。

我已尽可能简化了以下示例代码来说明我正在尝试执行的操作。我遗漏了明显的验证和错误处理代码。

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.

我有一些具有读/写属性的任意接口(interface),ITestDataIMoreData,以及一个保存对这些接口(interface)的引用的类,IDataHolder .

我按照 Nick Hodges 的示例创建了一个类 TVirtualData,它继承自 TVirtualInterface。当我按照我在所有示例中看到的方式使用此类时(如 Test_UsingDirectInstantiation 中所示),它的效果很好。

但是,我的代码需要做的是以更间接的方式实例化接口(interface),如 Test_UsingIndirectInstantiation 中所示。

InstantiateData 方法使用 RTTI,并且在 SetValue 调用引发 EInvalidCast 异常(“无效类类型转换”)之前一直运行良好。

我在注释行中添加了(我在“Delphi Sorcery”的一些示例代码中看到的),以尝试将数据对象转换为适当的接口(interface)。这使得 SetValue 调用能够干净地运行,但是当我尝试访问接口(interface)属性(即 dataHolder.TestData.Comment)时,它抛出了 EAccessViolation 异常(“访问冲突于地址 00000000。读取地址 00000000")。

为了好玩,我用 ITestData 替换了 InstantiateData 方法中的 IInterface,对于第一个属性,它工作得很好,但自然地,它没有不适用于第二个属性。

问题:有没有办法使用 TypeInfo 或 RTTI(或其他内容)将此 TVirtualInterface 对象动态转换为适当的接口(interface),以便 InstantiateData 方法和直接设置属性效果一样吗?

最佳答案

首先,您必须将实例转换为正确的接口(interface),而不是 IInterface。不过,您仍然可以将其存储在 IInterface 变量中,但它确实包含对正确接口(interface)类型的引用。

然后你必须将其放入具有正确类型的 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;

关于delphi - 在 Delphi XE3 中,如何使用 TypeInfo 或 RTTI 将 TVirtualInterface 对象强制转换为其接口(interface)?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/16048832/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com