会python真的可以为所欲为0(回)
350天前
这里还有人吗1(回)
535天前这里还有人吗0(回)
535天前
每天面对着电脑屏幕，敲打键盘。我所面对的并不只是代码，而是一种生活方式。0(回)
760天前到处都是羊，不想上班0(回)
840天前
鸽子
0(回)
844天前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 |
by: 发表于：2017-12-01 14:56:34 顶(0) | 踩(0) 回复
??
回复评论