Trong Delphi XE3, làm cách nào tôi có thể truyền đối tượng TVirtualInterface vào giao diện của nó, sử dụng TypeInfo hoặc RTTI?

Question

Tôi đang cố gắng sử dụng TVirtualInterface. Tôi chủ yếu cố gắng làm theo các ví dụ tại số Embarcadero doc wiki và tại Nick Hodges' blog.

Tuy nhiên, những gì tôi đang cố gắng làm là hơi khác so với ví dụ tiêu chuẩn.

Tôi đã đơn giản hóa mã mẫu sau nhiều nhất có thể để minh họa những gì tôi đang cố gắng làm. Tôi đã bỏ qua xác thực rõ ràng và mã xử lý lỗi.

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. 

Tôi có một số giao diện tùy ý với những đặc tính đọc/ghi, ITestData và IMoreData, và một lớp chứa tham chiếu đến các giao diện, IDataHolder.

Tôi đã tạo một lớp, TVirtualData, được kế thừa từ TVirtualInterface, theo ví dụ của Nick Hodges. Và khi tôi sử dụng lớp này theo cách tôi thấy trong tất cả các ví dụ, như trong Test_UsingDirectInstantiation, nó hoạt động sưng lên.

Mã của tôi cần làm gì, tuy nhiên, là khởi tạo giao diện theo cách gián tiếp hơn, như trong Test_UsingIndirectInstantiation.

Phương pháp InstantiateData sử dụng RTTI và hoạt động tốt cho đến khi cuộc gọi SetValue phát sinh ngoại lệ EInvalidCast ("Loại lớp không hợp lệ").

Tôi đã thêm vào dòng nhận xét (mà tôi đã thấy trong một số mã mẫu từ "Delphi Sorcery") để thử truyền đối tượng dữ liệu đến giao diện thích hợp. Điều này cho phép cuộc gọi SetValue chạy sạch, nhưng khi tôi cố gắng truy cập thuộc tính giao diện (ví dụ: dataHolder.TestData.Comment), nó đã ném ngoại lệ EAccessViolation ("Vi phạm truy cập tại địa chỉ 00000000. Đọc địa chỉ 00000000").

Để giải trí, tôi thay thế IInterface theo phương pháp InstantiateData với ITestData và đối với thuộc tính đầu tiên hoạt động tốt, nhưng tự nhiên, nó không hoạt động đối với thuộc tính thứ hai.

Câu hỏi: Có cách nào để tự động đúc tượng TVirtualInterface này để giao diện thích hợp sử dụng TypeInfo hoặc RTTI (hay cái gì khác) do đó các phương pháp InstantiateData có tác dụng tương tự như thiết lập các thuộc tính trực tiếp?

Answer 1

Trước tiên, bạn phải truyền đối tượng đó đến giao diện chính xác chứ không phải giao diện II. Bạn vẫn có thể lưu trữ nó trong một biến IInterface mặc dù nó thực sự chứa tham chiếu đến kiểu giao diện chính xác.

Sau đó, bạn cần phải đặt đó vào một TValue với đúng loại và không IInterface (RTTI là rất nghiêm ngặt về các loại)

Điểm mấu nhận xét bạn đã thêm có chỉ để làm việc xung quanh thứ hai nhưng khi nó đã thực sự có chứa tham chiếu IInterface (và không phải tài liệu tham khảo ITestData hoặc TMoreData) dẫn đến 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;