Memory Leaks, Interfaces, Agregates e RegisterClass

    Memory Leaks, Interfaces, Agregates e RegisterClassComo criar um objeto sem saber a classe, sabendo apenas o nome daclasse como string.
    Criar objetos dinâmicos com classevariável, onde a classe pode vir de um banco de dados ou arquivode configuração.
    E como fazer para esses objetos se auto - destruiremsem causar memory leaks. Como reduzir o acoplamento em ambientesnão OO altamente acoplados.
    Nesta dica vamos ver 4 assuntos distintos, poremcorrelacionados:

        1) Interfaces e comousá-las evitando memory leaks
        2) O tipo TClass e seussemelhantes, o que são e para que servem
        3) Como instanciar e manipularobjetos dos quais você não sabe a classe - Isto envolveregistrar a classe com RegisterClass e Acha-la com FindClass
        4) A maneira certa de se usarAgregates, delegates etc sem causar memory leak.

Vamos falar agora sobre Interfaces.

    Primeiro de tudo, até hoje, o melhor materialque eu já vi sobre interfaces no Delphi é este aqui: http://edn.embarcadero.com/article/30125

    Interfaces são definidas como um“contrato” entre duas partes, um padrão de encaixe.Por exemplo, uma placa de vídeo para se conectar numa placamãe com slot pciXpress deve seguir esse padrão depinagem.
    Na prática, interfaces são comoclasses (só parecem, pelo amor de Deus), porem todos osmétodos são públicos e ela não temimplementação.
    Na verdade, todas as classes tem uma interfaceimplícita, que é o conjunto de métodospúblicos da mesma. Se uma classe tem o métodopúblico “function     Mostrar(msg:string)” então esse método faz parte da interfacedessa classe mesmo que ela não implemente nenhuma.
    Usando interfaces nós podemos intercambiarobjetos que implementam a mesma interface, mesmo que sejam de linhagensdiferentes.
    Por exemplo, se duas classes totalmente diferentes(duas forms, para exemplificar), implementam a mesma interface, masnão são irmãs, nem mãe-filha e nãotem nenhum gral de parentesco, uma variável do tipo dessainterface pode conter instancias tanto de uma form como de outra.
    Isso é essencial quando precisamos instanciare abrir uma form, mas não sabemos a princípio qual otipo, porque este vai ser definido em runtime. Então um factorymethod ou um abstract factory poderia instanciar essa form paranós e ela poderia ser “acondicionada” em umavariável do tipo dessa interface.
    Por exemplo, imagine uma interface IProcura:

IProcura = interface
['{05A634F2-B8CD-4DFD-8447-59B77DE7682F}']
    Procedure Procura(valor: variant); 
End;

    Agora imagine que você tem umformulário de procura diferente para cada form do seu projeto:ProduraCliente, ProcuraFornecedor, ProcuraProduto etc... Se todas essasforms, embora diferentes entre si, implementassem a interface IProcurae o método Procura, qualquer uma delas poderia ser instanciadanuma variável:

Var Proc: IProcura;

Então estariam corretos:

 Proc:= TProcuraCliente.create(nil);
 Proc:= TProcuraFornecedor.create(nil);
 Proc:= TProcuraProduto.create(nil);

    Interfaces também podem suprir a necessidadede herança múltipla. Mas não queremos nos delongarna questão das interfaces. Então sugiro a leitura daClube Delphi 74 e 75, e estudar livros e sites de POO a respeito.
    Um fato curioso é que na revista clube delphi74 diz que você não precisa dar um free num objeto queimplementa uma interface (se você instanciá-lo navariável de interface, claro), pois a interface éliberada da memória automaticamente.
    Isso é verdade SE E SOMENTE SE a sua classefor descendente de TInterfacedObject. Isso porque essas classesimplementam a interface básica IInterface, cujos métodossão:

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

    Estas classes guardam uma contagem dereferências à uma instância da interface, e ométodo _Release verifica se a contagem de referênciasatinge zero.
    Se atingir zero ele dá o famoso e conhecidoDestroy. Definimos como referências o numero de usos oumenções a uma instancia de um objeto que implementa umainterface na memória.
    Ou seja, o número de variáveis queapontam para ele. Por exemplo, se uma variável aponta para umainstância de um objeto, temos uma referência. Se duasvariáveis e um parâmetro de método por valorapontam para o mesmo objeto, temos 3 referências embora o objetoseja o mesmo.
    Se damos o comando Proc:=TProcuraCliente.create(nil); e depois Proc:=TProcuraCliente.create(nil); novamente, o primeiro objeto instanciadoperde sua referência, porque não tem ninguém maisapontando para ele, uma vez que o segundo objeto sobrescreveu avariavel, que agora aponta para o segundo.
    Cada vez que um objeto que implementa uma interfaceé De-referênciado, ou seja perde a referência,é executado o método _release. (se atribuir nil a umavariável interface, por exemplo, ela vai apontar para umendereço nulo de memória e não mais para ainstância do objeto, que chamará o método _release).
    Veja a implementação de _release nodelphi 7:

    TInterfacedObject:
    function TInterfacedObject._Release: Integer;
    begin
Result := InterlockedDecrement(FRefCount); //decrementa de maneira thread-safe
if Result = 0 then 
      Destroy; //manda bala no objeto
    end;

    Mas porque eu disse que isso só ocorre SE ESOMENTE SE a sua classe for descendente de TInterfacedObject? Éporque essa classe dá um free quando FrefCount chega a zero, masa classe TInterfacedPersistent não, veja suaimplementação:

    function TInterfacedPersistent._Release: Integer;
    begin
if FOwnerInterface <> nil then
      Result := FOwnerInterface._Release
 else     
  Result := -1;
    end;  

    Na classe Tcomponent, que laaaaaa no fundo herda deTpersistent também há uma implementação de_Release, pois TComponent implementa IInterface, mas tambémnão dá o free:

    function TComponent._Release: Integer;
    begin
if FVCLComObject = nil then
      Result := -1 // -1 indicates no reference counting is taking place
else
      Result := IVCLComObject(FVCLComObject)._Release;

    end;
 

    Está Errado? Não sei dizer seestá errado, (eu nunca vi uma situação em queesses métodos retornassem algo diferente de -1, nem oFOwnerInterface ou o FVCLComObject <. de nil) mas se você usaro fastmm4 verá que há um memory leak se vocêinstanciar objetos dessas classes em uma interface e nãodestruí-los.     Já os objetos de classesderivadas de TInterfacedObject você não precisa destruir.
    Faça o teste: baixe o FastMM4, ajuste asopções de Report de Memory Leak e inclua a unit Fastmm4como primeira unit do seu DPR e sete as variáveis:

 FullDebugModeScanMemoryPoolBeforeEveryOperation := True;
 SuppressMessageBoxes:=False;

Logo depois do begin do seu DPR, ficando assim:

program
Project1;

uses
    FastMM4,
    Forms,
    Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin 
 FullDebugModeScanMemoryPoolBeforeEveryOperation := True;
     SuppressMessageBoxes:=False;
     Application.Initialize;
     Application.CreateForm(TForm1,Form1);
     Application.Run;
end.

    Eu criei a interface Iteste e 3 classes que aimplementam, uma filha de TInterfacedObject, uma filha deTinterfacedPersistent e outra filha de TComponent:

ITeste = interface(IInterface)
['{B0653AC1-B7A2-4E41-9DA3-B8E5C3480AE7}']
    procedure Testar;
end;

TClassTeste = class(TInterfacedObject, ITeste)
public
    procedure Testar;
end;

TPersistentTeste = class(TInterfacedPersistent, Iteste)
public
    procedure Testar;
end;

TComponentTeste = class(TComponent, Iteste)
public
    procedure Testar;
end;

e criei 3 botões, um para instanciar cada uma delas e executar ométodo Testar;

{ TClassTeste }
procedure TClassTeste.Testar;
begin
    ShowMessage('Testando Classe teste');
end;

{ TPersistentTeste }
procedure TPersistentTeste.Testar;
begin
    ShowMessage('Testando Persistent teste');
end;

{ TComponentTeste }
procedure TComponentTeste.Testar;
begin
    ShowMessage('Testando Componente teste');
end;

procedure TForm1.btInterfaceObjectClick(Sender: TObject);
var
    teste: ITeste;
begin
    teste := TClassTeste.create;
    teste.Testar;
end;

procedure TForm1.btInterfacePersistentClick(Sender: TObject);
var
    teste: ITeste;
begin
    teste := TPersistentTeste.create;
    teste.Testar;
end;

procedure
TForm1.btComponentClick(Sender: TObject);
var
    teste: ITeste;
begin
    teste := TComponentTeste.create(nil);
    teste.Testar;
end;

    Clique no primeiro botão e feche o programa.Reparou que não teve memory leak? Isso porque o Objeto da classeTClassTeste, ao perder sua referência no fechamento do programa,chama _release e dá um Destroy em si mesmo, visto que a contagemde referências atingiu zero. Porem, se você repetir o mesmoteste com os outros botões verá que TPersistent,TInterfacedPersistent e TComponent causam memory leaks.
    Se sua classe é filha ou de alguma formadescendente de TComponent, Tpersistent ou TInterfacedPersistent comosolucionar esse problema?
    Simples: implemente e sobrecarregue esses doismétodos:

    function _AddRef: Integer; stdcall; 
    function _Release: Integer; stdcall;

de IInterface seguindo o exemplo da classe TInterfacedObject.

    O Código da nossa unit até aqui:

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
 TForm1 = class(TForm)
     btInterfaceObject: TButton;
     btInterfacePersistent: TButton;
     btComponent: TButton;
     procedure btInterfaceObjectClick(Sender: TObject);
     procedure btInterfacePersistentClick(Sender: TObject);
     procedure btComponentClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

ITeste = interface(IInterface)
['{B0653AC1-B7A2-4E41-9DA3-B8E5C3480AE7}']
    procedure Testar;

end;

TClassTeste = class(TInterfacedObject, ITeste)
public
    procedure Testar;
end;

TPersistentTeste = class(TInterfacedPersistent, Iteste)
public
    procedure Testar;
end;

TComponentTeste = class(TComponent, Iteste)
public
    procedure Testar;
end;

var

Form1: TForm1;

implementation

{$R *.dfm}

{TClassTeste }

procedure TClassTeste.Testar;
begin
    ShowMessage('Testando Classe teste');
end;

{TPersistentTeste }

procedure TPersistentTeste.Testar;
begin
    ShowMessage('Testando Persistent teste');
end;


{TComponentTeste }

procedure TComponentTeste.Testar;
begin
    ShowMessage('Testando Componente teste');
end;


procedure TForm1.btInterfaceObjectClick(Sender: TObject);
var
    teste: ITeste;
begin
    teste := TClassTeste.create;
    teste.Testar;
end;


procedure TForm1.btInterfacePersistentClick(Sender: TObject);
var
    teste: ITeste;
begin
    teste := TPersistentTeste.create;
    teste.Testar;
end;


procedure TForm1.btComponentClick(Sender: TObject);
var
 teste: ITeste;
begin
 teste := TComponentTeste.create(nil);
 teste.Testar;
end;

end.

O DFM:

object Form1: TForm1
    Left = 419
    Top = 318
    Width = 142
    Height = 151
    Caption = 'Form1'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    PixelsPerInch = 96
    TextHeight = 13
    object btInterfaceObject: TButton
 Left = 8
 Top = 16
 Width = 121
 Height = 25
 Caption = 'TInterfacedObject'
 TabOrder = 0
 OnClick = btInterfaceObjectClick
    end

    object btInterfacePersistent: TButton
     Left = 8
     Top = 48
 Width = 121
     Height = 25
     Caption = 'TInterfacedPersistent'
     TabOrder = 1
     OnClick = btInterfacePersistentClick
    end

    object btComponent: TButton
     Left = 8
     Top = 80
     Width = 121
     Height = 25
     Caption = 'TComponent'
     TabOrder = 2
     OnClick = btComponentClick
    end
end

Agora vamos sobrecarregar os métodos

    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

das nossas classe filhas de TComponent eTInterfacedPersistent:

    Você precisará também deimplementar um FRefCount igual ao TInterfacedObject.
    Mas como fazer isso sem alterar o result e seguindoo exemplo de TInterfacedObject?
    Simples Assim:
    O código final do teste, com classes filhasde TInterfacedPersistent e TInterfacedObject vai abaixo, criei umafunção chamada showmessage que escreve as mensagens nummemo, ao invez de mostrar messageboxes. Melhor para testar:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    btInterfaceObject: TButton;
    btInterfacePersistent: TButton;
    btComponent: TButton;
    btDelegaObj: TButton;
    Memo1: TMemo;
    procedure btInterfaceObjectClick(Sender: TObject);
    procedure btInterfacePersistentClick(Sender: TObject);
    procedure btComponentClick(Sender: TObject);
    procedure btDelegaObjClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  ITeste = interface(IInterface)
  ['{B0653AC1-B7A2-4E41-9DA3-B8E5C3480AE7}']
    procedure Testar;
  end;

  TClassTeste = class(TInterfacedObject, ITeste)
  public
    procedure Testar;
  end;

  TPersistentTeste = class(TInterfacedPersistent, Iteste)
  private
    FRefCount: Integer;
  public
    procedure Testar;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  TComponentTeste = class(TComponent, Iteste)
  private
    FRefCount: Integer;
  public
    procedure Testar;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  TClasseAgregada = class(TAggregatedObject, ITeste)
  private
    FITeste: ITeste;
    //FITeste: TClassTeste;
    //FITeste: TPersistentTeste;
    //FITeste: TComponentTeste;
  public
    procedure Testar;
    constructor Create;
    property Teste: ITeste read FITeste write FITeste implements Iteste;
  end;

var
  Form1: TForm1;

  //apenas para sobrescrever a original, melhor mostrar num memo do que um monte de janelinhas
  procedure ShowMessage(msg: string);
implementation

  procedure ShowMessage(msg: string);
  begin
    Form1.Memo1.Lines.Add(msg);
  end;

{$R *.dfm}

{ TClassTeste }

procedure TClassTeste.Testar;
begin
  ShowMessage('Testando Classe teste');
end;

{ TPersistentTeste }
procedure TPersistentTeste.Testar;
begin
  ShowMessage('Testando Persistent teste');
end;

function TPersistentTeste._AddRef: Integer;
begin
  Result := inherited _AddRef;
  InterlockedIncrement(FRefCount);
  //ShowMessage('TPersistentTeste._AddRef: ' + IntToStr(Result)+ ' Contagem de referências: ' + IntToStr(FRefCount));
end;

function TPersistentTeste._Release: Integer;
begin
  Result := inherited _Release;
  //ShowMessage('TPersistentTeste._Release: ' + IntToStr(Result)+ ' Contagem de referências: ' + IntToStr(FRefCount));
  InterlockedDecrement(FRefCount);
  if FRefCount <=0 then
    Free;
end;

{ TComponentTeste }
procedure TComponentTeste.Testar;
begin
  ShowMessage('Testando Componente teste');
end;

function TComponentTeste._AddRef: Integer;
begin
  Result := inherited _AddRef;
  InterlockedIncrement(FRefCount);
  //ShowMessage('TComponentTeste._AddRef: ' + IntToStr(Result)+ ' Contagem de referências: ' + IntToStr(FRefCount));
end;

function TComponentTeste._Release: Integer;
begin
  Result := inherited _Release;
  //ShowMessage('TComponentTeste._Release: ' + IntToStr(Result)+ ' Contagem de referências: ' + IntToStr(FRefCount));
  InterlockedDecrement(FRefCount);
  if FRefCount <=0 then
    Free;
end;

procedure TForm1.btInterfaceObjectClick(Sender: TObject);
var
  teste: ITeste;
  Multiplasreferências: array[1..10] of ITeste;
  i: Integer;
begin
  teste := TClassTeste.create;
  teste.Testar;

  for i := 1 to 10 do
  begin
    Multiplasreferências[i] := teste;
  end;
  for i := 1 to 10 do
  begin
    Multiplasreferências[i].Testar;
  end;
end;

procedure TForm1.btInterfacePersistentClick(Sender: TObject);
var
  teste: ITeste;
  Multiplasreferências: array[1..10] of ITeste;
  i: Integer;
begin
  teste := TPersistentTeste.create;
  teste.Testar;

  for i := 1 to 10 do
  begin
    Multiplasreferências[i] := teste;
  end;
  for i := 1 to 10 do
  begin
    Multiplasreferências[i].Testar;
  end;
end;

procedure TForm1.btComponentClick(Sender: TObject);
var
  teste: ITeste;
  Multiplasreferências: array[1..10] of ITeste;
  i: Integer;
begin
  teste := TComponentTeste.create(nil);
  teste.Testar;

  for i := 1 to 10 do
  begin
    Multiplasreferências[i] := teste;
  end;
  for i := 1 to 10 do
  begin
    Multiplasreferências[i].Testar;
  end;
end;

procedure TForm1.btDelegaObjClick(Sender: TObject);
var
  Teste:  TClasseAgregada;
  Multiplasreferências: array[1..10] of ITeste;
  i: Integer;
begin
  teste := TClasseAgregada.create;
  Teste.Testar;
  for i := 1 to 10 do
  begin
    Multiplasreferências[i] := teste;
  end;
  for i := 1 to 10 do
  begin
    Multiplasreferências[i].Testar;
  end;
  Teste.Free;
end;

constructor TClasseAgregada.Create;
begin
  FITeste := TClassTeste.Create;
  inherited Create(FITeste);
end;

procedure TClasseAgregada.Testar;
begin
  FITeste.Testar;
  ShowMessage('TClasseAgregada  - teste');
end;
end.

o DFM:

object Form1: TForm1
  Left = 133
  Top = 318
  Width = 590
  Height = 321
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btInterfaceObject: TButton
    Left = 8
    Top = 16
    Width = 121
    Height = 25
    Caption = 'TInterfacedObject'
    TabOrder = 0
    OnClick = btInterfaceObjectClick
  end
  object btInterfacePersistent: TButton
    Left = 8
    Top = 48
    Width = 121
    Height = 25
    Caption = 'TInterfacedPersistent'
    TabOrder = 1
    OnClick = btInterfacePersistentClick
  end
  object btComponent: TButton
    Left = 8
    Top = 80
    Width = 121
    Height = 25
    Caption = 'TComponent'
    TabOrder = 2
    OnClick = btComponentClick
  end
  object btDelegaObj: TButton
    Left = 8
    Top = 112
    Width = 121
    Height = 25
    Caption = 'Delegação TObject'
    TabOrder = 3
    OnClick = btDelegaObjClick
  end
  object Memo1: TMemo
    Left = 144
    Top = 13
    Width = 417
    Height = 273
    ScrollBars = ssVertical
    TabOrder = 4
  end
end

    Funciona, não altera a funcionalidade nem osresultados das nossas classes e interfaces e.... Nada de Memory Leak!
    Agora você pode me perguntar: "Por quêde tudo isso?" Simples, se você quer que um método ou umobjeto receba como parâmetro um outro objeto, porémnão quer especificar que objeto é esse, não querengessar, mas quer deixar flexível, então vocêdeverá usar interfaces, certo?
    Porem uma variável do tipo interface, emborapossa conter qualquer objeto que implemente esta interface, nãotem conhecimento de como destruí-lo, certo?
    Você não pode dizer Fteste: Iteste;Fteste := TTeste.create() e depois dar um FTeste.Destroy simplesmenteporque o método Destroy não faz parte da interface.    Você quer é não ter aresponsabilidade nem de construir o objeto, delegando essaresponsabilidade a um factory method, muito menos ter aresponsabilidade de destruí-lo. Então um objeto queimplementa uma interface deve saber destruir-se por si mesmo, senão houver nenhuma referência para ele.
    "Bom, o TInterfacedObject já sedestrói sozinho", você poderia dizer. Mas oTInterfacedPersistent e o TComponent não. E para quê eupreciso disso?
    Um dos objetivos desse artigo é criar umAbstract Factory rústico usando o RegisterClass do delphi. Essemétodo público estático registra numa listainterna do delphi referências de classes. Depois você podeencontrar essa classe com o método FindClass Nãosão referências a objetos instânciados, sãoreferências a metadata de classes. Ou seja, você podereferênciar classes por seu nome, ou por uma variavel, enão pela classe em si. Você pode criar um objeto sem saberqual é a sua classe ou mudar sua classe em runtime.
    E se você quiser instanciar uma classe, porexemplo uma form em uma variável do tipo interface,através de um abstractfactory ou através de uma classeregistrada do delphi, com FindClass e RegisterClass, vocêsimplesmente não pode chamar o método destroy ou free,porque ele não existe na interface.
    Você poderia fazer um typecast para a classedesejada, ou para object e dar um free, mas normalmente vocêdesconhece a classe a qual tem de fazer typecast, e também issopode resultar em vários acces violation na hora dedereferênciar as interfaces, visto que elas executam o _Releasede um objeto que não existe mais.
    Então vamos lá! jásaímos do assunto "1", agora estamos no "2" .

    Existe o tipo TClass, que é umareferência a uma classe (não objeto) do tipo TObject.
    Existe o tipo TInterfacedClass, que é umareferência a uma classe TInterfacedObject.
    Existe o tipo TPersistentClass que é umareferência a classe TPersistent,
    Existe TComponentClass, TFormClass, mas nãoexiste nenhum TInterfacedPersistentClass.
    E pra que eu preciso de um TInterfacedPersistent,por que não posso usar um TInterfacedObject? Ou mesmo TObjectnormal?
    Precisamos que seja interfaced porque vamostrabalhar com interfaces e queremos que nossos objetos sejam liberadosautomaticamente sem memory leak.
    E precisamos que seja descentente de TPersistentporque o método RegisterClass só registra descendentes deTPersistent. Então, o primeiro de tudo é, na suabiblioteca de classes, declare:

       
 TInterfacedPersistentClass = class of TInterfacedPersistent;
       

    Cenário: Imagine que você tem uma formde produtos e uma de consulta de produtos (TConsultaPro). Porem essasduas forms, da maneira como foram feitas, estão engessadas,são usadas no sistema inteiro, nada pode ser alterado nelas ouem sua hierarquia, e não se pode criar descententes das mesmas.
    Mas você precisa criar outras classes deconsulta de produtos, clientes, fornecedores, pedidos etc... que podemser ou não descententes de TConsultaPro e podem ser forms ouclasses que chamam forms.
    A unit1 é a unit principal do nosso programa.É o nosso cadastro de produtos.

//esta seria a unit principal do projeto

unit Unit1;

interface

uses
  Controls,
  Forms,
  Unit3,  //esta é a biblioteca onde se encontra a interface
  Classes,
  StdCtrls;

type
  TfrmPrincipal = class(TForm)
    btAbrir: TButton;
    procedure btAbrirClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   iIntf: IFrmConsultaPro;  //A interface

end;

var
  frmPrincipal: TfrmPrincipal;

implementation

{$R *.dfm}

procedure TfrmPrincipal.btAbrirClick(Sender: TObject);
var
  NumPro: string;
  clsClasse:  TInterfacedPersistentClass;
  iIntf:  IFrmConsultaPro;
begin
  NumPro := '123456';
  clsClasse := TInterfacedPersistentClass(FindClass('TFConsultaProFactory'));
  if (clsClasse <> nil) then
  begin
    iIntf := ((clsClasse.Create) as IFrmConsultaPro);
    if iIntf <> nil then
    begin
 iIntf.ConsultaPro(NumPro);
    end;
    //ma que beleza hein!
  end;
end;
end.

o DFM:

object frmPrincipal: TfrmPrincipal
  Left = 460
  Top = 469
  Width = 288
  Height = 137
  Caption = 'Form Principal'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btAbrir: TButton
    Left = 88
    Top = 64
    Width = 105
    Height = 25
    Caption = 'Abrir a outra Form'
    TabOrder = 0
    OnClick = btAbrirClick
  end
end

A unit2 é a unit que tem a nossa classe que não pode sermechida, a TConsultaPro:

//Unit de uma form do projeto totalmente desconhecida e que pode ser chamada
//de varios pontos do projeto ou substituida na "cara de Pau" por outra
//que implemente a mesma interface

unit Unit2;

interface

uses
  Windows,
  Controls,
  Forms,
  Dialogs,
  Unit3, //unit da interface
  SysUtils,
  Classes, StdCtrls;

type
  TFConsultaPro = class(TForm)
    edt_Produto: TEdit;
    Label1: TLabel;
    procedure edt_ProdutoKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public

  end;

implementation

{$R *.dfm}

{ TFConsultaPro } 
procedure TFConsultaPro.edt_ProdutoKeyPress(Sender: TObject;   var Key: Char);
begin
  ShowMessage('Você consultou o produto: ' + edt_Produto.Text);
end;

procedure TFConsultaPro.FormClose(Sender: TObject;   var Action: TCloseAction);
begin
  Release;     
end;

end.

o DFM:

object FConsultaPro: TFConsultaPro
  Left = 346
  Top = 305
  Width = 331
  Height = 166
  Caption = 'Consultar Produto'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 96
    Top = 32
    Width = 96
    Height = 13
    Caption = 'Produto Consultado:'
  end
  object edt_Produto: TEdit
    Left = 96
    Top = 48
    Width = 121
    Height = 21
    TabOrder = 0
    OnKeyPress = edt_ProdutoKeyPress
  end
end

    Vamos criar nossa interface conforme a unit 3abaixo, que é nossa unit de "biblioteca".

//unit com os tipos, classes e interfaces usadas no sistema
unit Unit3;
interface

uses
  Classes;

type
  IFrmConsultaPro = interface(IInterface)
  ['{E054C396-7551-4B79-B439-A3130B25C79E}']
    procedure ConsultaPro(NumProd: string); stdcall;
  end;
  //Um tipo de referência de classe, para podermos encontrar e instanciar um
  //objeto de uma classe e unit desconhecida pelo seu nome (string) de forma
  //que ele seja uma classe interfaceada (que implemente IInterface)
  //é uma maneira "rustica" de se fazer um factoy method
  //a propria classe a ser registrada é uma factory que so serve para instanciar
  //um objeto da classe TFConsultaPro (form que consulta produto) quando
  //se executa o método  ConsultaPro. Optei por usar uma factory que
  //implementasse a interfac, mas a propria form poderia implementa - la
  //assim eu criaria diretamente a form e não o factory.
  //optei por criar esse factory para exemplificar as vezes que você não
  //pode mecher em nada ou quase nada na form, não podendo mecher por exemplo
  //na sua linhagem.
  //faz de conta que a TFConsultaPro é uma form legada, usada no sistema
  //inteiro e que vamos fazer de tudo para não mecher nela.
  //Até mesmo mantivemos a regra de negócio no evento do edit,
  //para demosntrar como aos poucos podemos melhorar uma programação altamente
  //acoplada, totalmente estruturada ou orientada a evento e diminuir o
  //acoplamento sem ser muito traumatizante.

  TInterfacedPersistentClass = class of TInterfacedPersistent;

implementation

end.

a Unit uFactory é a unit que tem a nossa classe factory eé onde ela é registrada com RegisterClass para serencontrada com FindClass

unit uFactory;

interface

uses
    Windows,
    Classes,
    Unit2,
    Unit3;

type
  TFConsultaProFactory = class(TInterfacedPersistent,  IFrmConsultaPro)
  private
    FRefCount: Integer;
  published
    procedure ConsultaPro(NumProd: string);
stdcall;

    //métodos de IInterface
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

implementation

procedure TFConsultaProFactory.ConsultaPro(NumProd: string);
var
  Enter: Char;
begin
  Enter := #13;
  with TFConsultaPro.Create(nil) do
  begin
    edt_Produto.Text:=NumProd;
    edt_Produto.OnKeyPress(edt_Produto,
Enter);
    ShowModal;
  end;
end;

function TFConsultaProFactory._AddRef: Integer;
begin
  Result := inherited  _AddRef;
  InterlockedIncrement(FRefCount);
end;

function TFConsultaProFactory._Release: Integer;
begin
  Result := inherited  _Release;
  InterlockedDecrement(FRefCount);
  if FRefCount <= 0 then
    Free;
end;

initialization

  //aqui eu registro minha classe factory (poderia ter registrado a form) para
  //que ela possa ser "encontrada" pelo delphi posteriormente, em uma unit que
  //não a conhece, sem esta unit 2 estar declarada no uses.

  RegisterClass(TFConsultaProFactory);

  //repare que com isso podemos instanciar objetos atraves do nome da classe
  //podendo armazenar os nomes das classes que queremos instanciar em 
  //arquivos de configuração, bancos de dados etc.

end.

    Repare que no exemplo que fizemos registramos umaclasse que possui um método para instanciar a form. Assim essaclasse teria o FactoryMethod da form, mas o registerClass e FindClassseria o FactoryMethod da nossa classe. Fizemos assim apenas parailustrar a situação de uma form feita por outra pessoaque você não pode mecher nem na unit. E num contexto quenão era orientado a objeto, mas está emmigração. Nada impede de fazer com que a própriaform implemente a interface IFrmConsultaPro, o métodoConsultaPro e que a própria form seja registrada comregisterClass. Mas o release deveria ser automatico, ou deveria-seimplementar os métodos _AddRef e _Release.
    Usando essas técnicas com criatividadevocê pode criar um super ultra abstract factory que cria qualquercomponente através de uma string, podendo permitiralterações em runtime customizadas pelo cliente emvários pontos do seu software. Também poderá teruma lista global de objetos criados e referências num objetosingleton para criar seu próprio garbage collector ou tirarestatísticas (bastando usar as interfaces e implementar essasalterações necessarias em _AddRef e _Release).
    Com isso o memory leak não te pega mais evocê pode destruir sem dó qualquer resquício deobjeto que queira ficar na memória.
    No arquivo para downloadEstudo_MemoryLeaks_Interfaces, há 4 pastas / exemplos:
    MemoryLeak_Interfaces é o código doprimeiro exemplo acima, que mostra como implementar _AddRef, _Release efazer autodestroy e refcount nas Classes TInterfacedPersistent eTComponent.
    MemoryLeak_Agregates_UsoCorreto: ilustra a maneiracorreta de se usar agregates para não gerar memory leak.
    MemoryLeak_Interface_RegisterClass mostra o exemploacima e como transformar aos poucos um sistema legado em sistemaorientado a objetos.
    MemoryLeak_Interface_RegisterClass Extra é umexemplo extra onde a classe registrada é a propria Form.

    Link para o arquivo com os exemplos, no meu skyDrive(use o 7zip para descompactar)

http://cid-a3e4fd1c20f4d546.skydrive.live.com/self.aspx/.Public/EstudoMemoryLeaksInterfaces.zip