CODEWITHSUNDEEP
delphiinterfacedelphi-2009
Wodzu
Wodzu

Reputation: 6979

How to solve an interface mess

I was always thinking about interfaces as a way to give different unrelated classes a common functionality. But the property of interface - "free an object when RefCOunt drops to zero" does not allow me to work as I want to.

For example: lets assume that I have two different classes: TMyObject and TMyDifferentObject. They both support this interface:

const
  IID_MyInterface: TGUID = '{4D91C27F-510D-4673-8773-5D0569DFD168}';

type
 IMyInterface = Interface(IInterface)
  ['{4D91C27F-510D-4673-8773-5D0569DFD168}']
  function GetID : Integer;
 end;

type
  TMyObject = class(TInterfacedObject, IMyInterface)
    function GetID: Integer;
  end;

function TMyObject.GetID: Integer;
begin
  Result := 1;
end;


type
  TMyDifferentObject = class(TInterfacedObject, IMyInterface)
    function GetID: Integer;
  end;

function TMyDifferentObject.GetID: Integer;
begin
  Result := 2;
end;

Now, I would like to create instances of this classes in my program, and then pass those instances to this method:

procedure ShowObjectID(AObject: TObject);
var
  MyInterface: IMyInterface;
begin
  if Supports(AObject, IID_MyInterface, MyInterface) then
  begin
    ShowMessage(IntToStr(MyInterface.GetID));
  end;
end;  //Interface goes out of scope and AObject is freed but I still want to work with that object!

This is an example. In general I want to pass instance of object to some procedure and check if this object supports an interface, if yes I want to execute method of this interface. But I don't want to finish work with that object when interface goes out of scope. How to do this?

Regards.

Upvotes: 2

Views: 434

Answers (3)

Ondrej Kelle
Ondrej Kelle

Reputation: 37211

Another option nobody mentioned so far is to explicitly call _AddRef on the object instance to keep it alive as long as you need it, then call _Release.

Upvotes: 3

David Heffernan
David Heffernan

Reputation: 612954

One approach to solve your problem is to change your code so that you only ever refer to the object through an interface reference. In other words instead of

var
  obj: TMyObject;
...
obj := TMyObject.Create;
try
  obj.DoStuff;
  //etc. etc.
finally
  obj.Free;
end;

you write

var
  obj: IMyObject;//NOTE: interface variable
...
obj := TMyObject.Create;
obj.DoStuff;
//etc. etc.
obj := nil;//or let it go out of scope and release that way

This can be inconvenient, so instead it can be more convenient to disable automatic lifetime management. You need to do this for your implementing object:

type
  TInterfacedObjectWithoutLifetimeManagement = class(TObject, IInterface)
  private
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

function TInterfacedObjectWithoutLifetimeManagement.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TInterfacedObjectWithoutLifetimeManagement._AddRef: Integer;
begin
  Result := -1;
end;

function TInterfacedObjectWithoutLifetimeManagement._Release: Integer;
begin
  Result := -1;
end;

You can then derive your classes from this class.

There is one very major caveat with this approach. Suppose that you hold in variables (local, global, class member) any interfaces that are implemented by a class derived from TInterfacedObjectWithoutLifetimeManagement. All such interface variables must be finalised before you call Free on the implementing object.

If you do not follow this rule you will find that when those interface variables go out of scope, the compiler still emits code to call _Release and it's an error to call a method on an object after it has been destroyed. This is a particularly nasty type of error because it commonly will not manifest itself with a runtime failure until your code runs on your most important client's machine! In other words such errors can be of intermittent nature.

Upvotes: 3

Marjan Venema
Marjan Venema

Reputation: 19346

Your problem probably stems from the fact that you create your objects using an object reference:

var
  MyObject: TObject;
begin
  MyObject := TMyObject.Create;
  ShowMessage('Before ShowObjectID MyObject RefCount: ' + IntToStr(MyObject.RefCount));
  ShowObjectID(MyObject);
  ShowMessage('After ShowObjectID MyObject RefCount: ' + IntToStr(MyObject.RefCount));
end;

Doing it like this means the RefCount after creation is zero. Either assign your object to an interface reference as well for as long as you need it, 

var
  MyObject: TMyObject;
  MyIntf: IMyInterface;
begin
  MyObject := TMyObject.Create;
  MyIntf := MyObject;
  ShowMessage('Before ShowObjectID MyObject RefCount: ' + IntToStr(MyObject.RefCount));
  ShowObjectID(MyObject);
  ShowMessage('After ShowObjectID MyObject RefCount: ' + IntToStr(MyObject.RefCount));
  MyIntf := nil;
  ShowMessage('After nilling the interface MyObject RefCount: ' + IntToStr(MyObject.RefCount));
end;

or disable refcounting as David suggested in the comments. Which essentially means declaring your own "TInterfacedObject" and implementing the three IInterface methods:

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;

The essence is to return -1 for both _AddRef and _Release. As David said: have a look at how TComponent does it. And just take what it is doing when FVCLComObject is nil.

Upvotes: 8

Related Questions