vb点虐 获取互联网的北京时间

Public Function GetBeijingTime() As DateTime

湛河网站建设公司创新互联公司,湛河网站设计制作，有大型网站制作公司丰富经验。已为湛河上1000+提供企业网站建设服务。企业网站搭建\外贸网站制作要多少钱，请找那个售后服务好的湛河做网站的公司定做！

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

vb 获取网络时间

下列代码不用任何控件就能从国家授时中心网页获取时间获得网络时间。

Function NetTime(Optional url As String) As String '返回包括时间和日期的字符串

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 .Readystate 4 Then Exit Function

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)

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秒，如果多次运行或加上网络延时校正代码可进一步减少误差。

运行代码后，可以用第三方软件或到国家授时中心网站查看本机时间与标准时间的误差以验证代码的效果，当然更可以用第三方软件来校正电脑时间，这样误差将不超过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 获取网络时间较快的代码

直接用vb转换GMT时间

Private Function getWebDatetime() As String

Dim XmlHttp As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "", False

XmlHttp.send

getWebDatetime = CDate(1 / 3 + CDbl(CDate(Mid$(XmlHttp.getResponseHeader("Date"), 5, 21))))

Set XmlHttp = Nothing

End Function

扩展资料：

读取网站服务器返回的时间的代码

Private Function getWebDatetime() As String

Dim XmlHttp As Object, objJs As Object

Set XmlHttp = CreateObject("Microsoft.XMLHTTP")

XmlHttp.Open "POST", "", False

XmlHttp.send

Set objJs = CreateObject("msscriptcontrol.scriptcontrol")

objJs.Language = "jScript"

getWebDatetime = objJs.Eval("var dt = new Date('"  XmlHttp.getResponseHeader("Date")  "');var date = [  [dt.getFullYear(), dt.getMonth() + 1, dt.getDate()].join('-'),  [dt.getHours(), dt.getMinutes(), dt.getSeconds()].join(':')].join(' ').replace(/(?=\b\d\b)/g, '0');date;")

Set XmlHttp = Nothing

Set objJs = Nothing

End Function

vb。net怎么获取网络上的时间 坐等

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

分享文章：包含vb点虐 获取网站时间的词条
文章来源：http://azwzsj.com/article/ddjsdij.html