用户注册



邮箱:

密码:

用户登录


邮箱:

密码:
记住登录一个月忘记密码?

发表随想


还能输入:200字
云代码 - vb代码库

===

2020-02-09 作者: 小红军举报

[vb]代码库

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
 
    下列代码利用上述NetTime函数,可以将本机时间同步到标准时间,误差一般不超过1秒,如果多次运行或加上网络延时校正代码可进一步减少误差。
 
    运行代码后,可以用时间精灵控件或到http://www.time.ac.cn/stime.asp网站查看本机时间与标准时间的误差以验证代码的效果,当然更可以用时间精灵来校正你的电脑时间,这样误差将不超过0.1秒!这是VB中用Time语句设定本机时间无法实现的,因为Time语句的“分辨率”只能达到整秒。
 
Sub UpDateTime()
 
    Dim sTime as String
 
    sTime=NetTime()
 
    On Error Resume Next
 
    If Stime<>"" Then
 
        Time=sTime
 
        Date=sTime
 
    End If
 
End Sub


网友评论    (发表评论)


发表评论:

评论须知:

  • 1、评论每次加2分,每天上限为30;
  • 2、请文明用语,共同创建干净的技术交流环境;
  • 3、若被发现提交非法信息,评论将会被删除,并且给予扣分处理,严重者给予封号处理;
  • 4、请勿发布广告信息或其他无关评论,否则将会删除评论并扣分,严重者给予封号处理。


扫码下载

加载中,请稍后...

输入口令后可复制整站源码

加载中,请稍后...