vb.net取网络时间的简单介绍( 二 )


.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
vb 获取网络时间下列代码不用任何控件就能从国家授时中心网页获取时间获得网络时间 。
Function NetTime(Optional url As String) As String'返回包括时间和日期vb.net取网络时间的字符串
Dim obj, OBJStatus,Retrieval
Dim GetText As String
Dim i As Long
Dim myDate As Date
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
If url = "" Then
url = "" '从国家授时中心网页获取时间
End If
'通过下载网页头信息获取网络时间
On Error Goto ToExit
With Retrieval
.Open "Get", url, False, "", ""
.setRequestHeader "If-Modified-Since", "0"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Connection", "close"
.Send
If .Readystate4 Then Exit Function
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 = Left(GetText, i - 1)
myDate = GetText '字符串变为时间类型
myDate = myDate + #8:00:00 AM#'将时间转化为北京时间
NetTime = myDate'将时间转化为字符串
End If
End With
ToExit:
Set Retrieval = Nothing
Set OBJStatus = Nothing
Set obj = Nothing
End Function
利用上述NetTime函数,可以将本机时间同步到标准时间,误差一般不超过1秒,如果多次运行或加上网络延时校正代码可进一步减少误差 。
运行代码后,可以用第三方软件或到国家授时中心网站查看本机时间与标准时间vb.net取网络时间的误差以验证代码vb.net取网络时间的效果,当然更可以用第三方软件来校正电脑时间 , 这样误差将不超过0.1秒 。这是VB中用Time语句设定本机时间无法实现的,因为Time语句的“分辨率”只能达到整秒 。
Sub UpDateTime()
Dim sTime as String
sTime=NetTime()
On Error Resume Next
If Stime"" Then
Time=sTime
Date=sTime
End If
End Sub
Vb.net 2008 如何获取网络时间你是指Internet上vb.net取网络时间的国际标准时间吗 。
先加入控件 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.CtlStateMSWinsockLib.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.govvb.net取网络时间!")
Else
NetTime("time.nist.gov")
If TimeFromNet = "" Then
MsgBox("网络标准时间服务器time.nist.gov超时vb.net取网络时间!")

推荐阅读