ObjGuard

Sometimes it happens that I would like to convert a Delphi object to an interfaces. Interfaces offer some advantages.
On the one hand you can handle different objects that are not derived from a common hierarchy but share the same methods.
On the other hand interfaces are reference counted. You can use the reference counting as a poor man’s garbage collection.

Normally objects that are interfaced are derived from TInterfacedObject.
Let’s have a look at the implementation of TInterfacedObject in Delphi XE3.

...
  TInterfacedObject = class(TObject, IInterface)
  protected
{$IFNDEF AUTOREFCOUNT}
    FRefCount: Integer;
{$ENDIF}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
...

function TInterfacedObject._AddRef: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  Result := AtomicIncrement(FRefCount);
{$ELSE}
  Result := __ObjAddRef;
{$ENDIF}
end;

function TInterfacedObject._Release: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  Result := AtomicDecrement(FRefCount);
  if Result = 0 then
    Destroy;
{$ELSE}
  Result := __ObjRelease;
{$ENDIF}
end;
...

...

TInterfacedObject = class(TObject, IInterface)

protected

{$IFNDEF AUTOREFCOUNT}

FRefCount: Integer;

{$ENDIF}

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

...

function TInterfacedObject._AddRef: Integer;

begin

{$IFNDEF AUTOREFCOUNT}

Result := AtomicIncrement(FRefCount);

{$ELSE}

Result := __ObjAddRef;

{$ENDIF}

end;

function TInterfacedObject._Release: Integer;

begin

{$IFNDEF AUTOREFCOUNT}

Result := AtomicDecrement(FRefCount);

if Result = 0 then

Destroy;

{$ELSE}

Result := __ObjRelease;

{$ENDIF}

end;

...

You can see two things:

Every interfaced object has to implement IInterface.
EMBT will introduce a real garbage collection but currently a TInterfacedObject is simply reference counted.

Normally you have to decide whether an object is interfaced or not if you are implementing it, not if you are using it.
That’s why I introduced a small wrapper class for an object. The wrapper class is interfaced and offers full access to the underlying object.

unit ObjGuard;

interface

type
  IObjGuard<T: class> = interface(IInterface)
  ['{7FBC48DC-1ED4-450F-8418-64E0D942F115}']
    function get_Obj: T;
    property Obj: T read get_Obj;
  end;

  TObjGuard<T: class> = class(TInterfacedObject, IObjGuard<T>)
  strict private
    FObj: T;
    function get_Obj: T; inline;
  strict protected
    property Obj: T read get_Obj;
  public
    constructor Create(AObj: T);
    destructor Destroy; override;
  end;

implementation

uses
  System.Classes;

{ TObjGuard<T> }

constructor TObjGuard<T>.Create(AObj: T);
begin
  inherited Create;
  FObj := AObj;
end;

destructor TObjGuard<T>.Destroy;
begin
  FObj.Free;
  inherited Destroy;
end;

function TObjGuard<T>.get_Obj: T;
begin
  Result := FObj;
end;

end.

unit ObjGuard;

interface

type

IObjGuard<T: class> = interface(IInterface)

['{7FBC48DC-1ED4-450F-8418-64E0D942F115}']

function get_Obj: T;

property Obj: T read get_Obj;

end;

TObjGuard<T: class> = class(TInterfacedObject, IObjGuard<T>)

strict private

FObj: T;

function get_Obj: T; inline;

strict protected

property Obj: T read get_Obj;

public

constructor Create(AObj: T);

destructor Destroy; override;

end;

implementation

uses

System.Classes;

{ TObjGuard<T> }

constructor TObjGuard<T>.Create(AObj: T);

begin

inherited Create;

FObj := AObj;

end;

destructor TObjGuard<T>.Destroy;

begin

FObj.Free;

inherited Destroy;

end;

function TObjGuard<T>.get_Obj: T;

begin

Result := FObj;

end;

end.

This makes the use of the object very simple. Just create an instance of the ObjGuard and the resulting interface offers access to the underlying object.
You can use it for example in records which don’t offer a destructor so that there must be a way to destroy object fields.

...
type
  TMyRecord = record
  strict private
    FStream: IObjGuard<TFileStream>;
    function get_Stream: TStream; inline;
  public
    constructor Create(const AFileName: string);
    property Stream: TFileStream read get_Stream;
  end;

...
constructor TMyRecord.Create(const AFileName: string);
begin
  FStream := TObjGuard<TFileStream>.Create(TFileStream.Create(AFileName, fmCreate));
end;

function TMyRecord.get_Stream: TStream;
begin
  Result := FStream.Obj;
end;

end.

...

type

TMyRecord = record

strict private

FStream: IObjGuard<TFileStream>;

function get_Stream: TStream; inline;

public

constructor Create(const AFileName: string);

property Stream: TFileStream read get_Stream;

end;

...

constructor TMyRecord.Create(const AFileName: string);

begin

FStream := TObjGuard<TFileStream>.Create(TFileStream.Create(AFileName, fmCreate));

end;

function TMyRecord.get_Stream: TStream;

begin

Result := FStream.Obj;

end;

end.

Recent Posts

Archives

Categories

Meta