找传奇、传世资源到传世资源站!

网络时间校准工具源码(delphi)

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

from clipboard
from clipboard
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdTime, StdCtrls, XPMan, ExtCtrls, RzTabs, IdTCPServer, IdTimeServer, RzPanel, RzRadGrp, ShellAPI, Menus, RzTray, AdvMenus, IniFiles, ImgList, Registry, ExtCtrlsX, ComCtrls, Spin;type TForm1 = class(TForm) idtm1: TIdTime; RzPageControl1: TRzPageControl; TabSheet1: TRzTabSheet; TabSheet2: TRzTabSheet; bvl1: TBevel; lbl1: TLabel; lbl2: TLabel; lbl3: TLabel; edt1: TEdit; cbb1: TComboBox; edt2: TEdit; btn2: TButton; Bevel1: TBevel; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Button1: TButton; IdTimeServer1: TIdTimeServer; RzRadioGroup1: TRzRadioGroup; CheckBox1: TCheckBox; Timer1: TTimer; RzTrayIcon1: TRzTrayIcon; AdvPopupMenu1: TAdvPopupMenu; a1: TMenuItem; b1: TMenuItem; N4: TMenuItem; ImageList1: TImageList; lbl4: TLabel; tmr1: TTimer; lbl5: TLabel; stat1: TStatusBar; pnl1: TPanel; lbl6: TLabel; lbl7: TLabel; chk1: TCheckBox; tmr2: TTimer; chk2: TCheckBox; cbb2: TComboBox; procedure btn2Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure RzRadioGroup1Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure a1Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure b1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure chk2Click(Sender: TObject); procedure SetAutoRun(ok: boolean); procedure tmr1Timer(Sender: TObject); procedure tmr2Timer(Sender: TObject); procedure chk1Click(Sender: TObject); procedure cbb2Change(Sender: TObject); procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND; private { Private declarations } public { Public declara procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);tions } end;var Form1: TForm1; iniParam: TINIFile;implementation{$R *.dfm}procedure TForm1.btn2Click(Sender: TObject); //互联网校准时间begin idtm1.Host := cbb1.Text; idtm1.Port := 37; lbl5.Visible := True; edt1.Text := FormatDateTime('yyyy-MM-dd hh:mm:ss', idtm1.DateTime); edt2.Text := FormatDateTime('yyyy-MM-dd hh:mm:ss', Now); try idtm1.SyncTime; lbl5.Caption := '时间校正成功'; tmr1.Enabled := True; except lbl5.Caption := '无法连接到时间服务器!'; tmr1.Enabled := True; end;end;procedure TForm1.Button1Click(Sender: TObject); //局域网时间校正begin idtm1.Host := Edit1.Text; idtm1.Port := StrToInt(Edit2.text); idtm1.Timeout := 100; lbl4.Caption := '正在连接时间服务器...'; lbl4.Visible := true; Application.ProcessMessages; try idtm1.SyncTime; lbl4.Caption := '时间校正成功'; tmr1.Enabled := True; except lbl4.Caption := '无法连接到时间服务器,请检查服务器IP和端口!'; tmr1.Enabled := True; end;end;procedure TForm1.RzRadioGroup1Click(Sender: TObject); //选择服务端还是客户端begin if RzRadioGroup1.ItemIndex = 0 then //服务端 begin Button1.Enabled := False; idtimeserver1.Active := True; lbl4.Visible := true; if IdTimeServer1.Active then lbl4.Caption := '时间服务器启动成功!' else lbl4.Caption := '时间服务器启动失败!' end else begin IdTimeServer1.Active := false; Button1.Enabled := True; if Edit1.text = '' then ShowMessage('请输入服务端的IP地址,端口默认为8800!'); end; tmr1.Enabled := True;end;procedure TForm1.CheckBox1Click(Sender: TObject); //自动校正设置begin if CheckBox1.Checked then begin b1.Checked := true; Timer1.Enabled := true; end else begin Timer1.Enabled := false; b1.Checked := false; end;end;procedure TForm1.Timer1Timer(Sender: TObject); //间隔时间校正一次begin if RzPageControl1.ActivePageIndex = 0 then Button1.Click else btn2.Click;end;procedure TForm1.a1Click(Sender: TObject); //显示主窗口begin if a1.Caption = '隐藏主窗口(&X)' then begin a1.Caption := '显示主窗口'; RzTrayIcon1.MinimizeApp; end else begin a1.Caption := '隐藏主窗口'; RzTrayIcon1.RestoreApp; end;end;procedure TForm1.N4Click(Sender: TObject); //退出begin Application.Terminate;end;procedure TForm1.b1Click(Sender: TObject); //自动校正begin if b1.Checked then begin if RzPageControl1.ActivePageIndex = 0 then CheckBox1.Checked := false; end else begin if RzPageControl1.ActivePageIndex = 0 then CheckBox1.Checked := true; end;end;procedure TForm1.FormCreate(Sender: TObject); //初始导入配置文件begin iniParam := TINIFile.Create(ExtractFileDir(ParamStr(0)) '\config.ini'); if not FileExists(ExtractFileDir(ParamStr(0)) '\config.ini') then begin iniParam := TINIFile.Create(ExtractFileDir(ParamStr(0)) '\config.ini'); iniParam.WriteString('base', 'host', '192.168.1.249'); iniParam.WriteString('base', 'port', '8800'); iniParam.WriteString('server', 'ip1', 'time.nist.gov'); iniParam.WriteString('server', 'ip2', 'time-a.nist.gov'); iniParam.WriteString('server', 'ip3', 'time-b.nist.gov'); iniParam.WriteString('server', 'ip4', 'utcnist.colorado.edu'); iniParam.WriteString('server', 'ip5', 'time-c.timefreq.bldrdoc.gov'); end; Edit1.Text := iniParam.ReadString('base', 'host', '192.168.1.249'); Edit2.Text := iniParam.ReadString('base', 'port', '8800'); cbb1.Items.Add(iniParam.ReadString('server', 'ip1', 'time.nist.gov')); cbb1.Items.Add(iniParam.ReadString('server', 'ip2', 'time-a.nist.gov')); cbb1.Items.Add(iniParam.ReadString('server', 'ip3', 'time-b.nist.gov')); cbb1.Items.Add(iniParam.ReadString('server', 'ip4', 'utcnist.colorado.edu')); cbb1.Items.Add(iniParam.ReadString('server', 'ip5', 'time-c.timefreq.bldrdoc.gov')); cbb1.ItemIndex := 0; iniParam.Free;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); //退出写入到配置文件var i: Integer;begin iniParam := TINIFile.Create(ExtractFileDir(ParamStr(0)) '\config.ini'); iniParam.WriteString('base', 'host', Edit1.Text); iniParam.WriteString('base', 'port', '8800'); iniParam.WriteString('server', 'ip1', 'time.nist.gov'); iniParam.WriteString('server', 'ip2', 'time-a.nist.gov'); iniParam.WriteString('server', 'ip3', 'time-b.nist.gov'); iniParam.WriteString('server', 'ip4', 'utcnist.colorado.edu'); iniParam.WriteString('server', 'ip5', 'time-c.timefreq.bldrdoc.gov'); iniparam.free; IdTimeServer1.Free; idtm1.Free; Application.Terminate;end;procedure TForm1.SetAutoRun(ok: boolean); //开机启动函数var Reg: TRegistry; //首先定义一个TRegistry类型的变量Regbegin Reg := TRegistry.Create; try //创建一个新键 Reg.RootKey := HKEY_LOCAL_MACHINE; //将根键设置为HKEY_LOCAL_MACHINE Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true); //打开一个键 if ok then begin Reg.WriteString('时间校正', ExpandFileName(ParamStr(0))); //在Reg这个键中写入数据名称和数据数值 chk2.State := cbChecked; end else begin reg.DeleteValue('时间校正'); chk2.State := cbUnchecked; end; Reg.CloseKey; //关闭键 finally Reg.Free; end;end;procedure TForm1.chk2Click(Sender: TObject); //开机启动设置begin if chk2.Checked then SetAutoRun(true) else SetAutoRun(false);end;procedure TForm1.tmr1Timer(Sender: TObject); //10秒后隐藏提示信息begin lbl4.Visible := false; lbl5.Visible := false; tmr1.Enabled := false;end;procedure TForm1.tmr2Timer(Sender: TObject); //取服务器时间begin if RzPageControl1.ActivePageIndex = 0 then begin if RzRadioGroup1.ItemIndex = 1 then begin idtm1.Host := Edit1.Text; idtm1.Port := StrToInt(Edit2.text); lbl6.Caption := '服务器时间:' FormatDateTime('hh:mm:ss', idtm1.DateTime); end else lbl6.Caption := ''; end else lbl6.Caption := '';end;procedure TForm1.chk1Click(Sender: TObject); //互联网自动校正begin if chk1.Checked then begin b1.Checked := true; Timer1.Enabled := true; end else begin Timer1.Enabled := false; b1.Checked := false; end;end;procedure TForm1.cbb2Change(Sender: TObject); //设置同步间隔var i: Integer;begin case cbb1.ItemIndex of 0: i := 5; 1: i := 10; 2: i := 30; 3: i := 60; //1分钟 4: i := 300; //5分钟 5: i := 600; //10分钟 6: i := 1800; //30分钟 7: i := 3600; //1小时 8: i := 7200; //2小时 9: i := 10800; //3小时 end; Timer1.Interval := i * 1000;end;procedure TForm1.WMSysCommand(var Msg: TMessage); //最小化begin case Msg.WParam of SC_MINIMIZE: a1.Caption := '显示主窗口'; end; inherited;end;end.

评论

发表评论必须先登陆, 您可以 登陆 或者 注册新账号 !


在线咨询: 问题反馈
客服QQ:174666394

有问题请留言,看到后及时答复