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;的这种实现必须正常。

{{1}}

Answer 2

我想我会选择第二个选项，主要是因为我更愿意避免使用RTTI，除非它是解决问题的唯一可行方案。

但是在你提出的两个选项中你都说明了

此处创建的对象未分配给任何接口变量

这根本不是真的。在这两种情况下，您都会分配到Result，其类型为IMyInterface。如果您有内存泄漏，则由其他一些代码引起，而不是由此代码引起。

@RRUZ找到了泄漏的原因 - 即使用TInterfacedPersistent未实现引用计数生命周期管理。您的代码不会泄漏TInterfacedObject。

对于它的价值，我会直接分配给接口变量而不是通过对象引用，但这只是风格偏好的问题。

if FDictionary.TryGetValue(AClassName, MyClass) then
  Result := MyClass.Create as IMyInterface;

Answer 3

您可以使用扩展RTTI和TObject的GetInterface方法：

function GetImplementation(const AClassName: string): IMyInterface;
var
  ctx: TRttiContext;
  t : TRttiInstanceType;
  obj: TObject;
begin
  Result := nil;
  t := ctx.FindType(AClassName).AsInstance;
  if Assigned(t) then begin
    obj := t.GetMethod('Create').Invoke(t.MetaclassType, []).AsObject;
    obj.GetInterface(IMyInterface, Result)
  end;
end;

如果对象覆盖QueryInterface进行自定义处理，则无效，但 TInterfacedPersistent 和 TInterfacedObject 都依赖于GetInterface。

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

3 个答案: