How to solve an interface mess - delphi

Question

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.

Answer 1

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.

Answer 2

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.

Answer 3

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.