從NTP授時服務器獲取高精度時間

iamlimeng

最近在校準家里的時鐘，找了不少工具，獲得的時間都不太精確，還是自己寫吧。很久以前寫過一個，由于算法問題，精度不夠高，重寫了算法，現(xiàn)在精度應該在0.1秒以內(nèi)（前提是服務器時間精確）。

目前國內(nèi)比較可靠，網(wǎng)絡訪問延時少的授時服務器有：阿里云授時服務器、國家授時中心服務器、NTP.ORG，當然蘋果和微軟的授時服務器也不錯。

NTP(Network Time Protocol）網(wǎng)絡時間協(xié)議基于UDP，用于網(wǎng)絡時間同步的協(xié)議，使網(wǎng)絡中的計算機時鐘同步到UTC，再配合各個時區(qū)的偏移調(diào)整就能實現(xiàn)精準同步對時功能。NTP授時精度與NTP服務器與用戶間的網(wǎng)絡狀況有關：廣域網(wǎng)授時精度通常能達50ms級，但有時超過500ms；局域網(wǎng)授時不存在路由器路徑延遲問題，因而授時精度理論上可以提到亞毫秒級；但是Windows內(nèi)置NTP服務，在局域網(wǎng)內(nèi)其最高授時精度也只能達10ms級。

IETF的RFC5905對NTP數(shù)據(jù)包的結構有詳細說明。

萬能的Perl就有效率比較高的解析模塊Net::NTP，結合RFC5905文檔的說明，將NTP服務器反饋的數(shù)據(jù)包解析后，只須對接收到的時間數(shù)據(jù)進行延時修正，就能獲得準確的時間，這個精度對于一般用途足夠了。

代碼分享如下：

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 發(fā)表于 2019-08-13 12:54
Win32::GUI，寫GUI很麻煩，簡單的搞一搞勉強可以。Label更新是個Timer，確實有點閃爍。

我現(xiàn)在用 IUP，和 WIN32::GUI 應該是同一個作者，kmx
https://metacpan.org/author/KMX

記得 Win32::GUI 有些模塊不能用了，IUP還算穩(wěn)定，但打包成exe沒試過 （總之就是各種不方便啊）

這幾天用IUP做的一個電商發(fā)貨輔助工具

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

膜拜大神了