Wie kann ich in Delphi XE3 ein TVirtualInterface-Objekt mit TypeInfo oder RTTI auf die Schnittstelle übertragen?

Question

Ich versuche, TVirtualInterface zu verwenden. Ich habe meistens versucht, den Beispielen bei Embarcadero doc wiki und bei Nick Hodges' blog zu folgen.

Was ich versuche, ist jedoch ein wenig anders als die Standard-Beispiele.

Ich habe den folgenden Beispielcode so weit wie möglich vereinfacht, um zu veranschaulichen, was ich versuche zu tun. Ich habe offensichtliche Validierungs- und Fehlerbehandlungscodes weggelassen.

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. 

Ich habe einige beliebige Schnittstellen mit Lese/Schreib-Eigenschaften, ITestData und IMoreData, und eine Klasse, die Verweise auf diese Schnittstellen IDataHolder hält.

Ich habe eine Klasse TVirtualData erstellt, die von TVirtualInterface erbt, den Beispielen von Nick Hodges folgend. Und wenn ich diese Klasse so benutze, wie ich es in allen Beispielen sehe, wie in Test_UsingDirectInstantiation, funktioniert es gut.

Was mein Code jedoch tun muss, ist die Instanziierung der Schnittstellen in einer indirekteren Weise, wie in Test_UsingIndirectInstantiation.

Die Methode verwendet RTTI und funktioniert bis zum Aufruf SetValue, der eine EInvalidCast-Ausnahme auslöst ("Invalid class typecast").

Ich fügte in der kommentierten Zeile (die ich in einigen Beispielcode aus "Delphi Sorcery" sah) hinzu, um zu versuchen, das Datenobjekt auf die entsprechende Schnittstelle zu werfen. Dadurch konnte der Aufruf SetValue sauber ausgeführt werden, aber wenn ich versuchte, auf die Schnittstelleneigenschaft zuzugreifen (d. H. dataHolder.TestData.Comment), wurde eine EAccessViolation-Ausnahme ausgelöst ("Zugriffsverletzung bei Adresse 00000000. Leseadresse 00000000").

Zum Spaß ersetze ich IInterface in der InstantiateData Methode mit ITestData, und für die erste Eigenschaft hat es gut funktioniert, aber natürlich hat es nicht für die zweite Eigenschaft funktioniert.

Frage: Gibt es eine Möglichkeit dynamisch dieses TVirtualInterface Objekt an der entsprechenden Schnittstelle zu werfen mit Typeinfo oder RTTI (oder etwas anderes), so dass die InstantiateData Methode die gleiche Wirkung wie die Einstellung der Eigenschaften hat direkt?

Answer 1

Zuerst müssen Sie die Instanz auf die richtige Schnittstelle und nicht IInterface werfen. Sie können es zwar weiterhin in einer IInterface-Variablen speichern, es enthält jedoch den Verweis auf den richtigen Schnittstellentyp.

Dann muss man das in einen TValue mit den richtigen Typ setzen und nicht IInterface (RTTI ist sehr streng über Typen)

Die kommentierte Zeile, die Sie hinzugefügt war gleich um die zweite zu arbeiten, aber, wie es wirklich war, enthaltend Die IInterface-Referenz (und nicht eine ITestData oder TMoreData-Referenzen) ergab sich auf dem 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;