从NTP授时服务器获取高精度时间

iamlimeng

最近在校准家里的时钟，找了不少工具，获得的时间都不太精确，还是自己写吧。很久以前写过一个，由于算法问题，精度不够高，重写了算法，现在精度应该在0.1秒以内（前提是服务器时间精确）。

目前国内比较可靠，网络访问延时少的授时服务器有：阿里云授时服务器、国家授时中心服务器、NTP.ORG，当然苹果和微软的授时服务器也不错。

NTP(Network Time Protocol）网络时间协议基于UDP，用于网络时间同步的协议，使网络中的计算机时钟同步到UTC，再配合各个时区的偏移调整就能实现精准同步对时功能。NTP授时精度与NTP服务器与用户间的网络状况有关：广域网授时精度通常能达50ms级，但有时超过500ms；局域网授时不存在路由器路径延迟问题，因而授时精度理论上可以提到亚毫秒级；但是Windows内置NTP服务，在局域网内其最高授时精度也只能达10ms级。

IETF的RFC5905对NTP数据包的结构有详细说明。

万能的Perl就有效率比较高的解析模块Net::NTP，结合RFC5905文档的说明，将NTP服务器反馈的数据包解析后，只须对接收到的时间数据进行延时修正，就能获得准确的时间，这个精度对于一般用途足够了。

代码分享如下：

1. #!/usr/bin/perl
   
2. 
   
3. =info
   
4.     Author: iamlimeng
   
5.     Date：2019-08
   
6. =cut
   
7. 
   
8. use strict;
   
9. use warnings;
   
10. use Net::NTP qw(get_ntp_response);
    
11. 
    
12. $| = 1;
    
13. my $interval = 0.999999;
    
14. 
    
15. my $NTP_Server = 'ntp1.aliyun.com'; #阿里云授时服务器，可靠性高
    
16. #my $NTP_Server = 'ntp.aliyun.com'; #阿里云授时服务器，可靠性高
    
17. #my $NTP_Server = 'ntp.ntsc.ac.cn';  #国家授时中心，可靠性高
    
18. #my $NTP_Server = 'cn.ntp.org.cn';
    
19. 
    
20. print "NTP Server: $NTP_Server\n\n";;
    
21. my %response = eval { get_ntp_response($NTP_Server) };
    
22. if (%response) {
    
23.         my $time = $response{'Transmit Timestamp'} + $response{'Delay'}/2;
    
24.         my ($now,$wait) = split(/\./,$time);
    
25.         select(undef, undef, undef, 1-$wait/100000);
    
26.          while(1) {
    
27.                  $now++;
    
28.                  print "\r",time_from_utc($now);
    
29.                  select(undef, undef, undef, $interval);
    
30.            }
    
31. }
    
32. else { print "Connect NTP Server Faild!"; }
    
33. 
    
34. <STDIN>;
    
35. exit;
    
36. 
    
37. sub time_from_utc {
    
38.         my $utc = shift;
    
39.         my ($sec,$min,$hour,$day,$mon,$year,$weekday,$yeardate,$savinglightday) = (localtime($utc));
    
40.          return (sprintf("%04d.%02d.%02d %02d:%02d:%02d",$year+1900,$mon+1,$day,$hour,$min,$sec));
    
41. }

复制代码

iamlimeng

搞了一个成品：
链接：https://pan.baidu.com/s/1zXd9iJ2CaphRPloJ6VZ4dw
提取码：a3qj

523066680

你用哪个模块做GUI， Label 更新的时候有点闪烁

iamlimeng

Win32::GUI，写GUI很麻烦，简单的搞一搞勉强可以。Label更新是个Timer，确实有点闪烁。

523066680

iamlimeng 发表于 2019-08-13 12:54
Win32::GUI，写GUI很麻烦，简单的搞一搞勉强可以。Label更新是个Timer，确实有点闪烁。

我现在用 IUP，和 WIN32::GUI 应该是同一个作者，kmx
https://metacpan.org/author/KMX

记得 Win32::GUI 有些模块不能用了，IUP还算稳定，但打包成exe没试过 （总之就是各种不方便啊）

这几天用IUP做的一个电商发货辅助工具

iamlimeng

ActiveState在ActivePerl-5.22.2.2202的PPM中没有提供编译好的IUP安装包，而这个版本是PDK支持的最后一个版本，我用CPAN安装IUP未成功，所以打包有可能没戏。

523066680

IUP的（只有外壳），写起来应该和 WIN32:GUI差不多。我用的 Strawberry Perl 5.24 32位

1. use utf8;
   
2. use IUP ':all';
   
3. use Date::Format;
   
4. use Time::HiRes qw/gettimeofday/;
   
5. STDOUT->autoflush(1);
   
6. 
   
7. my $label1 = IUP::Label->new(
   
8.     TITLE => "",
   
9.     FONT => "Microsoft YaHei",
   
10.     FONTSIZE=>"18",
    
11.     EXPAND => "HORIZONTAL",
    
12. );
    
13. 
    
14. my $label2 = IUP::Label->new(
    
15.     TITLE => "",
    
16.     FONT => "Microsoft YaHei",
    
17.     FONTSIZE=>"18",
    
18.     EXPAND => "HORIZONTAL",
    
19. );
    
20. 
    
21. my $dlg = IUP::Dialog->new(
    
22.     child => IUP::Vbox->new( child => [$label1, $label2] ),
    
23.     TITLE => "IupTimer",
    
24.     SIZE  => "300x100",
    
25. );
    
26. 
    
27. $timer1 = IUP::Timer->new(
    
28.         TIME => "100",
    
29.         RUN => "YES",
    
30.         ACTION_CB => sub {
    
31.             my $msec = sprintf "%03d", int((gettimeofday)[1]/1000);
    
32.             $label1->TITLE( time2str("%c ", time()) .$msec );
    
33.         }
    
34.     );
    
35. 
    
36. $timer2 = IUP::Timer->new(
    
37.         TIME => "200",
    
38.         RUN => "YES",
    
39.         ACTION_CB => sub {
    
40.             my $msec = sprintf "%03d", int((gettimeofday)[1]/1000);
    
41.             $label2->TITLE( time2str("%c ", time()) .$msec );
    
42.         }
    
43.     );
    
44. 
    
45. $dlg->Show();
    
46. 
    
47. IUP->MainLoop;
    

复制代码

iamlimeng

回复 7# 523066680

我昨天试了ActivePerl 5.26，PPM库中有IUP，安装很容易，你的代码也测试了，看起来非常好。PDK最高只支持到5.22，所以IUP代码打包估计是难了。

dahe_1984

膜拜大神了