一般获取网络时间的方法都是去找到个可以显示时间的网址,这里列几个比较可靠的:
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 = "[\s\S]*?(\d{4})[\s\S]*?(\d+)[\s\S]*?(\d+)[\s\S]*?(?:\d+)[\s\S]*?(\d+)[\s\S]*?(\d+)[\s\S]*?(\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(/(?=\b\d\b)/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测试的时候注意删除掉另外两个函数,否则会发生同名函数冲突的问题。 原文链接:https://www.f2er.com/vb/256822.html