{…}
depois em “function FreeInstance;”, troco por “procedure FreeInstance; override;”
{…}

O original tb tem override, ficando assim: “function FreeInstance; override”, mas, só compila quando mudo para procedure.

Veja o source de um teste simples:

—
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

TRefCountObject = class(TObject)
private
FRefCount: Integer;
function Release;
protected
procedure Finit; virtual;
public
destructor Destroy; reintroduce;
function AddRef;
function FreeInstance; override;
class function NewInstance: TObject; override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TRefCountObject.AddRef;
begin
Result := InterlockedIncrement(FRefCount);
end;

destructor TRefCountObject.Destroy;
begin
end;

function TRefCountObject.Finit;
begin
end;

function TRefCountObject.FreeInstance;
begin
if Release = 0 then
try
Finit;
finally
inherited;
end;
end;

class function TRefCountObject.NewInstance: TObject;
begin
Result := inherited NewInstance;
TRefCountObject(Result).FRefCount := 1;
end;

function TRefCountObject.Release;
begin
Result := InterlockedDecrement(FRefCount);
if Result < 0 then
raise Exception.Create(’Não é possível liberar a instância’);
end;

end.
—

Primeiro o compilador esbarra na linha “function Release;”, troco por “function Release: Integer; stdcall;” e passa, depois em “function AddRef;”, troco por “function AddRef: Integer; stdcall;” e passa, depois em “function FreeInstance;”, troco por “procedure FreeInstance; override;” e passa.

Note que teve houve umas mudanças, de function para procedure, e outras coisas (ex: “: Integer; stdcall”).

Eu uso Delphi7, será que estou fazendo algo errado?

Depois que deixei assim não deu mais erros:
—
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

TRefCountObject = class(TObject)
private
FRefCount: Integer;
function Release: Integer; stdcall;
protected
procedure Finit; virtual;
public
destructor Destroy; reintroduce;
function AddRef: Integer; stdcall;
procedure FreeInstance; override;
class function NewInstance: TObject; override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TRefCountObject.AddRef;
begin
Result := InterlockedIncrement(FRefCount);
end;

destructor TRefCountObject.Destroy;
begin
end;

procedure TRefCountObject.Finit;
begin
end;

procedure TRefCountObject.FreeInstance;
begin
if Release = 0 then
try
Finit;
finally
inherited;
end;
end;

class function TRefCountObject.NewInstance: TObject;
begin
Result := inherited NewInstance;
TRefCountObject(Result).FRefCount := 1;
end;

function TRefCountObject.Release;
begin
Result := InterlockedDecrement(FRefCount);
if Result < 0 then
raise Exception.Create(’Não é possível liberar a instância’);
end;

end.
—

P.S.: João, tem como notificar quando os comentários forem respondidos? Eu tenho muito interesse nas postagens que você faz, elas valem mais que alguns livros sobre ObjectPascal (a maioria mostrando no Delphi) que estão aí no mercado.

Um grande abraço!
Silvio Clécio

Posso estar errado, mas, não seria assim:

—
type
TRefCountObject = class(TObject)
private
FRefCount: Integer;
function Release: Integer; stdcall;
protected
procedure Finit; virtual;
public
destructor Destroy; reintroduce;
function AddRef: Integer; stdcall;
procedure FreeInstance; override;
class function NewInstance: TObject; override;
end;
—

implementation

function TRefCountObject.AddRef;
begin
Result := InterlockedIncrement(FRefCount);
end;

destructor TRefCountObject.Destroy;
begin
end;

procedure TRefCountObject.Finit;
begin
end;

procedure TRefCountObject.FreeInstance;
begin
if Release = 0 then
try
Finit;
finally
inherited;
end;
end;

class function TRefCountObject.NewInstance: TObject;
begin
Result := inherited NewInstance;
TRefCountObject(Result).FRefCount := 1;
end;

function TRefCountObject.Release;
begin
Result := InterlockedDecrement(FRefCount);
if Result < 0 then
raise Exception.Create(’Não é possível liberar a instância’);
end;
—

Só assim consegui fazer:

—
TCliente = class(TRefCountObject)
…
end;
—
procedure GuardaCliente(const ACliente: TCliente);
begin
FCliente := ACliente;
FCliente.AddRef;
end;
—

Um grande abraço,
Silvio Clécio

Então posso ter código desta forma:

begin
VCliente := TCliente.Create;
try
GuardaCliente(VCliente);
finally
VCliente.Free;
end;
end;

procedure GuardaCliente(const ACliente: TCliente);
begin
FCliente := ACliente;
FCliente.AddRef;
end;

E depois da chamada a VCliente.Free, o objeto continuará na memória para atender o ponteiro FCliente.

Eu uso um híbrido de OO/RAD nos meus aplicativos antigos: Criei um datamodule cujo nome é o nome da classe (ex.: Cliente). O datamodule contém um clientdataset que faz o acesso aos dados no DB. Ao mesmo tempo, o DM implementa uma interface (digamos, ICliente) e para que ele trabalhe com reference counting eu implementei algo parecido. Assim, eu posso fazer:

var
Cliente: ICliente;
begin
Cliente := ClienteFactory.CriarCliente;
Cliente.ConsultarPeloCodigo(’0001′);
ShowMessage(Cliente.Nome)
end;

Mas quando usado como componente eu tenho que destruí-lo manualmente:

var
Cliente: TCliente;
begin
Cliente := TCliente.Create(nil, Connection)
try
Cliente.ConsultarPeloCodigo(’0001′);
ShowMessage(Cliente.Nome);
finally
Cliente.Free;
end;
end;

Assim, eu mantenho o comportamento padrão de um datamodule (sem ref. Counting) e ao mesmo tempo, quando desejado, posso usar o Ref. Counting.

Um abraço. Legal o seu blog.