基本信息

---

下载

   友情提示：（无需注册或充值，赞助后即可获取资源下载链接）

---

     嘿，亲！知识可是无价之宝呢，但咱这精心整理的资料也耗费了不少心血呀。小小地破费一下，绝对物超所值哦！如有下载和支付问题，请联系我们QQ(微信同号)：813200300

本次赞助数额为： 2 元　

支付宝支付

微信支付

   源码介绍

---

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.