事实上在Internet上有三个不同的时间服务，每一个都由Request for Comment（RFC）定义为Internet日期时间标准。这三个标准分别为：RFC-867、RFC-868和RFC-1305。下面就先介绍RFC-867：RFC867 Daytime协议(RFC867 Daytime Protocol)本RFC规范了一个ARPA Internet community上的标准。在ARPA Internet上的所有主机应当采用和实现这个标准。一个有用的测量和调试工具就是daytime服务。它的作用就是返回当前时间和日期，格式是字符串格式。 * 基于TCP的daytime服务 daytime服务是基于TCP的应用，服务器在TCP端口13侦听，一旦有连接建立就返回ASCII形式的日期和时间(接收到的任何数据被忽略)，在传送完后关闭连接。 * 基于UDP的daytime服务 daytime服务也可以使用UDP协议，它的端口也是13，不过UDP是用数据报传送当前时间的。接收到的数据被忽略。 * Daytime格式 对于daytime没有特定的格式，建议使用ASCII可打印字符，空格和回车换行符。daytime应该在一行上。下面是两种流行的格式：一种流行的格式是：Weekday, Month Day, Year Time-Zone例子：Tuesday, February 22, 1982 17:37:43-PST另一种流行的格式用于SMTP中：dd mmm yy hh:mm:ss zzz例子：02 FEB 82 07:59:01 PST 注意：对于机器来说，有用的时间采用了时间协议（Time Protocol RFC-868) 接下来我们用VB程序实现通过RFC867协议设置我们自己的计算机系统时间，为使程序简化，程序未进行日期校正，只进行时间校正。在FORM1中添加1个Winsock控件，将下面代码剪贴到FORM1的代码窗体中即可： Option Explicit'采用RFC867 Daytime协议获取标准时间例程' 为中科院国家授时中心，采用北京时间'时间格式：Mon Jul 26 09:58:57 2004'time.nist.gov为美国标准技术院，采用格灵威时间'时间格式：53212 04-07-26 02:00:12 50 0 0 488.3 UTC(NIST) *Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Dim NoSrv As BooleanDim TimeFromNet Private Sub Form_Load()Winsock1.Protocol = sckTCPProtocol '采用TCP协议NetTime " " '首先取中科院国家授时中心时间If NoSrv Or TimeFromNet = "" Then'若未取到中科院国家授时中心时间，则取美国标准技术院时间NetTime "time.nist.gov"If NoSrv Or TimeFromNet = "" Then'若不能取美国标准技术院时间，则报错MsgBox "检测不到网络标准时间服务器time.nist.gov！"Else'为使网络传输误差减小，第2次再取美国标准技术院时间NetTime "time.nist.gov"If TimeFromNet = "" ThenMsgBox "网络标准时间服务器time.nist.gov超时！"ElseTimeFromNet = Mid(TimeFromNet, 17, 8)TimeFromNet = TimeSerial((Hour(TimeFromNet) + 8) Mod 24, Minute(TimeFromNet), Second(TimeFromNet))Time = TimeFromNet '设置系统时间End IfEnd IfElse'为使网络传输误差减小，第2次再取中科院国家授时中心时间NetTime " "If TimeFromNet = "" ThenMsgBox "网络标准时间服务器 超时！"ElseTime = Mid(TimeFromNet, 12, 8) '设置系统时间End IfEnd IfEndEnd Sub '关闭Winsock子程序Private Sub Winsock1_Close()If Winsock1.State sckClosed ThenWinsock1.CloseEnd IfEnd Sub 'Winsock接收数据事件Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)TimeFromNet = String(bytesTotal, " ")Winsock1.GetData TimeFromNet, vbString, bytesTotalEnd Sub 'Winsock出错事件Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)NoSrv = TrueEnd Sub '从互联网上标准时间提供网站获取标准时间Private Sub NetTime(TimeSrv As String)NoSrv = FalseTimeFromNet = ""If Winsock1.State sckClosed Then Winsock1.CloseWinsock1.RemoteHost = TimeSrv ' " " 或 "time.nist.gov"Winsock1.RemotePort = 13Winsock1.LocalPort = 0Winsock1.ConnectDo While TimeFromNet = "" '循环等待标准时间网站返回时间数据If NoSrv Then Exit Do '若Winsock出错，则跳出循环等待Sleep 55DoEventsLoopIf Winsock1.State sckClosed Then Winsock1.CloseEnd Sub
创新互联专注于南沙企业网站建设,成都响应式网站建设,成都做商城网站。南沙网站建设公司,为南沙等地区提供建站服务。全流程按需网站开发，专业设计，全程项目跟踪，创新互联专业和态度为您提供的服务
Public Function GetBeijingTime() As DateTime
Dim dt As DateTime
Dim wrt As WebRequest = Nothing
Dim wrp As WebResponse = Nothing
Try
wrt = WebRequest.Create("")
wrp = wrt.GetResponse()
Dim html As String = String.Empty
Using stream As Stream = wrp.GetResponseStream()
Using sr As New StreamReader(stream, Encoding.UTF8)
html = sr.ReadToEnd()
End Using
End Using
Dim tempArray As String() = html.Split(";"c)
For i As Integer = 0 To tempArray.Length - 1
tempArray(i) = tempArray(i).Replace(vbCr vbLf, "")
Next
Dim year As String = tempArray(1).Split("="c)(1)
Dim month As String = tempArray(2).Split("="c)(1)
Dim day As String = tempArray(3).Split("="c)(1)
Dim hour As String = tempArray(5).Split("="c)(1)
Dim minite As String = tempArray(6).Split("="c)(1)
Dim second As String = tempArray(7).Split("="c)(1)
dt = DateTime.Parse(year "-" month "-" day " " hour ":" minite ":" second)
Catch generatedExceptionName As WebException
Return DateTime.Parse("2011-1-1")
Catch generatedExceptionName As Exception
Return DateTime.Parse("2011-1-1")
Finally
If wrp IsNot Nothing Then
wrp.Close()
End If
If wrt IsNot Nothing Then
wrt.Abort()
End If
End Try
Return dt
End Function
下面是一个比较完整的获取网络时间的代码，自动判断网络没连接或者连接失败类情况，不用on Error Resume Next：
Private Sub Command1_Click()
Dim obj, OBJStatus, url, GetText, i
Dim Retrieval
url = ""
'判断网络是否连接
If url "" Then
Set Retrieval = GetObject("winmgmts:\\.\root\cimv2")
Set obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = '" Mid(url, 8) "'")
For Each OBJStatus In obj
If IsNull(OBJStatus.StatusCode) Or OBJStatus.StatusCode 0 Then
Exit Sub
Else
Exit For '已连接则继续
End If
Next
End If
'通过下载网页头信息获取网络时间
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.setRequestHeader "If-Modified-Since", "0"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Connection", "close"
.Send
If .Readystate 4 Then Exit Sub
GetText = .getAllResponseHeaders()
i = InStr(1, GetText, "date:", vbTextCompare)
If i 0 Then '网页下载成功
i = InStr(i, GetText, ",", vbTextCompare)
GetText = Trim(Mid(GetText, i + 1))
i = InStr(1, GetText, " GMT", vbTextCompare)
GetText = Left(GetText, i - 1)
MsgBox "网络时间:" GetText
End If
End With
Set Retrieval = Nothing
Set OBJStatus = Nothing
Set obj = Nothing
End Sub
你是指Internet上的国际标准时间吗。
先加入控件 AxWinsock1 在.Com中Microsoft.Winsock
Public Class Form1
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)
Dim NoSrv As Boolean
Dim TimeFromNet As String
Dim OldTime As Date
Dim NewTime As Date
Dim MyDate As Date
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()
AxWinsock1.Protocol = MSWinsockLib.ProtocolConstants.sckTCPProtocol
NetTime("") '首先取中科院国家授时中心时间
If NoSrv Or TimeFromNet = "" Then
NetTime("time.nist.gov") '取美国标准技时院时间
If NoSrv Or TimeFromNet = "" Then
MsgBox("检测不到网络标准时间服务器time.nist.gov！")
Else
NetTime("time.nist.gov")
If TimeFromNet = "" Then
MsgBox("网络标准时间服务器time.nist.gov超时！")
Else
MyDate = Mid(TimeFromNet, 8, 8)
OldTime = Mid(TimeFromNet, 17, 8)
NewTime = TimeSerial((Hour(OldTime) + 8) Mod 24, Minute(OldTime), Second(OldTime))
Dim MyTime As DateTime = MyDate Space(1) NewTime
MsgBox(MyTime)
'SetWindowsClock(MyTime)
End If
End If
Else
'使网络误差时间小，第2次再中科院国家授时中心时间
NetTime("")
If TimeFromNet = "" Then
MsgBox("网络标准时间服务器超时！")
Else
MyDate = Mid(TimeFromNet, 8, 8)
NewTime = Mid(TimeFromNet, 17, 8)
Dim MyTime As DateTime = MyDate Space(1) NewTime
MsgBox(MyTime)
'SetWindowsClock(MyTime)
End If
End If
End Sub
Private Sub NetTime(ByVal TimeSrv As String)
NoSrv = False
TimeFromNet = ""
If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()
AxWinsock1.RemoteHost = TimeSrv ' "" 或 "time.nist.gov"
AxWinsock1.RemotePort = 13
AxWinsock1.LocalPort = 0
AxWinsock1.Connect()
Do While TimeFromNet = ""
If NoSrv Then Exit Do
Sleep(55)
System.Windows.Forms.Application.DoEvents()
Loop
If AxWinsock1.CtlState MSWinsockLib.StateConstants.sckClosed Then AxWinsock1.Close()
End Sub
Private Sub AxAxWinsock1_CloseEvent(ByVal sender As Object, ByVal e As System.EventArgs) Handles AxWinsock1.CloseEvent
AxWinsock1.Close()
End Sub
Private Sub AxAxWinsock1_DataArrival(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent) Handles AxWinsock1.DataArrival
AxWinsock1.GetData(TimeFromNet)
End Sub
Private Sub AxAxWinsock1_Error(ByVal sender As Object, ByVal e As AxMSWinsockLib.DMSWinsockControlEvents_ErrorEvent) Handles AxWinsock1.Error
NoSrv = True
End Sub
End Class
Dim obj,OBJStatus As Object,url As String,GetText As String,i As Integer
Dim Retrieval
url=""
'判断网络是否连接
If url""Then
Retrieval=GetObject("winmgmts:\\.\root\cimv2")
obj=Retrieval.ExecQuery("Select*FromWin32_PingStatusWhereAddress='"Mid(url,8)"'")
For Each OBJStatus In obj
If IsNothing(OBJStatus.StatusCode) Or OBJStatus.StatusCode0 Then
Exit Sub
Else
Exit For'已连接则继续
End If
Next
End If
'通过下载网页头信息获取网络时间
Retrieval=CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open ( "Get",url,False,"","")
.setRequestHeader ("If-Modified-Since","0")
.setRequestHeader ("Cache-Control","no-cache")
.setRequestHeader ("Connection","close")
.Send()
If.Readystate4 Then Exit Sub
GetText=.getAllResponseHeaders()
i=InStr(1,GetText,"date:",vbTextCompare)
If i0 Then'网页下载成功
i=InStr(i,GetText,",",vbTextCompare)
GetText= Trim(Mid(GetText,i+1))
i=InStr(1,GetText,"GMT",vbTextCompare)
GetText=GetText.Substring(0,i-1)' Left(GetText,i-1)
MsgBox ("网络时间:"GetText)
End If
End With
Retrieval=Nothing
OBJStatus=Nothing
obj=Nothing
是不是另一台电脑是vista 及以上版本的系统 ？
用管理员模式。试试
