实例介绍
【实例简介】
【实例截图】
【核心代码】
unit Unit1;
interface
uses
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类型的变量Reg
begin
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.
好例子网口号:伸出你的我的手 — 分享!
相关软件
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明


网友评论
我要评论