In Delphi XE3, how can I cast a TVirtualInterface object to its interface, using TypeInfo or RTTI?

casting, delphi, delphi-xe3, interface, rtti

Solution

First you have to cast the instance to the correct interface and not IInterface. You can still store it in an IInterface variable though but it really containes the reference to the correct interface type.

Then you have to put that into a TValue with the correct type and not IInterface (RTTI is very strict about types)

The commented line you added was just to work around the second but as it was really containing the IInterface reference (and not a ITestData or TMoreData references) it resulted on the 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;

Problem

I'm trying to use TVirtualInterface. I've mostly tried to follow the examples at the Embarcadero doc wiki and at Nick Hodges' blog. However, What I'm trying to do is a little bit different from the standard examples. I have simplified the following sample code as much as I can to illustrate what I am trying to do. I have left out obvious validation and error 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`, and a class that holds references to these interfaces, `IDataHolder`. I have created a class, `TVirtualData`, that inherits from `TVirtualInterface`, following Nick Hodges' examples. And when I use this class the way I see it in all the examples, as in `Test_UsingDirectInstantiation`, it works swell. What my code needs to do, however, is instantiate the interfaces in a more indirect manner, as in `Test_UsingIndirectInstantiation`. The `InstantiateData` method uses RTTI, and works well up until the `SetValue` call which throws an EInvalidCast exception ("Invalid class typecast"). I added in the commented line (which I saw in some sample code from "Delphi Sorcery") to try to cast the data object to the appropriate interface. This allowed the `SetValue` call to run cleanly, but when I tried to access the interface property (i.e. `dataHolder.TestData.Comment`) it threw a EAccessViolation exception ("Access violation at address 00000000. Read of address 00000000"). For fun I replace `IInterface` in the `InstantiateData` method with `ITestData`, and for the first property it worked fine, but naturally, it didn't work for the second property. Question: Is there a way to dynamically cast this `TVirtualInterface` object to the appropriate interface using TypeInfo or RTTI (or something else) so that the `InstantiateData` method has the same effect as setting the properties directly?

Original source