Add an interface to a class afterwards

Question

Is it possible to add and implement an interface to an already existing class (which is a descendant of TInterfaced or TInterfacedPersistent) to accomplish separating Model and View into 2 units?

A small explanation why I need something like this:

I am developing a tree-structure, open-type model, which has following structure (VERY simplified and incomplete, just to illustrate the outline of the problem):

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;

Using a GUID-based RTTI (which uses ClassGUID), the function GetChildNodes is able to find the matching class and initialize it with the raw data. (Each dataset contains ClassGUID and RawData beside other data like created/updated timestamps)

It is important to notice that my API (Database_Kernel.pas) is strictly separated from the vendor's node classes (Vendor_Specific_Stuff.pas).

---

A vendor-specific program's GUI wants to visualize the nodes, e.g. giving them an user-friendly name, an icon etc.

Following idea works:

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

The vendor's specific descendants of TVMDNode in Vendor_Specific_Stuff.pas will implement the IGraphicNode interface.

But the vendor also needs to change Database_Kernel.pas to implement IGraphicNode to the base node class TVMDNode (which is used for "unknown" nodes, where RTTI was unable to find the matching class of the dataset, so at least the binary raw data can be read using TVMDNode.RawData).

So he will change my class as follows:

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;

The problem is that IGraphicNode is vendor/program-specific and should not be in the API's Database_Kernel.pas, since GUI and Model/API should be strictly divided.

My wish would be that the interace IGraphicNode could be added and implemented to the existing TVMDNode class (which is already a descendant of TInterfacedPersistent to allow interfaces) in a separate unit. As far as I know, Delphi does not support something like this.

Beside the fact that it is not nice to mix Model and View in one single unit/class, there will be following real-world problem: If the vendor has to change my Database_Kernel.pas API to extend TVMDNode with the IGraphicNode interface, he needs to re-do all his changes, as soon as I release a new version of my API Database_Kernel.pas.

What should I do? I thought very long about possible solutions possible with Delphi's OOP. A workaround may be nesting TVMDNode's into a container class, which has a secondary RTTI, so after I have found the TVMDNode class, I could search for a TVMDNodeGUIContainer class. But this sounds very strangle and like a dirty hack.

PS: This API is an OpenSource/GPL project. I am trying to stay compatible with old generations of Delphi (e.g. 6), since I want to maximize the number of possible users. However, if a solution of the problem above is only possible with the new generation of Delphi languages, I might consider dropping Delphi 6 support for this API.

Answer 1

Yes it is possible.

We implemented something similar to gain control of global/singletons for testing purposes. We changed our singletons to be accessible as interfaces on the application (not TApplication, our own equivalent). Then we added the ability to dynamically add/remove interfaces at run-time. Now our test cases are able to plug in suitable mocks as and when needed.

I'll describe the general approach, hopefully you'll be able to apply it to the specifics of your situation.

1. Add a field to hold a list of dynamically added interface. An TInterfaceList works nicely.
2. Add methods to add/remove the dynamic interfaces.
3. Override function QueryInterface(const IID: TGUID; out Obj): HResult; virtual;. Your implementation will first check the interface list, and if not found will defer to the base implementation.

---

Edit: Sample Code

To answer your question:

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?

When you add the interface, you're adding an instance of the object that implements the interface. This is very much like the normal property ... implements <interface> technique to delegate implementation of an interface to another object. The key difference being this is dynamic. As such it will have the same kinds of limitations: E.g. no access to the "host" unless explicitly given a reference.

The following DUnit test case demonstrates a simplified version of the technique in action.

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.