Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

获取网络时间实例

时 间:2014-01-18 13:16:37
作 者:杜超-2号   ID:16058  城市:江阴
摘 要:计算机的时间不准,或其它原因我们需要从网络中获得准确的时间和日期,以此做了个简单示例
正 文:

点击下载此附件

 

Function NetTime(Optional url As String) As String  '返回包括时间和日期的字符串

   Dim obj, OBJStatus,  Retrieval  

   Dim GetText As String

   Dim i As Long   

   Dim myDate As Date

   Set Retrieval = CreateObject("Microsoft.XMLHTTP")  

    If url = "" Then      

            url = "http://www.time.ac.cn/stime.asp" '从国家授时中心网页获取时间

    End If

   '通过下载网页头信息获取网络时间

   On Error Goto ToExit       

   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)

                myDate = GetText '字符串变为时间类型

                myDate = myDate + #8:00:00 AM#   '将时间转化为北京时间

                NetTime = myDate  '将时间转化为字符串

            End If

        End With

ToExit:

    Set Retrieval = Nothing

    Set OBJStatus = Nothing

    Set obj = Nothing

End Function



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助