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.