【转】vb获得网络时间的函数

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

{"success":"1","result":{"timestamp":"1550717323","datetime_1":"2019-02-21 10:48:43","datetime_2":"2019年02月21日 10时48分43秒","week_1":"4","week_2":"星期四","week_3":"周四","week_4":"Thursday"}}

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

今天下午专门研究了下怎样可以比较可靠的获取网络的时间的问题，发现网上有个java写的代码可以根据任何一个网站访问返回的头信息里取时间，相当于去获得这个网站的服务器时间，这样的话我们去获取百度阿里等大网站的服务器时间，这样就比较可靠了，而且一般也不会出现不可访问的问题。研究了下得到了GMT时间，然后又花了不少时间通过js中转终于可以得到我们的标准时间了。如果有谁有把GMT时间简便转换为标准北京时间的代码的话请提供下。
---------------------
作者：首都网吧管理员
来源：CSDN
原文：https://blog.csdn.net/sysdzw/article/details/54601414
版权声明：本文为博主原创文章，转载请附上博文链接！

Private Sub Form_Load()MsgBox getWebDatetime
End Sub'方法一，根据个别网址得到时间，由于网站不确定性可能会更新导致失效。不推荐
Private Function getWebDatetime() As StringDim strData As StringDim reg As ObjectDim XmlHttp As ObjectSet XmlHttp = CreateObject("Microsoft.XMLHTTP")XmlHttp.Open "GET", "http://www.beijing-time.org/time15.asp", FalseXmlHttp.SetRequestHeader "If-Modified-Since", "0"XmlHttp.sendstrData = StrConv(XmlHttp.ResponseBody, vbUnicode)Set XmlHttp = NothingSet reg = CreateObject("vbscript.regExp")reg.Global = Truereg.IgnoreCase = Truereg.MultiLine = Truereg.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 StringDim XmlHttp As Object, objJs As Object, objStream As ObjectSet XmlHttp = CreateObject("Microsoft.XMLHTTP")XmlHttp.Open "GET", "http://api.k780.com:88/?app=life.time&appkey=10003&sign=b59bc3ef6191eb9f747dd4e83c99f2a4&format=json", FalseXmlHttp.SetRequestHeader "If-Modified-Since", "0"XmlHttp.sendSet objStream = CreateObject("Adodb.Stream")objStream.Type = 1objStream.Mode = 3objStream.OpenobjStream.Write XmlHttp.ResponseBodyobjStream.position = 0objStream.Type = 2objStream.Charset = "UTF-8"Set objJs = CreateObject("msscriptcontrol.scriptcontrol")objJs.Language = "jScript"getWebDatetime = objJs.eval("eval(" & objStream.ReadText & ").result.datetime_1")objStream.CloseSet objStream = NothingSet XmlHttp = NothingSet objJs = Nothing
End Function'方法三，读取网站服务器返回的时间，这里的百度网站可以换成任何其他的例如淘宝。强烈推荐
Private Function getWebDatetime() As StringDim XmlHttp As Object, objJs As ObjectSet XmlHttp = CreateObject("Microsoft.XMLHTTP")XmlHttp.Open "POST", "http://www.baidu.com", FalseXmlHttp.sendSet 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 = NothingSet objJs = Nothing
End Function'方法四，直接用vb转换GMT时间（网友Chen8013提供），强烈推荐推荐
Private Function getWebDatetime() As StringDim XmlHttp As ObjectSet XmlHttp = CreateObject("Microsoft.XMLHTTP")XmlHttp.Open "POST", "http://www.baidu.com", FalseXmlHttp.sendgetWebDatetime = CDate(1 / 3 + CDbl(CDate(Mid$(XmlHttp.getResponseHeader("Date"), 5, 21))))Set XmlHttp = Nothing
End Function'方法五，来自https://blog.csdn.net/sitongqdl/article/details/46412633
Private Function GetTime() As DateDim oXMLHTTP As ObjectSet oXMLHTTP = CreateObject("MSXML2.XMLHTTP")oXMLHTTP.open "HEAD", "http://www.baidu.com", FalseoXMLHTTP.sendGetTime = DateAdd("h", 8, CDate(Trim(Split(Split(oXMLHTTP.getResponseHeader("Date"), ",")(1), "GMT")(0))))
End Function

【转】vb获得网络时间的函数相关推荐

转载-VB根据网络时间校准本地时间
通过Internet获得标准时间 (2009-10-27 21:22:47) 转载▼ 标签: 电脑基础 it分类: 电脑基础通过Internet获得标准时间 2009-02-14 23:50 在一个 ...
Excel VBA 获取网络时间函数接口
VBA获取网络时间函数接口 Public Function getWebDatetime()Dim XmlHttp As ObjectXmlHttp = CreateObject("Micr ...
VB中的format格式化函数
VB Format函数 Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 - - - - - - - - - - - - - - - ...
收集SQLite中的时间日期函数[ZT]
声明:文章摘自:http://www.xueit.com/html/2009-02/27_649_00.html 在插入数据时为了插入时间,我自己用了这个方法在数据库中: sql = "IN ...
VB 迅雷下载地址解密函数
它可将加密过的迅雷下载地址URL转换成真正的下载地址. Private Sub Form_Load() '解密 MsgBox thunderToURL("thunder: ...
VB 读取UTF-8编码文件函数
参数:Path 文件路径 Unicode 文件编码 Public Function File_get_contents(Path As String, Optional Unicode = " ...
设定软件使用期限，根据网络时间保护试用软件产品的方法
思路很简单(容易破解): 1. 在代码内设定最后使用期限 2. 程序运行时首先从网络获取时间 3. 获取网络时间失败(如用户未联网)或者网络时间显示已经超过设定期限,程序退出. 4. 特别注意:程序需 ...
Esp8266 进阶之路36【外设篇】乐鑫esp8266芯片SDK编程驱动时间芯片 ds1302，同步网络时间到本地，再也不怕掉电断网也可以同步时间了！（附带Demo）
本系列博客学习由非官方人员半颗心脏潜心所力所写,仅仅做个人技术交流分享,不做任何商业用途.如有不对之处,请留言,本人及时更改. 1. Esp8266之搭建开发环境,开始一个"hello ...
Arduino ESP32 获取网络时间并同步本地RTC时钟
Arduino ESP32 获取网络时间并同步本地RTC时钟相关篇<Arduino ESP32 最简单直接获取网络时间方法> 在 ArduinoESP32核心支持库当中已经包含相关的获取 ...

【转】vb获得网络时间的函数

【转】vb获得网络时间的函数相关推荐

最新文章

热门文章