delphi - ¿Existe una clase base sin referencia como TInterfacedObject?

delphi-xe reference-counting

Question

Necesito una clase base como TInterfacedObject pero sin recuento de referencias (por lo tanto, una especie de TNonRefCountedInterfacedObject ).

Esta es realmente la novena vez que necesito una clase así y de alguna manera siempre termino escribiendo (lea: copiando y pegando) la mía una y otra vez. No puedo creer que no haya una clase base "oficial" que pueda usar.

¿Hay una clase base en algún lugar de la IInterface implementación de RTL pero sin el recuento de referencias de la que puedo derivar mis clases?

Answer 1

En la unidad Generics.Defaults hay una clase TSingletonImplementation definida. Disponible en Delphi 2009 y superior.

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

Hice esto. Se puede usar en lugar de TInterfacedObject con o sin recuento de referencias. También tiene una propiedad de nombre, muy útil para la depuración.

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

No existe tal clase, pero puedes escribir fácilmente la tuya propia, como lo han demostrado otros. Sin embargo, me pregunto por qué lo necesitarías. En mi experiencia, rara vez existe una necesidad real de tal clase, incluso si desea mezclar referencias de objetos e interfaces.

También tenga en cuenta que cuando use una clase de este tipo, todavía tendrá que ocuparse de establecer cualquier referencia de interfaz que tenga para dicho objeto en cero antes de que dejen el alcance y antes de liberar el objeto. De lo contrario, podría obtener la situación en la que el tiempo de ejecución intenta llamar a _Release sobre un objeto liberado, y eso tiende a causar una excepción de puntero no válida.

IOW, yo recomendaría no usar tal clase en absoluto.

Answer 4

No sé de ninguna clase base fuera de la caja, así que escribí la mía (como usted). Solo colócalo en una unidad de utils común y listo.

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;

Answer 5

Usted podría considerar TInterfacedPersistent . Si no anula GetOwner, no se hace un recuento de ref.