Delphi实现Singleton模式

2016-02-19 18:24 3 1 收藏

下面图老师小编要跟大家分享Delphi实现Singleton模式,简单的过程中其实暗藏玄机,还是要细心学习,喜欢还请记得收藏哦!

【 tulaoshi.com - 编程语言 】

单例模式用于限制进程中只有一个某个类的对象,本例的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
  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.Size5000000 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;
  procedure joke;
  
  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.joke;
  begin
  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.

来源:http://www.tulaoshi.com/n/20160219/1617572.html

延伸阅读
标签: Delphi
  文件关联为我们带来很多的方便。Delphi自带有注册表对象TRegistry,可以通过它取得或改变注册表相关键值的内容。 Function GetAssociatedExec(FileExt: String; var FileDescription, MIMEType: String): String; Var Reg: TRegistry; FileType: String; begin Result := ′′;{函数返回值是打开Fi...
依然是java 与模式里的例子,(java 与模式 闫宏著) 以下是转为delphi的代码,这次加了注释:) unit BuilderPattern; interface type   TProduct = class;   //抽像建造者 规范接口   TBuilder = class(TObject)   public     procedure builderpart1(); virt...
在Windows95/98中,都是使用注册表对系统数据进行管理,有关壁纸的设置数据保存在Hkey_Current_UserControl PanelDesktop的Wallpaper和TileWallpaper 等键值中,只要成功修改了这两个键值,然后发消息给Windows即可更换壁纸。在本例的程序中,使用了一个Tform;两个Tspeedbutton(Speedbutton1用于接受用户的浏览命令,Speedbutton2用于接受用户的...
标签: Delphi
  给单位开发软件,涉及一打印模块,我感到颇有兴趣,就拿来其中的一个小功能模块与读者共享。下面以打印在纸张的矩形框内为例简单介绍: 程序要求: 单击[打印]按钮,把Memo的内容最多分三行打印出来,每行最多能容纳22个三号字,限定汉字上限为50个汉字。 编程思路: 用LineTo和MoveTo函数画一矩形框,根...
{D7+Win98,不能用于2000} unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; procedure Button1Click(Sende...

经验教程

46

收藏

53
微博分享 QQ分享 QQ空间 手机页面 收藏网站 回到头部