用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.