免費注冊 查看新帖 |

Chinaunix

  平臺 論壇 博客 文庫
最近訪問板塊 發新帖
查看: 39599 | 回復: 8
打印 上一主題 下一主題

從NTP授時服務器獲取高精度時間 [復制鏈接]

論壇徽章:
0
跳轉到指定樓層
1 [收藏(0)] [報告]
發表于 2019-08-11 19:49 |只看該作者 |倒序瀏覽
本帖最后由 iamlimeng 于 2019-08-11 19:51 編輯

最近在校準家里的時鐘,找了不少工具,獲得的時間都不太精確,還是自己寫吧。很久以前寫過一個,由于算法問題,精度不夠高,重寫了算法,現在精度應該在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. =info
  3.     Author: iamlimeng
  4.     Date:2019-08
  5. =cut

  6. use strict;
  7. use warnings;
  8. use Net::NTP qw(get_ntp_response);

  9. $| = 1;
  10. my $interval = 0.999999;

  11. my $NTP_Server = 'ntp1.aliyun.com'; #阿里云授時服務器,可靠性高
  12. #my $NTP_Server = 'ntp.aliyun.com'; #阿里云授時服務器,可靠性高
  13. #my $NTP_Server = 'ntp.ntsc.ac.cn';  #國家授時中心,可靠性高
  14. #my $NTP_Server = 'cn.ntp.org.cn';

  15. print "NTP Server: $NTP_Server\n\n";;
  16. my %response = eval { get_ntp_response($NTP_Server) };
  17. if (%response) {
  18.         my $time = $response{'Transmit Timestamp'} + $response{'Delay'}/2;
  19.         my ($now,$wait) = split(/\./,$time);
  20.         select(undef, undef, undef, 1-$wait/100000);
  21.          while(1) {
  22.                  $now++;
  23.                  print "\r",time_from_utc($now);
  24.                  select(undef, undef, undef, $interval);
  25.            }
  26. }
  27. else { print "Connect NTP Server Faild!"; }

  28. <STDIN>;
  29. exit;

  30. sub time_from_utc {
  31.         my $utc = shift;
  32.         my ($sec,$min,$hour,$day,$mon,$year,$weekday,$yeardate,$savinglightday) = (localtime($utc));
  33.          return (sprintf("%04d.%02d.%02d %02d:%02d:%02d",$year+1900,$mon+1,$day,$hour,$min,$sec));
  34. }
復制代碼

評分

參與人數 1信譽積分 +20 收起 理由
523066680 + 20 感謝分享

查看全部評分

論壇徽章:
0
2 [報告]
發表于 2019-08-13 11:47 |只看該作者
搞了一個成品:
鏈接:https://pan.baidu.com/s/1zXd9iJ2CaphRPloJ6VZ4dw
提取碼:a3qj

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
3 [報告]
發表于 2019-08-13 12:41 |只看該作者
你用哪個模塊做GUI, Label 更新的時候有點閃爍

論壇徽章:
0
4 [報告]
發表于 2019-08-13 12:54 |只看該作者
Win32::GUI,寫GUI很麻煩,簡單的搞一搞勉強可以。Label更新是個Timer,確實有點閃爍。

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
5 [報告]
發表于 2019-08-13 15:13 |只看該作者
本帖最后由 523066680 于 2019-08-13 15:16 編輯
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做的一個電商發貨輔助工具



論壇徽章:
0
6 [報告]
發表于 2019-08-13 15:53 |只看該作者
ActiveState在ActivePerl-5.22.2.2202的PPM中沒有提供編譯好的IUP安裝包,而這個版本是PDK支持的最后一個版本,我用CPAN安裝IUP未成功,所以打包有可能沒戲。

論壇徽章:
12
子鼠
日期:2014-10-11 16:46:482016科比退役紀念章
日期:2018-03-16 10:24:0515-16賽季CBA聯賽之山東
日期:2017-11-10 14:32:142016科比退役紀念章
日期:2017-09-02 15:42:4715-16賽季CBA聯賽之佛山
日期:2017-08-28 17:11:5515-16賽季CBA聯賽之浙江
日期:2017-08-24 16:55:1715-16賽季CBA聯賽之青島
日期:2017-08-17 19:55:2415-16賽季CBA聯賽之天津
日期:2017-06-29 10:34:4315-16賽季CBA聯賽之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亞冠之薩濟拖拉機
日期:2015-05-22 11:38:5315-16賽季CBA聯賽之北京
日期:2019-08-13 17:30:53
7 [報告]
發表于 2019-08-13 19:18 |只看該作者
本帖最后由 523066680 于 2019-08-13 19:20 編輯

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. my $label1 = IUP::Label->new(
  7.     TITLE => "",
  8.     FONT => "Microsoft YaHei",
  9.     FONTSIZE=>"18",
  10.     EXPAND => "HORIZONTAL",
  11. );

  12. my $label2 = IUP::Label->new(
  13.     TITLE => "",
  14.     FONT => "Microsoft YaHei",
  15.     FONTSIZE=>"18",
  16.     EXPAND => "HORIZONTAL",
  17. );

  18. my $dlg = IUP::Dialog->new(
  19.     child => IUP::Vbox->new( child => [$label1, $label2] ),
  20.     TITLE => "IupTimer",
  21.     SIZE  => "300x100",
  22. );

  23. $timer1 = IUP::Timer->new(
  24.         TIME => "100",
  25.         RUN => "YES",
  26.         ACTION_CB => sub {
  27.             my $msec = sprintf "%03d", int((gettimeofday)[1]/1000);
  28.             $label1->TITLE( time2str("%c ", time()) .$msec );
  29.         }
  30.     );

  31. $timer2 = IUP::Timer->new(
  32.         TIME => "200",
  33.         RUN => "YES",
  34.         ACTION_CB => sub {
  35.             my $msec = sprintf "%03d", int((gettimeofday)[1]/1000);
  36.             $label2->TITLE( time2str("%c ", time()) .$msec );
  37.         }
  38.     );

  39. $dlg->Show();

  40. IUP->MainLoop;
復制代碼

論壇徽章:
0
8 [報告]
發表于 2019-08-14 08:43 |只看該作者
回復 7# 523066680

我昨天試了ActivePerl 5.26,PPM庫中有IUP,安裝很容易,你的代碼也測試了,看起來非常好。PDK最高只支持到5.22,所以IUP代碼打包估計是難了。

論壇徽章:
0
9 [報告]
發表于 2020-04-21 16:56 |只看該作者
膜拜大神了
您需要登錄后才可以回帖 登錄 | 注冊

本版積分規則 發表回復

  

北京盛拓優訊信息技術有限公司. 版權所有 京ICP備16024965號-6 北京市公安局海淀分局網監中心備案編號:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年舉報專區
中國互聯網協會會員  聯系我們:huangweiwei@itpub.net
感謝所有關心和支持過ChinaUnix的朋友們 轉載本站內容請注明原作者名及出處

清除 Cookies - ChinaUnix - Archiver - WAP - TOP
   日韩综合区视频第一页导航,无码JK粉嫩小泬在线观看,午夜精品A片一区二区三区,日日躁夜夜躁狠狠躁麻豆,大胆国模,免费观看无遮挡www的网站