Interface factory Example

interface_factory.pas

program interface_factory;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Generics.Collections;

type
  { IBaseInterface }
  IBaseInterface = interface
    ['{A216EADB-08C1-4D59-B455-D5978109DC7B}']
  end;

  { TBaseInterface }
  TBaseInterface = class(TNoRefCountObject, IBaseInterface)
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  { TBaseInterfaceClass }
  TBaseInterfaceClass = class of TBaseInterface;

  { IObj1 }
  IObj1 = interface(IBaseInterface)
    ['{57E95F6B-D317-4C36-9C62-0F537C053340}']
    function Name: WideString;
  end;

  { TObj1 }
  TObj1 = class(TBaseInterface, IObj1)
  public
    function Name: WideString;
  end;

  { IObj2 }
  IObj2 = interface(IBaseInterface)
    ['{185B4A13-CB6D-46C8-BF9D-1DBC13727ABB}']
    function Name: WideString;
  end;

  { TObj2 }
  TObj2 = class(TBaseInterface, IObj2)
  public
    function Name: WideString;
  end;

  { IObj3 }
  IObj3 = interface(IBaseInterface)
    ['{25346D17-9B83-4988-B944-FE673FC6A17E}']
    function Name: WideString;
  end;

  { TObj3 }
  TObj3 = class(TBaseInterface, IObj3)
  public
    function Name: WideString;
  end;

  { TFactory }
  TFactory = class
  protected
    FList: TDictionary<TGUID, TBaseInterfaceClass>;
  public
    constructor Create;
    destructor Destroy; override;
    function RegisterInterface(const aGUID: TGUID; const aClass: TBaseInterfaceClass): Boolean;
    function GetInterface(const aGUID: TGUID; const [ref] aInterface: IBaseInterface): Boolean;
    function ReleaseInterface(const [ref] aInterface: IBaseInterface): Boolean;
  end;

{ TBaseInterface }
constructor TBaseInterface.Create;
begin
  inherited;
end;

destructor TBaseInterface.Destroy;
begin
  inherited;
end;

{ TObj1 }
function TObj1.Name: WideString;
begin
  Result := 'TObj1';
end;

{ TObj2 }
function TObj2.Name: WideString;
begin
  Result := 'TObj2';
end;

{ TObj3 }
function TObj3.Name: WideString;
begin
  Result := 'TObj3';
end;

{ TFactory }
constructor TFactory.Create;
begin
  inherited;
  FList := TDictionary<TGUID, TBaseInterfaceClass>.Create;
end;

destructor TFactory.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;

function TFactory.RegisterInterface(const aGUID: TGUID; const aClass: TBaseInterfaceClass): Boolean;
begin
  if Supports(aClass, aGUID) then
    Result := FList.TryAdd(aGUID, aClass)
  else
    Result := False;
end;

function TFactory.GetInterface(const aGUID: TGUID; const [ref] aInterface: IBaseInterface): Boolean;
var
  LClass: TBaseInterfaceClass;
  LInterface: IBaseInterface;
  LTemp: IBaseInterface;
begin
  if FList.TryGetValue(aGUID, LClass) then
    begin
      LInterface := LClass.Create;
      Result := Supports(LInterface, aGUID, LTemp);
      if Result then
        IBaseInterface(Pointer(@aInterface)^) := LTemp
      else
        IBaseInterface(Pointer(@aInterface)^) := nil;
    end
  else
    begin
      IBaseInterface(Pointer(@aInterface)^) := nil;
      Result := False;
    end;
end;

function TFactory.ReleaseInterface(const [ref] aInterface: IBaseInterface): Boolean;
var
  Temp: TBaseInterface;
begin
  Result := False;
  if aInterface = nil then Exit;
  Temp := TBaseInterface(aInterface);
  IBaseInterface(Pointer(@aInterface)^) := nil;
  Temp.Free;
  Result := True;
end;

var
  F: TFactory;
  I1: IObj1;
  I2: IObj2;
  I3: IObj3;
begin
  ReportMemoryLeaksOnShutdown := True;

  try
    F := TFactory.Create;
    F.RegisterInterface(IObj1, TObj1);
    F.RegisterInterface(IObj2, TObj2);

    if F.GetInterface(IObj1, I1) then
      begin
        WriteLn(I1.Name);
        F.ReleaseInterface(I1);
      end
    else
      WriteLn('IObj1 not registered');


    if F.GetInterface(IObj2, I2) then
      begin
        WriteLn(I2.Name);
        F.ReleaseInterface(I2);
      end
    else
      WriteLn('IObj2 not registered');

    if F.GetInterface(IObj3, I3) then
      begin
        WriteLn(I3.Name);
        F.ReleaseInterface(I3);
      end
    else
      WriteLn('IObj3 not registered');

    FreeAndNil(F);

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.