VB网络校时.

    有时我们对某些场合,对系统时间的要求是很高的,例如:SQLSERVER服务器间的同步或文件同步.但计算机的时钟运行一段时间,会出现一个误差.时间长了,可能达分钟以上.下面程序可以解决这个问题.该程从各天文台或国家授时中心读取时间后,并设置为计算机的本地时间.误差在一秒以内.

 

  1. Option Explicit
  2. Dim SvrName(14) As String
  3. '
  4. Private Sub SetTime()
  5.     On Error Resume Next
  6.     
  7.     Dim i As Long
  8.     For i = 1 To 14
  9.         With Winsock1(i)
  10.             If .State = 9 Then Exit Sub
  11.             If .State > 0 Then .Close
  12.             .Connect SvrName(i), 13
  13.         End With
  14.     Next
  15.     
  16.     Timer2.Enabled = True
  17.     labMsg.Caption = "开始校时..."
  18.     
  19. End Sub
  20. '
  21. Private Sub Form_Load()
  22.     Dim i As Long
  23.     
  24.     SvrName(1) = "time.nist.gov"                'NCAR, Boulder, Colorado  192.43.244.18
  25.     SvrName(2) = "time-a.nist.gov"              'NIST, Gaithersburg, Maryland  129.6.15.28
  26.     SvrName(3) = "time-b.nist.gov"              'NIST, Gaithersburg, Maryland  129.6.15.29
  27.     SvrName(4) = "time-a.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.101
  28.     SvrName(5) = "time-b.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.102
  29.     SvrName(6) = "time-c.timefreq.bldrdoc.gov"  'NIST, Boulder, Colorado  132.163.4.103
  30.     SvrName(7) = "utcnist.colorado.edu"         'University of Colorado, Boulder  128.138.140.44
  31.     SvrName(8) = "time-nw.nist.gov"             'Microsoft, Redmond, Washington 131.107.1.10
  32.     SvrName(9) = "nist1.datum.com"              'Datum, San Jose, California  66.243.43.21
  33.     SvrName(10) = "nist1.dc.glassey.com"        'Abovenet, Virginia  216.200.93.8
  34.     SvrName(11) = "nist1.ny.glassey.com"        'Abovenet, New York City  208.184.49.9
  35.     SvrName(12) = "nist1.sj.glassey.com"        'Abovenet, San Jose, California  207.126.103.204
  36.     SvrName(13) = "nist1.aol-ca.truetime.com"   'TrueTime, AOL facility, Sunnyvale, CA  207.200.81.113
  37.     SvrName(14) = "nist1.aol-va.truetime.com"   'TrueTime, AOL facility, Virginia  205.188.185.33
  38.     
  39.     For i = 1 To 14
  40.         Load Winsock1(i)
  41.     Next
  42.     
  43.     labTime.Caption = Format$(Now, "yyyy-mm-dd  hh:mm:ss")
  44.     Call SetTime
  45.     
  46. End Sub
  47. '
  48. Private Sub Form_Unload(Cancel As Integer)
  49.     Dim i As Long
  50.     For i = 1 To 14
  51.         Unload Winsock1(i)
  52.     Next
  53.     Erase SvrName
  54.     End
  55. End Sub
  56. '
  57. Private Sub Timer1_Timer()
  58.     labTime.Caption = Format$(Now, "yyyy-mm-dd  hh:mm:ss")
  59. End Sub
  60. '
  61. Private Sub Timer2_Timer()
  62.     Call SetTime
  63. End Sub
  64. '
  65. Private Sub Timer3_Timer()
  66.     Unload Me
  67. End Sub
  68. '
  69. Private Sub Winsock1_DataArrival(Index As IntegerByVal bytesTotal As Long)
  70.     On Error Resume Next
  71.     
  72.     Dim s As String
  73.     Dim dt As Date
  74.     
  75.     Winsock1(Index).GetData s, vbString
  76.     
  77.     If Mid$(s, 31, 1) <> "0" Then Exit Sub
  78.     If Me.Tag = "OK" Then Exit Sub
  79.     
  80.     Me.Tag = "ok"
  81.     dt = CDate(Mid$(s, 8, 17)) + 8# / 24#
  82.     Date = dt
  83.     Time = dt
  84.     labMsg = labMsg & "成功!  10秒后关闭!" & vbCrLf
  85.     Timer2.Enabled = False
  86.     Timer3.Enabled = True
  87.     
  88. End Sub
 
发布了25 篇原创文章 · 获赞 4 · 访问量 6万+
展开阅读全文

没有更多推荐了,返回首页

©️2019 CSDN 皮肤主题: 大白 设计师: CSDN官方博客

分享到微信朋友圈

×

扫一扫,手机浏览