手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>程序设计>delphi>列表

用Delphi实现Singleton模式

来源:互联网 作者:west263.com 时间:2008-02-23
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!
单例模式用于限制进程中只有一个某个类的对象,本例的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.

上一篇: Delphi2005和DUnit搭建敏捷开发平台
下一篇: 用Delphi来DIY一个软件"变脸"功能

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!