vb获得网络时间的函数（历史上最全最完整最可靠的函数）

一般获取网络时间的方法都是去找到个可以显示时间的网址，这里列几个比较可靠的：
http://www.beijing-time.org/time15.asp
http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json

不过这些可能会随着人家网址变更或接口收费等更新导致失效。

今天下午专门研究了下怎样可以比较可靠的获取网络的时间的问题，发现网上有个java写的代码可以根据任何一个网站访问返回的头信息里取时间，相当于去获得这个网站的服务器时间，这样的话我们去获取百度阿里等大网站的服务器时间，这样就比较可靠了，而且一般也不会出现不可访问的问题。研究了下得到了GMT时间，然后又花了不少时间通过js中转终于可以得到我们的标准时间了。如果有谁有把GMT时间简便转换为标准北京时间的代码的话请提供下。

Private Sub Form_Load()
    MsgBox getWebDatetime
End Sub

'方法一，根据个别网址得到时间，由于网站不确定性可能会更新导致失效。不推荐
Private Function getWebDatetime() As String
    Dim strData As String
    Dim reg As Object
    Dim XmlHttp As Object
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET","http://www.beijing-time.org/time15.asp",False
    XmlHttp.SetRequestHeader "If-Modified-Since","0"
    XmlHttp.send
    strData = StrConv(XmlHttp.ResponseBody,vbUnicode)
    Set XmlHttp = Nothing

    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    reg.IgnoreCase = True
    reg.MultiLine = True
    reg.Pattern = "[sS]*?(d{4})[sS]*?(d+)[sS]*?(d+)[sS]*?(?:d+)[sS]*?(d+)[sS]*?(d+)[sS]*?(d+);.*"
    getWebDatetime = reg.Replace(strData,"$1-$2-$3 $4:$5:$6")
End Function

方法二，根据网上提供的一些接口提供。推荐
'直接调用getWebDatetime获取网络日期时间
Public Function getWebDatetime() As String
    Dim XmlHttp As Object,objJs As Object,objStream As Object
    
    Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
    XmlHttp.Open "GET","http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json","0"
    XmlHttp.send
    
    Set objStream = CreateObject("Adodb.Stream")
    objStream.Type = 1
    objStream.Mode = 3
    objStream.Open
    objStream.Write XmlHttp.ResponseBody
    objStream.position = 0
    objStream.Type = 2
    objStream.Charset = "UTF-8"

    Set objJs = CreateObject("msscriptcontrol.scriptcontrol")
    objJs.Language = "jScript"
    getWebDatetime = objJs.eval("eval(" & objStream.ReadText & ").result.datetime_1")
    
    objStream.Close
    Set objStream = Nothing
    Set XmlHttp = Nothing
    Set objJs = 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(/(?=bdb)/g,'0');date;")
    Set XmlHttp = Nothing
    Set objJs = Nothing
End Function

'方法四，直接用vb转换GMT时间（网友Chen8013提供），强烈推荐推荐
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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!