How to solve an interface mess

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.