delphi 单例模式

unit Singleton;
(*
  单例模式适用于辅助类, 一般伴随于单元的生命周期
*)
interface
uses SysUtils;

type
  TSingleton = class
  public
    class function NewInstance : TObject; override;
    class function GetInstance : TSingleton;
    destructor Destroy; override;
    procedure FreeInstance; override;

    function Address : integer;
  end;

implementation
var
  FSingleton : TSingleton = nil;
  FCanFree : Boolean;

{ TSingleton }
function TSingleton.Address: integer;
begin
  Result := Integer(Self);
end;

destructor TSingleton.Destroy;
begin
  inherited;
end;

procedure TSingleton.FreeInstance;
begin
  if not FCanFree then Exit;
  inherited FreeInstance;
  FSingleton := nil;
end;

class function TSingleton.GetInstance: TSingleton;
begin
  if not Assigned(FSingleton) then
  begin
    FSingleton := TSingleton.Create;
  end;
  Result := FSingleton;
end;

class function TSingleton.NewInstance: TObject;
begin
  if not Assigned(FSingleton) then
  begin
    FSingleton := TSingleton(inherited NewInstance);
  end;
  Result := FSingleton;
end;

initialization
  FSingleton := TSingleton.Create;

finalization
  FCanFree := True;
  if Assigned(FSingleton) then
  begin
    FSingleton.Free;
    FSingleton := nil;
  end;

end.

uses  Singleton;

procedure TForm1.btn1Click(Sender: TObject);
var
  vTest, vTest2 : TSingleton;
begin
  vTest := TSingleton.Create;
  ShowMessage(IntToStr(vTest.Address));

  vTest2 := TSingleton.Create;
  ShowMessage(IntToStr(vTest2.Address));

//  vTest.free;
  FreeAndNil(vTest);
  vTest2.free;
end;