unit uTestHelper; {$mode objfpc}{$H+} interface uses Classes, SysUtils, TestFramework; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TIntfObjOwner = class(TTestCase) private fIntfObjCounter: Integer; protected procedure SetUp; override; public property IntfObjCounter: Integer read fIntfObjCounter; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TIntfObj = class(TObject, IUnknown) private fOwner: TIntfObjOwner; private { IUnknown } fRefCount : longint; function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; public constructor Create(const aOwner: TIntfObjOwner); destructor Destroy; override; end; implementation //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TIntfObjOwner///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TIntfObjOwner.SetUp; begin inherited SetUp; fIntfObjCounter := 0; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TIntfObj////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TIntfObj.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if getinterface(iid,obj) then result := S_OK else result := longint(E_NOINTERFACE); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TIntfObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin _addref := InterLockedIncrement(fRefCount); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TIntfObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin _Release := InterLockedDecrement(fRefCount); if (_Release = 0) then Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TIntfObj.Create(const aOwner: TIntfObjOwner); begin inherited Create; fOwner := aOwner; inc(fOwner.fIntfObjCounter); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TIntfObj.Destroy; begin dec(fOwner.fIntfObjCounter); inherited Destroy; end; end.