delphi - 之后向类添加接口(interface)

Question

是否可以向现有类(它是 TInterfaced 或 TInterfacedPersistent 的后代)添加和实现接口(interface)，以将模型和 View 分离为 2 个单元？

一个小解释为什么我需要这样的东西:

我正在开发一个树形结构、开放式模型，其结构如下(非常简化且不完整，只是为了说明问题的轮廓):

Database_Kernel.pas

TVMDNode = class(TInterfacedPersistent);
public
  class function ClassGUID: TGUID; virtual; abstract; // constant. used for RTTI

  property RawData: TBytes {...};
  constructor Create(ARawData: TBytes);

  function GetParent: TVMDNode;
  function GetChildNodes: TList<TVMDNode>;
end;

Vendor_Specific_Stuff.pas

TImageNode = class(TVMDNode)
public
  class function ClassGUID: TGUID; override; // constant. used for RTTI

  // Will be interpreted out of the raw binary data of the inherited class
  property Image: TImage {...};
end;

TUTF8Node = class(TVMDNode)
public
  class function ClassGUID: TGUID; override; // constant. used for RTTI

  // Will be interpreted out of the raw binary data of the inherited class
  property StringContent: WideString {...};
end;

TContactNode = class(TVMDNode)
public
  class function ClassGUID: TGUID; override; // constant. used for RTTI

  // Will be interpreted out of the raw binary data of the inherited class
  property PreName: WideString {...};
  property FamilyName: WideString {...};
  property Address: WideString {...};
  property Birthday: TDate {...};
end;

使用基于 GUID 的 RTTI(使用 ClassGUID)，函数 GetChildNodes 能够找到匹配的类并使用原始数据对其进行初始化。 (每个数据集除了创建/更新时间戳等其他数据之外还包含 ClassGUID 和 RawData)

值得注意的是，我的 API (Database_Kernel.pas) 与供应商的节点类 (Vendor_Specific_Stuff.pas) 严格分开。

<小时/>

特定于供应商的程序的 GUI 想要可视化节点，例如给它们一个用户友好的名称、图标等。

以下想法有效:

IGraphicNode = interface(IInterface)
  function Visible: boolean;
  function Icon: TIcon;
  function UserFriendlyName: string;
end;

Vendor_Specific_Stuff.pas 中 TVMDNode 的供应商特定后代将实现 IGraphicNode 接口(interface)。

但是供应商还需要更改Database_Kernel.pas以将IGraphicNode实现为基节点类TVMDNode(用于“未知”) “节点，其中 RTTI 无法找到数据集的匹配类，因此至少可以使用 TVMDNode.RawData 读取二进制原始数据)。

所以他将改变我的类(class)如下:

TVMDNode = class(TInterfacedPersistent, IGraphicNode);
public
  property RawData: TBytes {...};
  class function ClassGUID: TGUID; virtual; abstract; // constant. used for RTTI
  constructor Create(ARawData: TBytes);
  function GetParent: TVMDNode;
  function GetChildNodes: TList<TVMDNode>;

  // --- IGraphicNode
  function Visible: boolean; virtual; // default behavior for unknown nodes: False
  function Icon: TIcon; virtual; // default behavior for unknown nodes: "?" icon
  function UserfriendlyName: string; virtual; // default behavior for unknown nodes: "Unknown"
end;

问题在于，IGraphicNode 是特定于供应商/程序的，不应该位于 API 的 Database_Kernel.pas 中，因为 GUI 和 Model/API 应该严格划分。

我的愿望是可以将接口(interface) IGraphicNode 添加并实现到现有的 TVMDNode 类(它已经是 TInterfacedPersistent 的后代)允许接口(interface))在一个单独的单元中。据我所知，Delphi不支持这样的东西。

除了将模型和 View 混合在一个单元/类中并不好这一事实之外，还会存在以下实际问题:如果供应商必须更改我的 Database_Kernel.pas API要使用 IGraphicNode 接口(interface)扩展 TVMDNode，一旦我发布新版本的 API Database_Kernel.pas<，他就需要重新进行所有更改。/.

我该怎么办？我对 Delphi 的 OOP 可能的解决方案思考了很长时间。解决方法可能是将 TVMDNode 嵌套到具有辅助 RTTI 的容器类中，因此在找到 TVMDNode 类后，我可以搜索 TVMDNodeGUIContainer 类。但这听起来非常令人窒息，就像一个肮脏的黑客。

PS:此 API 是一个 OpenSource/GPL 项目。我试图与老一代的 Delphi(例如 6)保持兼容，因为我想最大化可能的用户数量。但是，如果上述问题只能通过新一代 Delphi 语言才能解决，我可能会考虑放弃 Delphi 6 对此 API 的支持。

Answer 1

是的，这是可能的。

出于测试目的，我们实现了类似于获得全局/单例控制权的东西。我们将单例更改为可作为应用程序上的接口(interface)进行访问(不是 TApplication ，我们自己的等效项)。然后我们添加了在运行时动态添加/删除接口(interface)的功能。现在，我们的测试用例可以在需要时插入合适的模拟。

我将描述一般方法，希望您能够将其应用于您的具体情况。

1. 添加一个字段来保存动态添加的接口(interface)列表。安TInterfaceList效果很好。
2. 添加方法以添加/删除动态接口(interface)。
3. 覆盖function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; 。您的实现将首先检查接口(interface)列表，如果没有找到，将遵循基本实现。

<小时/>

编辑:示例代码

回答您的问题:

I understand that the class now can tell others that it supports interface X now, so the interface was ADDED during runtime. But I also need to IMPLEMENT the interface's methods from outside (another unit). How is this done?

添加接口(interface)时，您将添加实现该接口(interface)的对象的实例。这非常类似于普通的属性 ... 实现 技术，将接口(interface)的实现委托(delegate)给另一个对象。关键区别在于这是动态的。因此，它将具有相同的限制:例如除非明确给出引用，否则无法访问“主机”。

以下 DUnit 测试用例演示了该技术的简化版本。

unit tdDynamicInterfaces;

interface

uses
  SysUtils,
  Classes,
  TestFramework;

type
  TTestDynamicInterfaces = class(TTestCase)
  published
    procedure TestUseDynamicInterface;
  end;

type
  ISayHello = interface
    ['{6F6DDDE3-F9A5-407E-B5A4-CDF91791A05B}']
    function SayHello: string;
  end;

implementation

{ ImpGlobal }

type
  TDynamicInterfaces = class(TInterfacedObject, IInterface)
  { We must explicitly state that we are implementing IInterface so that
    our implementation of QueryInterface is used. }
  private
    FDynamicInterfaces: TInterfaceList;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddInterface(AImplementedInterface: IInterface);
  end;

type
  TImplementor = class (TInterfacedObject, ISayHello)
  { NOTE: This could easily have been implemented in a separate unit. }
  protected
    {ISayHello}
    function SayHello: string;
  end;

{ TDynamicInterfaces }

procedure TDynamicInterfaces.AddInterface(AImplementedInterface: IInterface);
begin
  { The simplest, but least flexible approach (see also QueryInterface).
    Other options entail tagging specific GUIDs to be associated with given
    implementation instance. Then it becomes feasible to check for duplicates
    and also dynamically remove specific interfaces. }
  FDynamicInterfaces.Add(AImplementedInterface);
end;

constructor TDynamicInterfaces.Create;
begin
  inherited Create;
  FDynamicInterfaces := TInterfaceList.Create;
end;

destructor TDynamicInterfaces.Destroy;
begin
  FDynamicInterfaces.Free;
  inherited Destroy;
end;

function TDynamicInterfaces.QueryInterface(const IID: TGUID; out Obj): HResult;
var
  LIntf: IInterface;
begin
  { This implementation basically means the first implementor added will be 
    returned in cases where multiple implementors support the same interface. }
  for LIntf in FDynamicInterfaces do
  begin
    if Supports(LIntf, IID, Obj) then
    begin
      Result := S_OK;
      Exit;
    end;
  end;

  Result := inherited QueryInterface(IID, Obj);
end;

{ TImplementor }

function TImplementor.SayHello: string;
begin
  Result := 'Hello. My name is, ' + ClassName;
end;

{ TTestDynamicInterfaces }

procedure TTestDynamicInterfaces.TestUseDynamicInterface;
var
  LDynamicInterfaceObject: TDynamicInterfaces;
  LInterfaceRef: IUnknown;
  LFriend: ISayHello;
  LActualResult: string;
begin
  LActualResult := '';

  { Use ObjRef for convenience to not declare interface with "AddInterface" }
  LDynamicInterfaceObject := TDynamicInterfaces.Create;
  { But lifetime is still managed by the InterfaceRef. }
  LInterfaceRef := LDynamicInterfaceObject;

  { Comment out the next line to see what happens when support for 
    interface is not dynamically added. }
  LDynamicInterfaceObject.AddInterface(TImplementor.Create);

  if Supports(LInterfaceRef, ISayHello, LFriend) then
  begin
    LFriend := LInterfaceRef as ISayHello;
    LActualResult := LFriend.SayHello;
  end;

  CheckEqualsString('Hello. My name is, TImplementor', LActualResult);
end;

end.