Is there a non-reference-counted base class like TInterfacedObject?

Question

I need a base class like TInterfacedObject but without reference counting (so a kind of TNonRefCountedInterfacedObject).

This actually is the nth time I need such a class and somehow I always end up writing (read: copy and pasting) my own again and again. I cannot believe that there is no "official" base class I can use.

Is there a base class somewhere in the RTL implementing IInterface but without reference counting which I can derive my classes from?

Answer 1

In the unit Generics.Defaults there is a class TSingletonImplementation defined. Available in Delphi 2009 and above.

  // A non-reference-counted IInterface implementation.
  TSingletonImplementation = class(TObject, IInterface)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

Answer 2

I did this. It can be used in place of TInterfacedObject with or without reference counting. It also has a name property - very useful when debugging.

// TArtInterfacedObject
// =============================================================================


// An object that supports interfaces, allowing naming and optional reference counting
type
  TArtInterfacedObject = class( TInterfacedObject )
    constructor Create( AReferenceCounted : boolean = True);
  PRIVATE
    FName             : string;
    FReferenceCounted : boolean;
  PROTECTED
    procedure SetName( const AName : string ); virtual;
  PUBLIC

    property Name : string
               read FName
               write SetName;

    function QueryInterface(const AGUID : TGUID; out Obj): HResult; stdcall;
    function SupportsInterface( const AGUID : TGUID ) : boolean;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

  end;

// =============================================================================




{ TArtInterfacedObject }

constructor TArtInterfacedObject.Create( AReferenceCounted : boolean = True);
begin
  inherited Create;

  FName := '';

  FReferenceCounted := AReferenceCounted;
end;

function TArtInterfacedObject.QueryInterface(const AGUID: TGUID; out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  If FReferenceCounted then
    Result := inherited QueryInterface( AGUID, Obj )
   else
    if GetInterface(AGUID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;


procedure TArtInterfacedObject.SetName(const AName: string);
begin
  FName := AName;
end;

function TArtInterfacedObject.SupportsInterface(
  const AGUID: TGUID): boolean;
var
  P : TObject;
begin
  Result := QueryInterface( AGUID, P ) = S_OK;
end;


function TArtInterfacedObject._AddRef: Integer;
begin
  If FReferenceCounted then
    Result := inherited _AddRef
   else
    Result := -1   // -1 indicates no reference counting is taking place
end;

function TArtInterfacedObject._Release: Integer;
begin
  If FReferenceCounted then
    Result := inherited _Release
   else
    Result := -1   // -1 indicates no reference counting is taking place
end;


// =============================================================================

Answer 3

You might consider TInterfacedPersistent. If you don't override GetOwner it does no ref-counting.