免费注册 查看新帖 |

ChinaUnix.net

  平台 论坛 博客 文库
12下一页
最近访问板块 发新帖
查看: 11322 | 回复: 16

分享一个自己用Perl写的GUI桌面应用程序 [复制链接]

论坛徽章:
0
发表于 2013-05-08 15:57 |显示全部楼层
本帖最后由 iamlimeng 于 2013-05-08 15:59 编辑

最近写个小程序,需要获得准确NTP时间,不依赖系统时间。我把其中的部分提出来,做成了一个可以用来同步本机时间的小桌面应用。因为Windows本身可以设置自动与授时服务器同步时间,从功能上看这个程序是多余的,但本版Perl写的桌面应用很少,尤其是GUI程序,更少,在此共享一下,希望跟大家多多交流,共同进步。

代码写得不好,大家将就参考啊。另外,对授时服务器的工作原理了解很少,如有更好的方式实现,希望前辈们多多指点。
  1. #!/usr/bin/perl

  2. use strict;
  3. #use warnings;
  4. use Win32::GUI qw( MB_ICONINFORMATION MB_OK );
  5. use POSIX qw/ _exit /;
  6. use threads;
  7. use threads::shared;
  8. use Thread::Queue;
  9. use Net::Time qw(inet_time);

  10. my $my_name = "NTP Time Synchronizer V2.0";
  11. my $about= <<EOF;
  12. /`\\ /`\\
  13. (/\\ V /\\)        $my_name
  14.   /6 6\\          -- Written by Limeng o_*, May 8, 2013
  15. >{= Y =}<
  16. /'-^-'\\         All Rights Reserved 2010-3000 ChangSha
  17. (_)""-(_)        Homepage: http://limeng.class22.net
  18.                  E-mail: iamlimeng\@163.com
  19. BlueIdea!

  20. 本程序用于从国际授时服务器获得时间,并校准系统时间!
  21. EOF

  22. my @time_sever = (
  23. 'time-a.nist.gov',
  24. 'time-b.nist.gov',
  25. 'utcnist.colorado.edu',
  26. 'time-nw.nist.gov',
  27. 'nist1-dc.glassey.com',
  28. 'nist1-ny.glassey.com',
  29. 'nist1-sj.glassey.com',
  30. 'time.nist.gov',
  31. 'salmon.maths.tcd.ie',
  32. 'nist1.symmetricom.com',
  33. '210.72.145.44',
  34. '133.100.11.8',
  35. 'time-a.timefreq.bldrdoc.gov',
  36. 'time-b.timefreq.bldrdoc.gov',
  37. 'time-c.timefreq.bldrdoc.gov',
  38. 'nist1.aol-ca.truetime.com',
  39. 'nist1.aol-va.truetime.com',
  40. );

  41. my $data_queue = new Thread::Queue;
  42. my $result_queue = new Thread::Queue;
  43. my $MAX_THREADS = 5;
  44. my $processing_count :shared = 0;
  45. my %checked :shared = ();
  46. my $net_time :shared = '';
  47. my $thread;

  48. my $w_m = 360;
  49. my $h_m = 240;
  50. my $icon = new Win32::GUI::Icon("icon.ico");
  51. my $wm_class = new Win32::GUI::Class(
  52.         -name => 'Limeng',
  53.         -icon => $icon,
  54. );

  55. my $font1 = Win32::GUI::Font->new(
  56.          -name => "Arial",
  57.          -size => 14,
  58. );

  59. my $font2 = Win32::GUI::Font->new(
  60.          -name => "宋体",
  61.          -size => 11,
  62. );

  63. my $main = Win32::GUI::Window->new(
  64.         -title => " $my_name",
  65.         -class => $wm_class,
  66.         -size  => [$w_m,$h_m],
  67.         -maximizebox        => 0,
  68.         -dialogui        => 1,
  69.         -noflicker        => 1,
  70.         -resizable        => 0,
  71. );

  72. $main->AddLabel(
  73.         -name => 'Local',
  74.         -font => $font1,
  75.         -pos  => [$w_m-315,50],
  76.         -size => [$w_m,20],
  77.         -text => "",
  78. );

  79. $main->AddLabel(
  80.         -name => 'Net',
  81.         -font => $font1,
  82.         -pos  => [$w_m-315,100],
  83.         -size => [$w_m,20],
  84.         -text => "",
  85. );

  86. $main->AddButton(
  87.         -name => 'B1',
  88.         -pos  => [$w_m-300,$h_m-70],
  89.         -font => $font2,
  90.         -text => " 校准时间 ",
  91.         -default => 1,
  92.         -ok      => 1,
  93.         -visible => 1,
  94.         -onClick => \&doAdjust,
  95. );

  96. $main->AddButton(
  97.         -name => 'B2',
  98.         -pos  => [$w_m-150,$h_m-70],
  99.         -text => " 关于程序 ",
  100.         -font => $font2,
  101.         -default => 1,
  102.         -ok      => 1,
  103.         -visible => 1,
  104.         -onClick => \&aboutMe,
  105. );
  106. my $timer1 = $main->AddTimer('T1',1000);
  107. $main->B1->Disable();
  108. $main->Center();
  109. $main->Show();
  110. &ObtainNetTime;
  111. Win32::GUI::Dialog();
  112. $main->Hide();
  113. undef $main;
  114. POSIX::_exit(0);

  115. sub Window_Terminate {
  116.         return -1;
  117. }

  118. sub doAdjust {
  119.         $thread = threads->new(\&Adjust);
  120.         $thread->detach();
  121.         return 0;
  122. }

  123. sub aboutMe {
  124.         my $self = shift;
  125.         $self->MessageBox("$about","关于本程序...",MB_ICONINFORMATION | MB_OK,);
  126.         return 0;
  127. }

  128. sub T1_Timer {
  129.         my $now = gettime();
  130.         $main->Local->Change(-text => "本机时间: $now");
  131. }

  132. sub T2_Timer {
  133.         $net_time++;
  134.         my $now = time_from_utc($net_time);
  135.         $main->Net->Change(-text => "网络时间: $now");
  136. }

  137. sub Adjust {
  138.         my ($date,$time) = split(/\s+/,time_from_utc($net_time));
  139.         my $result1 = system("date $date");
  140.         my $result2 = system("time $time");
  141.         if ($result1 or $result2) { $main->MessageBox("本机时间校准失败, 请以管理员身份运行本程序并重试!","本机时间校准失败!",MB_ICONINFORMATION | MB_OK,); }
  142.         else { $main->MessageBox("本机时间校准成功!","本机时间校准成功!",MB_ICONINFORMATION | MB_OK,); }
  143. }

  144. sub gettime {
  145.         my ($sec,$min,$hour,$day,$mon,$year,$weekday,$yeardate,$savinglightday) = (localtime(time));
  146.         $sec = ($sec < 10)? "0$sec":$sec;
  147.         $min = ($min < 10)? "0$min":$min;
  148.         $hour = ($hour < 10)? "0$hour":$hour;
  149.         $day = ($day < 10)? "0$day":$day;
  150.         $year += 1900;
  151.         $mon = ($mon < 9)? "0".($mon+1):($mon+1);
  152.         return("$year/$mon/$day $hour:$min:$sec");
  153. }

  154. sub ObtainNetTime {
  155.         $main->Net->Change(-text => "连接国际授时服务器...");
  156.         my $total = @time_sever;
  157.         my $sucess = 0;
  158.         for (my $n = 0; $n < $MAX_THREADS; $n++) {
  159.                 threads->create(\&thread_io);
  160.         }

  161.         foreach my $time_sever(@time_sever) {
  162.                  if ($data_queue ->pending() > $MAX_THREADS * 20) {
  163.                           select(undef, undef, undef, 0.02);
  164.                           redo;
  165.                  }
  166.                  $data_queue->enqueue("$time_sever");

  167.                  if ($result_queue->pending() > 0) {
  168.                           while (my $result = $result_queue->dequeue_nb()) {
  169.                                    if ($result) { $sucess++; }
  170.                           }
  171.                  }
  172.         }

  173.         my $times = 1;
  174.         while ($processing_count > 0 or $data_queue->pending() > 0 or $result_queue->pending() > 0) {
  175.                  select(undef, undef, undef, 0.02);
  176.                  while (my $result = $result_queue->dequeue_nb()) {
  177.                                    if ($result) { $sucess++; }
  178.                  }
  179.                  last if ($times > 300 or $sucess >= $total or $sucess >= 3);
  180.                  $times++;
  181.         }

  182.         foreach my $thread (threads->list(threads::all)) {
  183.                 $thread->detach();
  184.         }

  185.         # Check completion and recheck
  186.         if ($sucess < 3) {
  187.                  my @recheck;
  188.                  foreach (@time_sever) {
  189.                           if (!$checked{$_}) { push(@recheck,"$_"); }
  190.                  }
  191.                  if (@recheck) {
  192.                           foreach my $time_sever (@recheck) {
  193.                                    next if ($checked{$time_sever});
  194.                                    my $result = obtain_time($time_sever);
  195.                                    if ($result) { $sucess++; }
  196.                           }
  197.                  }
  198.         }

  199.         if ($sucess >= 3) {
  200.                  my @utc = sort values %checked;
  201.                  for (0..$#utc) {
  202.                          if (abs($utc[$_+1] - $utc[$_]) <= 10 or abs($utc[$_-1] - $utc[$_]) <= 10) {
  203.                                  $net_time = $utc[$_];
  204.                          }
  205.                  }
  206.         }
  207.          if ($net_time) {
  208.                  $main->B1->Enable();
  209.                 my $timer2 = $main->AddTimer('T2',1000);
  210.          }
  211.          else {
  212.                  $main->MessageBox("连接国际授时服务器失败, 请检查网络并重试!","连接国际授时服务器失败!",MB_ICONINFORMATION | MB_OK,);
  213.                  $main->Hide();
  214.                 undef $main;
  215.                 POSIX::_exit(0);
  216.          }
  217.          return(0);
  218. }

  219. sub thread_io()
  220. {
  221.         while (my $data = $data_queue->dequeue())
  222.         {
  223.                 {
  224.                         lock $processing_count;
  225.                         ++$processing_count;
  226.                 }

  227.                 my $result = obtain_time($data);
  228.                 $result_queue->enqueue($result);
  229.                 {
  230.                         lock $processing_count;
  231.                         --$processing_count;
  232.                 }
  233.         }
  234. }

  235. sub obtain_time {
  236.         my $time_sever = shift;
  237.         my $time = inet_time($time_sever,'udp',3);
  238.          if ($time) {
  239.                  $checked{$time_sever} = $time;
  240.                  return(1);
  241.          }
  242.          else { return(0); }
  243. }

  244. sub time_from_utc {
  245.         my $utc = shift;
  246.         my ($sec,$min,$hour,$day,$mon,$year,$weekday,$yeardate,$savinglightday) = (localtime($utc));
  247.         $sec = ($sec < 10)? "0$sec":$sec;
  248.         $min = ($min < 10)? "0$min":$min;
  249.         $hour = ($hour < 10)? "0$hour":$hour;
  250.         $day = ($day < 10)? "0$day":$day;
  251.          $mon = ($mon < 9)? "0".($mon+1):($mon+1);
  252.         $year += 1900;
  253.         return("$year/$mon/$day $hour:$min:$sec");
  254. }
复制代码
工作原理:用多线程从多个授时服务器获取时间,成功后,可以用授时服务器时间来同步本机时间。

打包后的程序如下:
NetTimeSynchronizer.rar (1.31 MB, 下载次数: 600)

论坛徽章:
2
金牛座
日期:2013-09-06 09:16:182015年迎新春徽章
日期:2015-03-04 09:53:17
发表于 2013-05-08 16:37 |显示全部楼层
楼主是做什么工作的,经常写这种程序?

论坛徽章:
1
辰龙
日期:2014-05-15 19:37:15
发表于 2013-05-09 10:06 |显示全部楼层
多谢分享,没怎么写过 GUI 但看起来很有意思

论坛徽章:
0
发表于 2013-05-09 10:09 |显示全部楼层
回复 2# nixiaoweihunter


  Perl是业余爱好,没事写几行,解决一些日常小问题,顺便防止老年痴呆。   

论坛徽章:
0
发表于 2013-05-09 11:48 |显示全部楼层
运行不了啊,一运行,Perl就停止工作了,window7 activePerl

论坛徽章:
0
发表于 2013-05-09 11:52 |显示全部楼层
回复 6# hkkkyy


    跟我的运行环境一样啊,win7+activeperl 5.10.1008,请检查一下,代码所需的的模块都已经安装。

论坛徽章:
1
未羊
日期:2014-09-08 22:47:27
发表于 2013-05-09 10:56 |显示全部楼层
回复 4# iamlimeng


    防止老年痴呆的这个主意不错。

论坛徽章:
0
发表于 2013-05-09 11:55 |显示全部楼层
我是5.16,包都装上了,难道因为是x64.回复 7# iamlimeng


   

论坛徽章:
0
发表于 2013-05-09 12:01 |显示全部楼层
回复 8# hkkkyy


   我是x86,代码本身没问题,请调试一下,看问题在哪里。

论坛徽章:
0
发表于 2013-05-09 16:15 |显示全部楼层
可以运行嘿嘿
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

基于案例的 SQL 优化实战训练营

讲师:中电福富特级专家梁敬彬,参与本次课程培训,你将收获:
1. 能编写出较为高效的 SQL;
2. 能解决70%以上的数据库常见优化问题;
3. 能得到老师提供的高效的相关工具和解决方案;
4. 能举一反三,收获不仅仅是 SQL 优化。
现在购票享受8.8折优惠!
----------------------------------------
优惠时间:2019年3月20日前

大会官网>>
  

北京盛拓优讯信息技术有限公司. 版权所有 16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122
中国互联网协会会员  联系我们:huangweiwei@it168.com
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP