delphi - 是否有像 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

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

我不知道任何开箱即用的基类，所以我编写了自己的（像你一样）。只需将它放在一个通用的 utils 单元中就可以了。

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

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

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

IOW，我建议不要使用这样的课程。