以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2) ---- [求助]这段获取网络时间的代码在Foxtable中怎样应用? (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=27052) |
||||
-- 作者:blueskyyq -- 发布时间:2012/12/20 17:56:00 -- [求助]这段获取网络时间的代码在Foxtable中怎样应用? 大家帮忙看看这段获取网络时间的VB代码在Foxtable中怎么用?
Private Sub Command1_Click()
[此贴子已经被作者于2012-12-20 18:27:40编辑过]
|
||||
-- 作者:狐狸爸爸 -- 发布时间:2012/12/20 18:22:00 -- 获取国际标准时间,记得考虑时差:
结果加上8小时,就是北京时间。 [此贴子已经被作者于2012-12-20 18:24:41编辑过]
|
||||
-- 作者:blueskyyq -- 发布时间:2012/12/20 18:24:00 -- 谢谢狐爸,参考下 |
||||
-- 作者:布莱克朱 -- 发布时间:2012/12/20 19:14:00 -- 这段代码 有问题吧 你自己测试下 在全局代码中 拷贝进去 Public Function NewTime(ByVal p1 As Date) As Date Dim obj, OBJStatus, url, GetText, i Dim Retrieval url = "http://www.baidu.com" \'判断网络是否连接 If url <> "" Then Retrieval = GetObject("winmgmts:\\\\.\\root\\cimv2") obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = \'" & Mid(url, 8) & "\'") For Each OBJStatus In obj If OBJStatus.StatusCode Is Nothing Or OBJStatus.StatusCode <> 0 Then Exit Function 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 .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) MsgBox("网络时间:" & GetText) End If End With Retrieval = Nothing OBJStatus = Nothing obj = Nothing End Function 命令窗口 Dim d As Date Output.Show(newTime(D)) 我出来的是 网络时间: 2012-12-20 11:13:37 |
||||
-- 作者:lin_hailun -- 发布时间:2012/12/20 19:26:00 -- 好用,测试都有效,收藏一下。 |
||||
-- 作者:布莱克朱 -- 发布时间:2012/12/20 19:31:00 -- 原来需要加上8 那这样改: Public Function NewTime(ByVal p1 As Date) As Date Dim obj, OBJStatus, url, GetText, i Dim Retrieval url = "http://www.baidu.com" \'判断网络是否连接 If url <> "" Then Retrieval = GetObject("winmgmts:\\\\.\\root\\cimv2") obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = \'" & Mid(url, 8) & "\'") For Each OBJStatus In obj If OBJStatus.StatusCode Is Nothing Or OBJStatus.StatusCode <> 0 Then Exit Function 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 .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) Dim d As Date = GetText d =d.AddHours(8) MsgBox("网络时间:" & d) \'MsgBox("网络时间:" & GetText) End If End With Retrieval = Nothing OBJStatus = Nothing obj = Nothing End Function 命令窗口: Dim d As Date newtime(d) |
||||
-- 作者:布莱克朱 -- 发布时间:2012/12/20 19:43:00 -- 老大自己给自己打个精华 |
||||
-- 作者:blueskyyq -- 发布时间:2012/12/20 19:56:00 -- 谢谢朱兄,精华! 狐爸别光顾着给自己精华啊,给朱兄也来个精 |
||||
-- 作者:e-png -- 发布时间:2012/12/20 19:59:00 -- 以下是引用布莱克朱在2012-12-20 19:43:00的发言:
老大自己给自己打个精华 呵呵,他说过精华是为引起重视,让人学习用。 |
||||
-- 作者:blueskyyq -- 发布时间:2012/12/20 20:02:00 -- 嗯,也能促进广大狐友答疑及分享的积极性 |