德尔福服务定位器

Question

正如我以前在 Java 中所做的那样，我尝试在 Delphi 中做一个 ServiceLocator。一些代码存在，但它没有像预期的那样工作。

我不想要带有枚举或其他任何内容的案例，我想要一个在创建新类时不必接触的代码。

我的应用程序和所有其他应用程序都有一个全局接口：

type
  IMyApp = interface
  end;

  IBuilder = interface(IMyApp)
    procedure Build;
  end;

  IPrint = interface(IMyApp)
    procedure Print;
  end;

  ICalculator = interface(IMyApp)
    procedure Calc;
  end;

我想要一个这样的类，我直接通过接口创建实现，并且对象是通过 find 它创建的（也许使用 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.

Answer 1

不要使用普通的函数参数，而是让TServiceLocator.Get() 使用Generic 参数。

然后您可以使用IMyApp constraint 以便只能指定IMyApp 和后代。您可以使用参数的 RTTI（通过TypeInfo().Name）获取请求的接口类型名称。

您还必须定义一个带有虚拟构造函数的基类，以便您的接口实现类从中派生。这样，您就可以根据从TRttiContext.FindType() 获得的类类型创建一些具体的东西。您不能仅从 TRttiType 实例化一个类对象（请参阅 How do I instantiate a class from its TRttiType?）。

例如，试试这样的：

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;

那么你可以这样做：

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.