Существует ли базовый класс без учета ссылок, такой как TInterfacedObject?

Question

Мне нужен базовый класс, такой как TInterfacedObject, но без подсчета ссылок (так что вроде TNonRefCountedInterfacedObject).

Это на самом деле уже в девятый раз, когда мне нужен такой класс, и почему-то я всегда заканчиваю тем, что пишу (читай: копирую и вставляю) свой собственный снова и снова.Я не могу поверить, что не существует «официального» базового класса, который я мог бы использовать.

Есть ли где-то в RTL базовый класс, реализующий IInterface, но без подсчета ссылок, из которого я могу получить свои классы?

Answer 1

В модуле Generics.Defaults определен класс TSingletonImplementation.Доступно в Delphi 2009 и выше.

  // 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

Я сделал это.Он может использоваться вместо TInterfacedObject с подсчетом ссылок или без него.Он также имеет свойство name - очень полезно при отладке.

// 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

Вы можете рассмотреть TInterfacedPersistent .Если вы не переопределите GetOwner, он не будет пересчитывать счет.

Answer 4

Нет такого класса, но вы можете легко написать свой собственный, как показали другие.Я, однако, удивляюсь, зачем вам это нужно.По моему опыту, редко существует реальная потребность в таком классе, даже если вы хотите смешать ссылки на объекты и интерфейсы.

Также обратите внимание, что когда вы используете такой класс, вам все равно придется позаботиться о том, чтобы любые ссылки на интерфейсы, которые у вас были, на такой объект равны нулю, прежде чем они покинут область действия и перед тем, как освободить объект.В противном случае вы можете получить ситуацию, когда среда выполнения пытается вызвать _Release для освобожденного объекта, и это приводит к исключению недопустимого указателя.

IOW, я бы посоветовал против используя такой класс вообще.

Answer 5

Я не знаю ни одного готового базового класса, поэтому я написал свой собственный (как и вы).Просто поместите его в общий блок утилит, и все готово.

type
  TPureInterfacedObject = class(TObject, IInterface)
  protected
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

{ TPureInterfacedObject }

function TPureInterfacedObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  Result := E_NOINTERFACE;
end;

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

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