vb 获取网络时间较快的代码
发布网友
发布时间：2022-04-21 11:19
共2个回答
热心网友
时间：2023-07-13 04:29
直接用vb转换GMT时间
Private Function getWebDatetime() As String
Dim XmlHttp As Object
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "POST", "http://www.baidu.com", 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", "http://www.baidu.com", 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
热心网友
时间：2023-07-13 04:29
Function getDateTime(Optional url As String) As String
Dim xmlhttp
Dim dt As String
Dim m As Integer, n As Integer
On Error Resume Next
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
If url = "" Then url = "http://www.time.ac.cn"
With xmlhttp
.Open "Get", url, False, "", ""
.setRequestHeader "If-Modified-Since", "0"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Connection", "close"
.Send
dt = .getAllResponseHeaders()
m = InStr(1, dt, "Date:", vbTextCompare)
n = InStr(1, dt, "GMT", vbTextCompare)
If m > 0 Then getDateTime = CDate(Trim(Split(Mid(dt, m + 5, n - m - 5), ",")(1))) + #8:00:00 AM#
End With
Set xmlhttp = Nothing
End Function
调用方法：
dt=getDateTime("http://www.baidu.com") '从百度服务器获取时间，我这里获取很快（毫秒级），取决于你访问百度的速度
dt=getDateTime() '从国家授时中心获取时间，我这里访问比较慢
追问谢谢，我输入QQ.com，速度较快，能不能给一段判断网络是否连接的代码，判断速度也快一的
