In Delphi XE3, how can I include a TVirtualInterface object in my interface using TypeInfo or RTTI?

Question

I am trying to use TVirtualInterface. I basically tried to follow the examples in the Embarcadero doc wiki and Nick Hodges Blog .

However, what I'm trying to do is slightly different from standard examples.

I have simplified the following sample code as much as I can illustrate what I'm trying to do. I missed the obvious error checking and handling code.

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. 

I have some arbitrary interfaces with read / write properties, ITestData and IMoreData , as well as a class containing links to these interfaces, IDataHolder .

I created the TVirtualData class, which inherits from TVirtualInterface , following Nick Hodges's examples. And when I use this class, as I see it in all examples, like in Test_UsingDirectInstantiation , it works swell.

However, my code should create the interface in a more indirect way, as in Test_UsingIndirectInstantiation .

The InstantiateData method uses RTTI and works well until you call SetValue , which throws an EInvalidCast exception ("Invalid typecast type").

I added to the commented line (which I saw in some example code from Delphic Witchcraft) to try to apply the data object to the corresponding interface. This allowed the SetValue call to be SetValue , but when I tried to access the interface property (i.e. dataHolder.TestData.Comment ), he threw an EAccessViolation exception ("Access violation at address 00000000. Reading address 00000000").

For fun, I replaced IInterface with the InstantiateData method with ITestData , and for the first property it worked fine, but naturally it did not work for the second property.

Question: Is there a way to dynamically apply this TVirtualInterface object to the corresponding interface using TypeInfo or RTTI (or something else) so that the InstantiateData method has the same effect as setting the property directly?

Answer 1

First you need to direct the instance to the correct interface, not to IInterface. You can still save it in the IInterface variable, but in reality it contains a link to the correct interface type.

Then you should put this in a TValue with the correct type, and not with IInterface (RTTI is very strict about types)

The comment line you added is intended only to work in the second, but since it really contained an IInterface link (and not a link to ITestData or TMoreData), it appeared on 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;