在运行时创建接口实现实例

Question

首先,对我的情况做一点解释:

我有一个由不同类实现的示例接口,这些类可能并不总是具有共享的祖先:

  IMyInterface = interface
    ['{1BD8F7E3-2C8B-4138-841B-28686708DA4D}']
    procedure DoSomething;
  end;

  TMyImpl = class(TInterfacedPersistent, IMyInterface)
    procedure DoSomething;
  end;

  TMyImp2 = class(TInterfacedObject, IMyInterface)
    procedure DoSomething;
  end;

我还有一个工厂方法,它应该创建一个实现我的接口的对象的实例.我的工厂方法接收类名作为其参数:

  function GetImplementation(const AClassName: string): IMyInterface;

我尝试了两种方法来实现这个工厂方法,第一种是使用扩展RTTI:

var
  ctx : TRttiContext;
  t : TRttiInstanceType;
begin
  t := ctx.FindType(AClassName).AsInstance;
  if Assigned(t) then
    Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface as IMyInterface;
end;

在这种方法中,我调用默认构造函数,这在我的场景中很好.这个问题是,在运行时,我得到一个错误告诉我该对象不支持IMyInterface.更重要的是,创建的对象未分配给接口变量; 因此,它将被泄露.我也尝试使用TValue.AsType方法返回值,但它给了我访问冲突:

function GetImplementation(const AClassName: string): IMyInterface;
var
  ctx : TRttiContext;
  rt : TRttiInstanceType;
  V : TValue;
begin
  rt := ctx.FindType(AClassName).AsInstance;
  if Assigned(rt) then
  begin
    V := rt.GetMethod('Create').Invoke(rt.MetaclassType, []);
    Result := V.AsType<IMyInterface>;
  end;
end;

.

我尝试的第二种方法是使用通用字典来保存对,并提供注册,取消注册方法:

  TRepository = class
  private
    FDictionary : TDictionary<string, TClass>;
  public
    constructor Create;
    destructor Destroy; override;
    function GetImplementation(const AClassName: string): IMyInterface;
    procedure RegisterClass(AClass: TClass);
    procedure UnregisterClass(AClass: TClass);
  end;

这里我实现了GetImplementation方法:

function TRepository.GetImplementation(const AClassName: string): IMyInterface;
var
  Obj : TObject;
begin
  if FDictionary.ContainsKey(AClassName) then
  begin
    Obj := FDictionary[AClassName].Create;
    Obj.GetInterface(IMyInterface, Result);
  end;
end;

这工作正常,我可以使用GetImplementation的返回值调用DoSomething方法,但它仍然存在内存泄漏问题; 在此创建的Obj未分配给任何接口变量; 因此,它不是参考计数,而是泄露.

.

现在,我的实际问题:

所以我的问题是,如何安全地创建一个在运行时实现我的接口的类的实例？我看到了Delphi Spring Framework,它在Spring.Services单元中提供了这样的功能,但它有自己的反射例程和生命周期管理模型.我正在寻找一个轻量级的解决方案,而不是一个完整的第三方框架来为我做这个.

问候

Answer 1

使用RTTI的第一种情况会给您一个访问冲突,因为 TRttiContext.FindType(AClassName)无法找到未在应用程序中注册或使用的类的Rtti信息.

所以你可以改变你的代码

function GetImplementation(AClass: TClass): IMyInterface;
var
  ctx : TRttiContext;
  t : TRttiInstanceType;
begin
  t := ctx.GetType(AClass).AsInstance;
  if Assigned(t) then
    Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface As IMyInterface;
end;

并以这种方式打电话

AClass:=GetImplementation(TMyImp2);

现在,如果您想使用类名来调用该类,则使用列表(如您的TRepository类)来注册类是一种有效的方法.关于内存泄漏我很确定是什么原因造成的,因为TMyImpl该类派生自TInterfacedPersistent那些没有直接实现引用计数的类TInterfacedObject.

这个实现TRepository必须正常.

constructor TRepository.Create;
begin
  FDictionary:=TDictionary<string,TClass>.Create;
end;

destructor TRepository.Destroy;
begin
  FDictionary.Free;
  inherited;
end;

function TRepository.GetImplementation(const AClassName: string): IMyInterface;
var
  Obj : TObject;
begin
  if FDictionary.ContainsKey(AClassName) then
  begin
    Obj := FDictionary[AClassName].Create;
    Obj.GetInterface(IMyInterface, Result);
  end;
end;

{
or using the RTTI
var
  ctx : TRttiContext;
  t : TRttiInstanceType;
begin
  t := ctx.GetType(FDictionary[AClassName]).AsInstance;
  if Assigned(t) then
    Result := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsInterface As IMyInterface;
end;
}

procedure TRepository.RegisterClass(AClass: TClass);
begin
  FDictionary.Add(AClass.ClassName,AClass);
end;

procedure TRepository.UnregisterClass(AClass: TClass);
begin
  FDictionary.Remove(AClass.ClassName);
end;