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;