用Delphi实现的Singleton模式

unit uSingleton;

interface

uses
  SysUtils;

type
  ESingletonException = class(Exception);

TSingleton = class
  private
// 单例类真正使用的构造函数，此处命名为CreateNew
constructor CreateNew;
  public
// 用于阻止显式调用，因为即便将其设为私有的，
// 也可以调用构造函数Create，
// 虽然实际上调用的是其父类的构造函数，
// 这样显然不是很理想，
// 所以只好声明并在实现中引发 ESingletonException
constructor Create;
// 类方法，返回对唯一的实例
class function Instance: TSingleton;
  end;

implementation

uses SyncObjs;

var
  SingletonInstance: TSingleton = nil;

// 用于锁定 TSingleton.Instance 方法，防止多线程访问
  SingletonLocker: TCriticalSection = nil;

{ TSingleton }

constructor TSingleton.Create;
begin
  raise ESingletonException.Create('单例类，禁止显式调用构造函数');
end;

constructor TSingleton.CreateNew;
begin
  // do something
end;

class function TSingleton.Instance: TSingleton;
begin
  SingletonLocker.Enter;
  try
if not Assigned(SingletonInstance) then
   SingletonInstance := TSingleton.CreateNew;
Result := SingletonInstance;
  finally
SingletonLocker.Leave;
  end;
end;

initialization
  SingletonLocker := TCriticalSection.Create;
finalization
  SingletonLocker.Free;
end.