Delphi - 无法将 TVirtualInterface 转换为虚拟化接口的基本接口

Question

你好，

我正在使用 TVirtualInterface 来实现一些接口。这些接口代表可以在数据库中找到的密钥。我使用定制的代码生成器生成接口定义。例如：

// Base code 

IKey = interface
  function KeyFields : string;
  function KeyValues : Variant;
  function GetKeyValue(const aKeyName : string) : Variant;
  procedure SetKeyValue(const aKeyName : string; Value : Variant);
end;

// Generated code

ITable1Key = interface(IKey)
end;

ITable1Key1 = interface(ITable1Key)
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
end;

ITable1Key2 = interface(ITable1Key)
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
  procedure SetField2(const Value : string);
  function GetField2 : string;
  property Field2 : string read GetField1 write SetField1;
end;

// Other generated declarations

我使用 TVirtualInterface 来实现每个 IKey 接口，而不是一一实现。

不过，在我的 TVirtualInterface 中：

TKey = TVirtualInterface
public
  constructor Create(aType : PTypeInfo);
  function Cast : IKey;
end;

TKey<T : IKey>
public
  constructor Create; reintroduce;
  function Cast : T;
end;


constructor TKey.Create(aType : PTypeInfo)
begin
  inherited Create(aType, aHandlerMethod);
end;

function TKey.Cast;
var
  pInfo: PTypeInfo;
begin
  pInfo := TypeInfo(IKey);
  if QueryInterface(GetTypeData(pInfo).Guid, Result) <> 0 then
  begin
    raise Exception.CreateFmt('Sorry, TKey is unable to cast %s to its interface ', [string(pInfo.Name)]);
  end;
end;

constructor TKey<T>.Create;
begin
  inherited Create(TypeInfo(T));
end;

function TKey<T>.Cast;
var
  pInfo: PTypeInfo;
begin
  pInfo := TypeInfo(T);
  if QueryInterface(GetTypeData(pInfo).Guid, Result) <> 0 then
  begin
    raise Exception.CreateFmt('Sorry, TKey<T> is unable to cast %s to its interface ', [string(pInfo.Name)]);
  end;
end;

使用 TKey.Cast 方法将 TKey 虚拟接口转换为 T 类型没有问题，尽管 TKey.Cast 返回一个不支持的接口错误。

我检查了 System.Rtti 中没有按我想要的方式工作的部分：

function TVirtualInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if iid = FIID then
  begin
    _AddRef;
    Pointer(Obj) := @VTable;
    Result := S_OK;
  end
  else
    Result := inherited
end;

现在，如何强制 TVirtualInterface 将自身转换为 IID，它是 FIID 字段的父接口？我是否必须为 IKey 接口创建另一个 TVirtualInterface 实例？

非常感谢。

Answer 1

您误用了TVirtualInterface。它只是一个 RTTI 助手，你根本不应该从它派生。您应该从 TInterfacedObject 派生。

此外，您的两个TKey 类都忽略了传递给构造函数的PTypeInfo。非通用TKey.Cast() 始终只查询IKey，绝不是后代接口。通用TKey<T>.Cast 总是重新查询T 的RTTI 以获取其IID。所以去掉构造函数中的PTypeInfo，就浪费了。

由于非泛型TKey 只是一个基类，实际上根本没有实现任何派生接口，因此TKey.QueryInterface() 对于IKey 本身以外的任何接口总是会失败。至少 Generic TKey 可以查询派生接口。

无论如何，您的Cast 函数都是多余的，因为您可以使用as 运算符或SysUtils.Supports() 函数将一个接口转换为另一个接口。这些是首选方法，而不是手动使用QueryInterface()。

无论如何，您的接口在其声明中都缺少 IID，因此您无论如何都不能在接口之间进行转换。

试试这样的：

// Base code 

IKey = interface
  ['{D6D212E0-C173-468C-8267-962CFC3FECF5}']
  function KeyFields : string;
  function KeyValues : Variant;
  function GetKeyValue(const aKeyName : string) : Variant;
  procedure SetKeyValue(const aKeyName : string; Value : Variant);
end;

// Generated code

ITable1Key = interface(IKey)
  ['{B8E44C43-7248-442C-AE1B-6B9E426372C1}']
end;

ITable1Key1 = interface(ITable1Key)
  ['{0C86ECAA-A8E7-49EB-834F-77DE62BE1D28}']
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
end;

ITable1Key2 = interface(ITable1Key)
  ['{82226DE9-221C-4268-B971-CD72617C19C7}']
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
  procedure SetField2(const Value : string);
  function GetField2 : string;
  property Field2 : string read GetField1 write SetField1;
end;

// Other generated declarations

type
  TKey = class(TInterfacedObject, IKey)
  public
    function Cast : IKey;
    // IKey methods...
  end;

  TKey<T : IKey> = class(TInterfacedObject, IKey, T)
  public
    function Cast : T;
  end;

  TTable1Key = class(TKey, IKey, ITable1Key)
  end;

  TTable1Key1 = class(TTable1Key, IKey, ITable1Key, ITable1Key1)
  public
    // ITable1Key1 methods...
  end;

  TTable1Key2 = class(TTable1Key, IKey, ITable1Key, ITable1Key2)
  public
    // Table1Key2 methods...
  end;

// and so on ...

function TKey.Cast: IKey;
begin
  if not Supports(Self, IKey, Result) then
    raise Exception.Create('Sorry, unable to cast to IKey');
end;

function TKey<T>.Cast: T;
begin
  if not Supports(Self, GetTypeData(TypeInfo(T)).Guid, Result) then
    raise Exception.CreateFmt('Sorry, unable to cast to %s', [string(TypeInfo(T).Name)]);
end;

// other class methods as needed ...

还要注意派生类如何必须重复其基类实现的接口。这是一个已知的 Delphi 限制。派生类不继承基类接口。每个类都必须明确指定它实现的接口，即使实际实现在基类中。