Delphi 线程安全单例
在C++中写了一个多线程环境下写日志的插件,考虑到以前写Delphi代码时对文件的操作类封装时老是欠缺线程安全方面的考虑，所以总结了一下，写了一个线程安全的单例。可能有欠缺之处请各位朋友多多指教。
首先自己封了一个多线程的临界操作类，用来管理多线程的临界区，方法很简单只是单独对WINDOWS API的封装，实现单元如下：
(*******************************************************************
*@file: CriticalSectionU.pas
*@desc: 多线程操作时，对临界区的封装
*@author: daihw
*@date: 2009-03-03
*******************************************************************)
unit CriticalSectionU;
interface
uses Windows,Classes,CommCtrl,Dialogs;
type
TMCriticalSection=class(TObject)
protected
FCriticalSection:TRTLCriticalSection;
public
constructor create;
destructor destory;
function Init():TRTLCriticalSection;
function lock():Boolean;
function unlock():Boolean;
function Trim():Boolean;
end;
TMAutoCriticalSection=class(TMCriticalSection)
public
constructor Create;
destructor Destory;
end;
TMsafeDeleteCriticalSection=class(TMCriticalSection)
private
m_bInitialized:Boolean;
public
constructor Create;
destructor Destory ;
function Init():TRTLCriticalSection;
function lock():Boolean;
function unlock():Boolean;
function Trim():Boolean;
end;
implementation
{ TMCriticalSection }
constructor TMCriticalSection.create;
begin
InitializeCriticalSection(FCriticalSection);
end;
destructor TMCriticalSection.destory;
begin
DeleteCriticalSection(FcriticalSection);
end;
function TMCriticalSection.Init: TRTLCriticalSection;
begin
RESULT := FCriticalSection;
end;
function TMCriticalSection.lock: Boolean;
begin
EnterCriticalSection(FCriticalSection);
Result:=true;
end;
function TMCriticalSection.Trim: Boolean;
begin
DeleteCriticalSection(FcriticalSection);
Result:=true;
end;
function TMCriticalSection.unlock: Boolean;
begin
LeaveCriticalSection(FcriticalSection);
Result:=true;
end;
{ TMAutoCriticalSection }
constructor TMAutoCriticalSection.Create;
begin
inherited Create;
end;
destructor TMAutoCriticalSection.Destory;
begin
inherited Destory;
end;
{ TMsafeDeleteCriticalSection }
constructor TMsafeDeleteCriticalSection.Create;
begin
inherited Create;
m_bInitialized:=True;
end;
destructor TMsafeDeleteCriticalSection.Destory;
begin
m_bInitialized:=False;
inherited Destory;
end;
function TMsafeDeleteCriticalSection.Init: TRTLCriticalSection;
begin
if (m_bInitialized) then
Result:=Init;
end;
function TMsafeDeleteCriticalSection.lock: Boolean;
begin
if (m_bInitialized) then
Result:= inherited lock
else
Result:=False;
end;
function TMsafeDeleteCriticalSection.Trim: Boolean;
begin
if (m_bInitialized) then
Result:= inherited Trim
else
Result:=False;
end;
function TMsafeDeleteCriticalSection.unlock: Boolean;
begin
if (m_bInitialized) then
Result:= inherited unlock
else
Result:=true;
end;
end.
做好临界处理后，开始实现线程安全的单例对象，实现代码如下：
(*******************************************************************
*@file: singletonU.pas
*@desc: 线程安全的单例,通过引用计数维护对象生命周期.
*@author: daihw
*@date: 2009-03-03
*******************************************************************)
unit SingletonU;
interface
uses Classes, SysUtils, CommCtrl, Dialogs, Windows, CriticalSectionU;
type
TDSingletonCreator = class(TObject)
private
FMsg: string;
public
property Msg: string read FMsg write FMsg;
class function Instance(): TDSingletonCreator;
class function Release(): Integer;
class function NewInstance: TObject; override;
procedure FreeInstance; override;
end;
implementation
var
_sc: TMsafeDeleteCriticalSection = nil;
_self: TDSingletonCreator = nil;
_refCount: LongInt = 0;
{ TDSingleton }
procedure TDSingletonCreator.FreeInstance;
begin
inherited;
_sc := nil;
_self := nil;
end;
class function TDSingletonCreator.Instance: TDSingletonCreator;
begin
if not Assigned(_sc) then
begin
_sc := TMsafeDeleteCriticalSection.create();
end;
_sc.lock();
if not Assigned(_self) then
_self := TDSingletonCreator.create;
_sc.unlock();
Inc(_refCount);
Result := _self;
end;
class function TDSingletonCreator.NewInstance: TObject;
begin
if not Assigned(_sc) then
begin
_sc := TMsafeDeleteCriticalSection.create();
end;
_sc.lock();
if not Assigned(_self) then
_self := TDSingletonCreator(inherited NewInstance);
_sc.unlock();
Inc(_refCount);
Result := _self;
end;
class function TDSingletonCreator.Release: Integer;
begin
if Assigned(_sc) then
begin
_sc.lock();
if (_refCount = 0) then
Result := 0;
Dec(_refCount);
if (_refCount = 0) then
if Assigned(_self) then
FreeAndNil(_self);
_sc.unlock();
if (_refCount = 0) then
FreeAndNil(_sc);
Result := _refCount;
end
else
Result := 0;
end;
end.
测试代码如下：
unit TestU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
SingletonU;
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
singleton:TDSingletonCreator;
begin
singleton:=TDSingletonCreator.Instance;
singleton.Msg:='121212';
TDSingletonCreator.Release;
end;
procedure TForm1.btn2Click(Sender: TObject);
var
singleton:TDSingletonCreator;
begin
singleton:=TDSingletonCreator.Create;
ShowMessage(singleton.msg);
singleton.Free;
end;
end.
总结：这片文章写出来可能对多线程环境下文件操作，有点帮助，比如：日志文件的读写操作。