用Delphi实现Singleton模式

下载本文示例代码
　　单例模式用于限制进程中只有一个某个类的对象，本例的Singleton是一个线程实例，在每一个时钟到达时检测是否到达某个时刻（本例的时刻存于Ini文件中），如果到达则产生一个线程，但是如果在这个线程完成其任务前又到达一个时钟，则有可能会产生多个线程执行任务，以致出现混乱，所以考虑使用Singleton模式解决这个问题（当然还有其他解决方案，但本例使用的是Singleton）。 　　核心代码如下： //timer单元 procedure TService1.Timer_mainTimer(Sender: TObject); 　var 　　mystringlist:TStringList; 　　SearchRec: TSearchRec; 　　nowtime :string; 　begin 　　try 　　　DateTimeToString(nowtime,'hh:nn',now); 　　　if LeftStr(nowtime,4)=LeftStr(GetMSG('GAME','下发时间',theexename '.ini'),4) then 　　　begin 　　　　//创建发送线程 　　　　Global_Instance:=TSendThread.getInstance; 　　　　////////////// 　　　end; 　　except 　　　on e: Exception do 　　　begin //捕获错误存入txt文件　　　　mystringlist:=TStringList.Create; 　　　　if FileExists(ExtractFilePath(Paramstr(0)) 'Err.txt') then 　　　　　mystringlist.LoadFromFile(ExtractFilePath(Paramstr(0)) 'Err.txt'); 　　　　　mystringlist.Add('(' DateTimeToStr(Now) ')[创建线程出错:]' E.Message); 　　　　　mystringlist.SaveToFile(ExtractFilePath(Paramstr(0)) 'Err.txt'); 　　　　　mystringlist.Free; 　　　　if FindFirst(ExtractFilePath(Paramstr(0)) 'Err.txt', faAnyFile, SearchRec)=0 then 　　　　begin 　　　　　if SearchRec.Size>5000000 then 　　　　　begin 　　　　　　RenameFile(ExtractFilePath(Paramstr(0)) 'Err.txt',ansireplacestr(ExtractFilePath(Paramstr(0)) 'Err.txt','.txt',FormatDateTime('yyyy-MM-dd hh-mm-ss',now) '.txt')); 　　　　　end; 　　　　end; 　　　end; 　　end; 　end; //线程单元 unit Unit_Send ; interface uses 　SysUtils, Classes,StrUtils,main; type TSendThread = class(TThread) public 　constructor Create(CreateSuspended: Boolean); 　destructor Destroy; override; 　class function getInstance:TSendThread; protected 　procedure Execute; override; end; var 　Global_Instance:TSendThread; implementation 　uses DB; 　class function TSendThread.getInstance:TSendThread; 　begin 　　if Global_Instance=nil then 　　begin 　　　Global_Instance:=TSendThread.Create(false); 　　end; 　　Result:=Global_Instance; 　end; 　constructor TSendThread.Create(CreateSuspended: Boolean); 　begin 　　if Global_Instance=nil then 　　begin 　　　inherited Create(CreateSuspended); 　　　FreeOnTerminate:=true ; 　　end 　　else //如果有人不小心多次创建对象则产生一个异常　　　raise Exception.CreateFmt('Can not create more than one TSendThread instance!',[SysErrorMessage(0)]); 　　end; 　　destructor TSendThread.Destroy; 　　begin 　　　inherited Destroy; 　　end; 　　procedure TSendThread.Execute; 　　var 　　　theuser:TUserInfo; 　　　tmpSql:string; 　　begin 　　　//执行任务 　　　//处理定时下发 ' GameInfo.mainusertable ' 　　　tmpSql:='select * from ' mainusertable ' where destroy=0 order by id'; 　　　Service1.ADOQuery_send.Connection:=conn_Server; 　　　SQLQuery(Service1.ADOQuery_send,tmpSql); 　　　while (not Service1.ADOQuery_send.Eof) and (not Terminated) do 　　　begin 　　　　theuser.SeqID:='0'; 　　　　theuser.UID:=''; 　　　　theuser.Spc:=GetMSG('PARAMETER','Spcode',theexename '.ini'); 　　　　theuser.RecordID:='0'; 　　　　theuser.Mob:=Service1.ADOQuery_send.FieldByname('mobile').AsString; 　　　　AutoJoke(theuser); 　　　　Service1.ADOQuery_send.Next; 　　　end; 　　　Sleep(600001); 　　　Global_Instance:=nil; 　　　Terminate; 　　　//任务完成 　　end; 　end. 　　单例模式用于限制进程中只有一个某个类的对象，本例的Singleton是一个线程实例，在每一个时钟到达时检测是否到达某个时刻（本例的时刻存于Ini文件中），如果到达则产生一个线程，但是如果在这个线程完成其任务前又到达一个时钟，则有可能会产生多个线程执行任务，以致出现混乱，所以考虑使用Singleton模式解决这个问题（当然还有其他解决方案，但本例使用的是Singleton）。 　　核心代码如下： //timer单元 procedure TService1.Timer_mainTimer(Sender: TObject); 　var 　　mystringlist:TStringList; 　　SearchRec: TSearchRec; 　　nowtime :string; 　begin 　　try 　　　DateTimeToString(nowtime,'hh:nn',now); 　　　if LeftStr(nowtime,4)=LeftStr(GetMSG('GAME','下发时间',theexename '.ini'),4) then 　　　begin 　　　　//创建发送线程 　　　　Global_Instance:=TSendThread.getInstance; 　　　　////////////// 　　　end; 　　except 　　　on e: Exception do 　　　begin //捕获错误存入txt文件　　　　mystringlist:=TStringList.Create; 　　　　if FileExists(ExtractFilePath(Paramstr(0)) 'Err.txt') then 　　　　　mystringlist.LoadFromFile(ExtractFilePath(Paramstr(0)) 'Err.txt'); 　　　　　mystringlist.Add('(' DateTimeToStr(Now) ')[创建线程出错:]' E.Message); 　　　　　mystringlist.SaveToFile(ExtractFilePath(Paramstr(0)) 'Err.txt'); 　　　　　mystringlist.Free; 　　　　if FindFirst(ExtractFilePath(Paramstr(0)) 'Err.txt', faAnyFile, SearchRec)=0 then 　　　　begin 　　　　　if SearchRec.Size>5000000 then 　　　　　begin 　　　　　　RenameFile(ExtractFilePath(Paramstr(0)) 'Err.txt',ansireplacestr(ExtractFilePath(Paramstr(0)) 'Err.txt','.txt',FormatDateTime('yyyy-MM-dd hh-mm-ss',now) '.txt')); 　　　　　end; 　　　　end; 　　　end; 　　end; 　end; //线程单元 unit Unit_Send ; interface uses 　SysUtils, Classes,StrUtils,main; type TSendThread = class(TThread) public 　constructor Create(CreateSuspended: Boolean); 　destructor Destroy; override; 　class function getInstance:TSendThread; protected 　procedure Execute; override; end; var 　Global_Instance:TSendThread; implementation 　uses DB; 　class function TSendThread.getInstance:TSendThread; 　begin 　　if Global_Instance=nil then 　　begin 　　　Global_Instance:=TSendThread.Create(false); 　　end; 　　Result:=Global_Instance; 　end; 　constructor TSendThread.Create(CreateSuspended: Boolean); 　begin 　　if Global_Instance=nil then 　　begin 　　　inherited Create(CreateSuspended); 　　　FreeOnTerminate:=true ; 　　end 　　else //如果有人不小心多次创建对象则产生一个异常　　　raise Exception.CreateFmt('Can not create more than one TSendThread instance!',[SysErrorMessage(0)]); 　　end; 　　destructor TSendThread.Destroy; 　　begin 　　　inherited Destroy; 　　end; 　　procedure TSendThread.Execute; 　　var 　　　theuser:TUserInfo; 　　　tmpSql:string; 　　begin 　　　//执行任务 　　　//处理定时下发 ' GameInfo.mainusertable ' 　　　tmpSql:='select * from ' mainusertable ' where destroy=0 order by id'; 　　　Service1.ADOQuery_send.Connection:=conn_Server; 　　　SQLQuery(Service1.ADOQuery_send,tmpSql); 　　　while (not Service1.ADOQuery_send.Eof) and (not Terminated) do 　　　begin 　　　　theuser.SeqID:='0'; 　　　　theuser.UID:=''; 　　　　theuser.Spc:=GetMSG('PARAMETER','Spcode',theexename '.ini'); 　　　　theuser.RecordID:='0'; 　　　　theuser.Mob:=Service1.ADOQuery_send.FieldByname('mobile').AsString; 　　　　AutoJoke(theuser); 　　　　Service1.ADOQuery_send.Next; 　　　end; 　　　Sleep(600001); 　　　Global_Instance:=nil; 　　　Terminate; 　　　//任务完成 　　end; 　end. 下载本文示例代码


用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式用Delphi实现Singleton模式