自己动手打造精确网络时钟
想不想令你的计算机时钟精准无比？下载网络校时软件当然可以，不过时不时的跳出一个让你注册的框子，实在讨厌，即使是免费的又怎么能满足你那颗充满好奇和迷惑的心呢！其实一切都很简单，下面我就带着你，自己动手，打造一个通过网络自动校时的软件--网络时钟。网络校时的原理，说来很简单：就是通过网络连接和网络时间服务器进行对话，获得具有一定精度的时间值。
这个程序我们选用Visual Basic6.0进行开发，如果你用别的开发工具，只要了解了原理，同样不会有多少困难。
要想上网和时间服务器进行对话，当然离不开网络协议，对于时间服务器吗，当然需要网络时间协议(Network Time Protocol),这个协议非常简单，为完成我们的程序，仅需了解 RFC868时间协议，这个协议描述了具体的应答过程，RFC868支持两种网络传输方式：TCP和UDP.
TCP(传输控制协议)方式：
时间服务器(S)：监听端口37
客户端(U)： 连接服务器的37端口
S: 以32位的二进制值发送时间的秒数值
U: 接收时间的秒数值
U: 断开连接
S: 断开连接
UDP(用户数据报协议)方式：
时间服务器(S)：监听端口37
客户端(U)： 发送空数据报到时间服务器的37端口
S: 接收这个空数据报
S: 发送一个包含32位二进制秒数值的数据报
U: 接收时间秒数值数据报
其中的时间秒数值是指从1900年1月1日00:00:00时刻起到现在的总秒数值，在上述的过程中，时间服务器要确保发送有效的时间值。
由这个协议内容可以知道，我们的程序应该包括两个主要部分：
（一）和时间服务器进行应答，获得32位二进制总秒数值
（二）将获得的总秒数值转换成现在的时刻值
下面就启动VB6，亲自打造出这个程序吧。
首先，当然是新建一个窗体，然后添加必要的一些控件，具体的包括：
显示本地系统时间的文本框:LocalTimeText;
显示服务器时间的文本框：ServerTimeText；
选择时间服务器地址的组合框：TimeServer；
再为前面的三个控件添加三个名称标签：label1,label2,label3；
再添加两个按钮：“获时”按钮（ConnectCmd）和“校时”按钮（JSCmd），
具体的大小和位置，由你自己决定。
要想和时间服务器建立连接对话，需要知道服务器的地址名称，上网查一下资料，就可以找到一些时间服务器的地址，我们将这些地址放入组合框TimeServer中,赋值将在Form_Load事件中完成。知道了地址，如何连接呢？实现这个操作一点也不复杂，因为我们有现成的Winsock控件,看看你的工具箱中是不是有一个包括两个小电脑的控件图标？如果没有，不要紧，按下面的步骤添加即可：点击工程菜单，点“部件”，在“控件”选项页中的“Microsoft Winsock Control 6.0”前面的小方框中打钩选中，点“确定”，在看看工具箱，这回肯定有了吧。
Winsock控件，是为了简化网络编程而建立的，有了它，网络编程便成了极其简单轻松的事情了，现在在窗体上添加一个Winsock控件（sckClient），在程序运行时，它是不可见得。Winsock控件对TCP和UDP两种数据传输协议都支持，本程序为了和时间服务器进行连接对话，我们将采用UDP协议方式。当然对于一个较完善的程序，对这两种方式都应该支持，如果想做到这一点，看完本程序，你会发现几行代码就可以解决这个问题。
我们的程序要不断显示时间，因此还要添加一个时间控件（Timer1）。至此，我们的窗体设计基本完成。
程序的基本任务是：如果点击“获时”按钮，则根据TimeServer组合框中选定的服务器地址和该服务器进行网络连接，获得总秒数值，由此得到现在的时刻值；如果点击“校时”按钮，则根据txtOutput中的服务器时间校订本地系统时间。当然你可以对本程序进行修改，使之成为可以进行网络校时的一个独立模块，以便加入到你开发的其他软件当中。
程序并不长，可以结合注释内容进行研究。
Option Explicit
Dim dCF(3) As Double '保存3个计算常数
Dim StartDate As Date '1/1/1900
Dim NowDate As Date '当前日期
Dim dSecDiffs As Double '本地系统时间与服务器时间的秒数误差
Dim dStartTime As Double '记录查询时间服务器的开始时间
Dim dTimeClicks As Double '获得的时间服务器的总秒数值
Dim iCounts As Integer '允许重复连接的次数
Private Sub ConnectCmd_Click()
''点击“获时”按钮,开始通过UDP协议与选定的时间服务器进行连接对话
On Error Resume Next
dTimeClicks = 0
iCounts = 1
sckClient.Protocol = sckUDPProtocol '应用UDP协议
sckClient.RemoteHost = TimeServer.List(TimeServer.ListIndex) '服务器地址名称
sckClient.RemotePort = 37 '端口37
sckClient.SendData 0 '发送空字节
dStartTime = Timer '记录查询时间服务器的开始时间
'用于计算网络连接的时间延时
ConnectCmd.Enabled = False
ServerTimeText.Text = "正在连接时间服务器......"
Timer1.Enabled = True '打开时钟控件
JSCmd.Enabled = False
End Sub
Private Sub JSCmd_Click()
''校准本地系统时间
Time = ServerTimeText.Text '将服务器时间设定为本机时间
dSecDiffs = 0 '秒数误差设置为0
JSCmd.Enabled = False '关闭校时按钮，在重新获时之前不能再校时
End Sub
Private Sub Form_Load()
'初始化
TimeServer.AddItem "ntp.cs.mu.oz.au"
TimeServer.AddItem "ntp0.fau.de"
TimeServer.AddItem "ntp2.fau.de"
TimeServer.AddItem "ntp3.fau.de"
TimeServer.AddItem "time-nw.nist.gov"
TimeServer.AddItem "ntps1-0.cs.tu-berlin.de"
TimeServer.AddItem "ntps1-0.uni-erlangen.de"
TimeServer.AddItem "ntps1-1.cs.tu-berlin.de"
TimeServer.AddItem "ntps1-1.uni-erlangen.de"
TimeServer.AddItem "ntp0.nl.net"
TimeServer.AddItem "ntp2.nl.net"
TimeServer.AddItem "timekeeper.isi.edu"
TimeServer.ListIndex = 1
Timer1.Interval = 1000
JSCmd.Enabled = False
dCF(0) = 2 ^ 24: dCF(1) = 2 ^ 16: dCF(2) = 2 ^ 8
End Sub
Private Sub Form_Unload(Cancel As Integer)
''关闭窗体时，关闭Winsock连接
sckClient.Close
End Sub
Private Sub sckClient_DataArrival(ByVal bytesTotal As Long)
'有数据到达时，触发此过程
On Error Resume Next
Dim reData '定义变体类型，获得接收的数据
Dim bArr() As Byte '定义二进制数组，用于存储接收到的32位字节数据
sckClient.GetData reData, vbArray + vbByte '按二进制数组格式接收数据
bArr = reData
dTimeClicks = bArr(0) * dCF(0) + bArr(1) * dCF(1) + bArr(2) * dCF(2) + bArr(3) '将32位二进制字节数据转换成总秒数值
If Timer - dStartTime > 0.5 Then '如果查询时间超出精度控制，放弃本次查询
dTimeClicks = 0
Exit Sub
Else
If dTimeClicks <> 0 Then '为有效查询
dSecDiffs = GetTotalSecs + Timer - dTimeClicks '得到秒数误差值
End If
End If
sckClient.Close '关闭Winsock
ConnectCmd.Enabled = True
JSCmd.Enabled = True
End Sub
Function GetTimeStr(tclks As Long) As String
''此函数根据从00：00：00到现在时刻的秒数值计算得出现在的时：分：秒
Dim hrs As String*2, mins As String*2, secs As String*2
tclks = Int(tclks)
hrs = Trim(Str(tclks / 3600))
mins = Trim(Str((tclks Mod 3600) / 60))
secs = Trim(Str(tclks Mod 60))
If Val(hrs) < 10 Then hrs = "0" + hrs
If Val(mins) < 10 Then mins = "0" + mins
If Val(secs) < 10 Then secs = "0" + secs
GetTimeStr = hrs + ":" + mins + ":" + secs
End Function
Private Sub Timer1_Timer()
''时间控件程序，用于显示本地时间，以及连接失败时，进行重复连接
Dim temp As Long
On Error Resume Next
temp = Timer '临时存储时间
LocalTimeText.Text = Str(Date) + " <" + GetTimeStr(temp) + ">" '显示本地时间
If dTimeClicks = 0 Then '如果没有获得有效秒数值或连接失败
sckClient.Close
If iCounts > 5 Then '可以重复5次连接
ServerTimeText.Text = "连接超时"
ConnectCmd.Enabled = True
Exit Sub
End If
'重新发送数据连接请求
iCounts = iCounts + 1
sckClient.Protocol = sckUDPProtocol
sckClient.RemoteHost = TimeServer.List(TimeServer.ListIndex)
sckClient.RemotePort = 37
sckClient.SendData 0
dStartTime = Timer '记录本次连接申请的开始时间
Exit Sub
End If
ServerTimeText.Text = Str(Date) + " <" + GetTimeStr(temp - dSecDiffs) + ">"
'显示获得的时间服务器时间
End Sub
Private Function GetTotalSecs() As Double
''此函数获得从1/1/1900 00：00：00 到今天00：00：00的总秒数值
Dim tZone As TIME_ZONE_INFORMATION '定义时区信息变量，以获得时差值
GetTimeZoneInformation tZone '利用API函数，获得时区信息
StartDate = #1/1/1900#
NowDate = Date
GetTotalSecs = DateDiff("s", StartDate, NowDate) + 60 * tZone.Bias
'其中的函数DateDiff()可以计算出两个时刻之间的时间长度，参数"s"表示要计算秒数值
End Function
最后再添加一个定义有关时间信息类型和API声名的模块：
Type SYSTEMTIME '这两个类型定义可以在MSDN的联机文档中找到
iYear As Integer
iMonth As Integer
iDayOfWeek As Integer
iDay As Integer
iHour As Integer
iMinute As Integer
iSecond As Integer
iMilliseconds As Integer
End Type
Type TIME_ZONE_INFORMATION
Bias As Long '时差（分钟数），我们的程序仅需要这一项
StandardName(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Public Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
<script type="text/javascript"> google_ad_client = "pub-2416224910262877"; google_ad_width = 728; google_ad_height = 90; google_ad_format = "728x90_as"; google_ad_channel = ""; google_color_border = "E1771E"; google_color_bg = "FFFFFF"; google_color_link = "0000FF"; google_color_text = "000000"; google_color_url = "008000"; </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
1479
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
