在Delphi2010里面整了个单例模式，大家看看好用不？
(* * This unit demonstrates how to implement the Singleton Pattern in Delphi 2010. * The final reversion will be available in the Delphi Spring Framework. * * Zuo Baoquan * *)unit SingletonPatternUnit;interfacetype /// <summary> /// Provides a simple, fast and thread-safe Singleton Pattern implementation. /// </summary> /// <description> /// Singleton Pattern is defined as: /// Ensure a class only has one instance, and provide a global point of access to it. /// </description> /// <remarks> /// 1. Use Instance class property to get the singleton instance. /// 2. Concrete Singleton Classes may override DoCreate/DoDestroy if necessary. /// 3. Do not call Create/Free methods, otherwise an EInvalidOp exception will be raised. /// </remarks> /// <example> /// <code> /// TApplicationContext = class(TSingleton<TApplicationContext>) /// protected /// procedure DoCreate; override; /// procedure DoDestroy; override; /// end; /// </code> /// </example> /// <author>Zuo Baoquan (Paul)</author> TSingleton<T: class> = class //(TInterfaceBase) strict private class var fInstance: T; class function GetInstance: T; static; class destructor Destroy; protected procedure DoCreate; virtual; procedure DoDestroy; virtual; public constructor Create; destructor Destroy; override; class property Instance: T read GetInstance; end;implementationuses Windows, SysUtils;{$REGION 'TSingleton<T>'}class destructor TSingleton<T>.Destroy;begin if fInstance <> nil then begin TSingleton<T>(fInstance).DoDestroy; TSingleton<T>(fInstance).FreeInstance; fInstance := nil; end;end;constructor TSingleton<T>.Create;begin raise EInvalidOp.Create('Use Instance class property instead.');end;destructor TSingleton<T>.Destroy;begin if ExceptObject = nil then raise EInvalidOp.Create('Free/Destroy.');end;class function TSingleton<T>.GetInstance: T;var obj: T;begin if fInstance = nil then begin obj := T(T.NewInstance); TSingleton<T>(obj).DoCreate; if InterlockedCompareExchangePointer(PPointer(@fInstance)^, PPointer(@obj)^, nil) <> nil then begin TSingleton<T>(obj).DoDestroy; TSingleton<T>(obj).FreeInstance; end; end; Result := fInstance;end;procedure TSingleton<T>.DoCreate;beginend;procedure TSingleton<T>.DoDestroy;beginend;{$ENDREGION}end. TBaseSingleton = class abstract private class function yourNewInstance: TObject; procedure yourFreeInstance; // 别忘了 BeforeDestruction protected constructor DoCreate; virtual; abstract; // must be overrided procedure DoDestroy; virtual; public class function NewInstance: TObject; override; // raise an exception procedure FreeInstance; override; // raise an exception end; TSingletonClass = class of TBaseSingleton; Tfoo = class private class var FDict: TDictionary<TSingletonClass, TBaseSingleton>; FCS: TRTLCriticalSection; public class constructor Create; class destructor Destroy; class function GetInstance<T: TBaseSingleton>: T; { EnterCriticalSection(FCS); try if(FDict.TryGetValue(TSingletonClass(T), TBaseSingleton(Result)))then Exit; Result := T(TSingletonClass(T).yourNewInstance); FDict.Add(TSingletonClass(T), TBaseSingleton(Result)); finally LeaveCriticalSection(FCS); end; TBaseSingleton(Result).DoCreate; } end;
[解决办法]