是否有像 TInterfacedObject 这样的非引用计数基类？

Question

我需要一个类似 TInterfacedObject 的基类，但没有引用计数（因此是一种 TNonRefCountedInterfacedObject）。

这实际上是我第n次需要这样的课程，不知怎的，我总是一次又一次地编写（阅读：复制和粘贴）我自己的课程。我不敢相信没有我可以使用的“官方”基类。

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

您可以考虑TInterfacedPercient。如果您不重写 GetOwner，它不会进行引用计数。

Answer 3

我这样做了。它可以用来代替 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 4

从 Delphi 11 Embarcadero 开始，将 TNoRefCountObject 添加到系统单元。以下是发行说明中的​​注释：

新类 System.TNoRefCountObject 是非引用计数的
IInterface 实现（替换旧的且命名奇怪的
TSingletonObject）

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;

Answer 6

没有这样的类，但是您可以轻松编写自己的类，正如其他人所展示的那样。然而，我确实想知道为什么你需要它。根据我的经验，即使您想混合对象和接口引用，也很少真正需要这样的类。

另请注意，当您使用此类时，您仍然需要在此类对象离开作用域之前以及释放对象之前将此类对象的任何接口引用设置为 nil。否则，您可能会遇到运行时尝试在已释放对象上调用 _Release 的情况，这往往会导致无效指针异常。

IOW，我建议反对使用这样的类。