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

Question

First, a little explanation about my situation:

I have a sample interface which is implemented by different classes, and these classes might not always have a shared ancestor:

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

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

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

I also have a factory method which is supposed to create an instance of an object which implements my interface. My factory method receives the class name as its parameter:

  function GetImplementation(const AClassName: string): IMyInterface;

I tried two approaches to implement this factory method, the first one was using extended 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;

In this approach I am calling the default constructor which is fine in my scenario. The problem with this is, at runtime, I get an error telling me the object does not support IMyInterface. What's more, the created object is not assigned to an interface variable; therefore, it will be leaked. I also tried returning the value using TValue.AsType method, but it gives me Access Violation:

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;

.

The second approach I tried was using a generic dictionary to hold pairs of , and provide registration, unregistration methods:

  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;

Here I implemented GetImplementation method as this:

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;

This works fine, and I can call DoSomething method using the returned value of GetImplementation, but it still has the memory-leak problem; Obj which is created here is not assigned to any interface variable; therefore, it is not reference-counted, and is leaked.

.

Now, my actual question:

So my question is, how can I safely create an instance of a class which implements my interface at runtime? I saw Delphi Spring Framework, and it provides such functionality in its Spring.Services unit, but it has its own reflection routines and lifetime management models. I am looking for a lightweight solution, not a whole 3rd-party framework to do this for me.

Regards

Answer 1

The first case using the RTTI give you a access violation because the TRttiContext.FindType(AClassName) cannot find the Rtti info for the classes which are not registered or used explicity in the app.

So you can change your code to

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;

and call in this way

AClass:=GetImplementation(TMyImp2);

Now if you want to use the Class name to invoke the class, using a list (like your TRepository class) to register the classes is a valid aproach. about the memory leak i'm pretty sure which is caused because the TMyImpl class is derived from the TInterfacedPersistent which not implement reference counting directly like the TInterfacedObject .

This implementation of the the TRepository must works ok.

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;

Answer 2

I think I would opt for the second option, mainly because I prefer to avoid RTTI unless it is the only possible solution to a problem.

But in both your proposed options you state that

the object which is created here is not assigned to any interface variable

That's simply not true. In both cases you assign to Result which has type IMyInterface . If you have a memory leak, it is caused by some other code, not by this code.

And @RRUZ has found the cause of the leak – namely using TInterfacedPersistent which does not implement reference counted lifetime management. Your code won't leak for TInterfacedObject .

For what it is worth, I would assign directly to the interface variable rather than via an object reference, but that is just a matter of stylistic preference.

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

Answer 3

You can do it using extended RTTI and TObject's GetInterface method:

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;

It won't work if the object overrides QueryInterface to do custom processing, but both TInterfacedPersistent and TInterfacedObject rely on GetInterface.