1

As I had before in Java, I try to do a ServiceLocator in Delphi. Some code exist but it's didn't work like expected.

I don't want a case with enum or anything else, I want a code that I don't have to touch when I create a new class.

I have a global interface for my application, and all the other :

type
  IMyApp = interface
  end;

  IBuilder = interface(IMyApp)
    procedure Build;
  end;

  IPrint = interface(IMyApp)
    procedure Print;
  end;

  ICalculator = interface(IMyApp)
    procedure Calc;
  end;

I want a class like that, where I create the implementation directly by the interface, and that the object is create by find it (maybe with RTTI ?) :

class function TServiceLocator.Get(aInterface: IMyApp): IMyApp;
var
 C : TRttiContext;
 T : TRttiInstanceType;
 V : TValue;
 ClassNameToCreate: string;
begin
  // Ex: TBuilder (Replace I by T)
  ClassNameToCreate := 'T' + Copy(aInterface.GetName, 1, aInterface.GetName.Length);

  T := (C.FindType(ClassNameToCreate) as TRttiInstanceType);
  Result := V as IMyApp;
end;

var
  b: IBuilder;
begin
  b := TServiceLocator.Get(IBuilder);
  b.Build;
end.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
Bosshoss
  • 783
  • 6
  • 24

1 Answers1

2

Rather than use an ordinary function parameter, have TServiceLocator.Get() use a Generic parameter instead.

You can then use an IMyApp constraint so that only IMyApp and descendants can be specified. You can get the requested interface type name using the parameter's RTTI (via TypeInfo().Name).

You will also have to define a base class with a virtual constructor for your interface implementation classes to derive from. That way, you have something concrete that you can create from the class type you get from TRttiContext.FindType(). You can't instantiate a class object from just a TRttiType alone (see How do I instantiate a class from its TRttiType?).

For example, try something like this:

type
  IMyApp = interface
    ['{3E8332C3-8C23-481A-9609-8982B66E840A}']
  end;

  TMyAppBase = class(TInterfacedObject, IMyApp)
  public
    constructor Create; virtual;
  end;

  TMyAppBaseClass = class of TMyAppBase;

  TServiceLocator = class
  public
    class function Get<T: IMyApp>(): T;
  end;

...

constructor TMyAppBase.Create;
begin
  inherited Create;
end;

class function TServiceLocator.Get<T: IMyApp>(): T;
var
  ClassNameToCreate: string;
  Ctx : TRttiContext;
  Typ : TRttiInstanceType;
  Cls: TClass;
begin
  Result := nil;

  // Ex: TBuilder (Replace I by T)
  ClassNameToCreate := 'T' + Copy(TypeInfo(T).Name, 2, MaxInt);

  Typ := Ctx.FindType(ClassNameToCreate);
  if not ((Typ <> nil) and Typ.IsInstance) then
    Exit; // or raise...

  Cls := Typ.AsInstance.MetaclassType;
  if not Cls.InheritsFrom(TMyAppBase) then
    Exit; // or raise...

  Result := TMyAppBaseClass(Cls).Create as T;
end;

Then you can do this:

type
  IBuilder = interface(IMyApp)
    ['{350FA31A-ECA5-4419-BAB5-5D2519B8BF03}']
    procedure Build;
  end;

  IPrint = interface(IMyApp)
    ['{F726FDDE-A26E-4D0D-BB48-0F639EE34189}']
    procedure Print;
  end;

  ICalculator = interface(IMyApp)
    ['{27E3836B-05B6-4C0B-ABED-C62E6BE194F2}']
    procedure Calc;
  end;

  TBuilder = class(TMyAppBase, IBuilder)
  public
    constructor Create; override; // if needed
    procedure Build;
  end;

  TPrint = class(TMyAppBase, IPrint)
  public
    constructor Create; override; // if needed
    procedure Print;
  end;

  TCalculator = class(TMyAppBase, ICalculator)
  public
    constructor Create; override; // if needed
    procedure Calc;
  end;

...

constructor TBuilder.Create;
begin
  inherited Create;
  ...
end;

procedure TBuilder.Build;
begin
  ...
end;

constructor TPrint.Create;
begin
  inherited Create;
  ...
end;

procedure TPrint.Print;
begin
  ...
end;

constructor TCalculator.Create;
begin
  inherited Create;
  ...
end;

procedure TCalculator.Calc;
begin
  ...
end;
var
  b: IBuilder;
begin
  b := TServiceLocator.Get<IBuilder>();
  b.Build;
end.
Remy Lebeau
  • 555,201
  • 31
  • 458
  • 770
  • Thanks but the FindType return nil when I search my class or myUnit.myClass, do I need to do something ? – Bosshoss Sep 15 '20 at 07:32