Question

VB 获取网络时间方法

需要无控件方法获取网络时间，怎样实现？

如果不行，那无控件获取网页源码怎样实现？

以下是无控件获取网页源码，但如果网络没连接或者连接失败类情况会出现程序出错问题，怎样修改好呢？

Dim obj
Set obj = CreateObject("Microsoft.XMLHTTP")
obj.Open "GET", url, False
obj.Send
GetText = StrConv(obj.responseBody, vbUnicode)

最好能不用On Error Resume Next这类方法跳过出错。

那位高手能解答下，先谢谢了。
huajianli 他获取时窗口卡死没反应，可能是我不会用，不知道那里错了。
WWEERR 我是想无控件方法做。
ljl88900 没有回值啊~

Answer 1

下面是一个比较完整的获取网络时间的代码，自动判断网络没连接或者连接失败类情况，不用on Error Resume Next：

Private Sub Command1_Click()
Dim obj, OBJStatus, url, GetText, i
Dim Retrieval
url = "http://www.163.com"
'判断网络是否连接
If url <> "" Then
Set Retrieval = GetObject("winmgmts:\\.\root\cimv2")
Set obj = Retrieval.ExecQuery("Select * From Win32_PingStatus Where Address = '" & Mid(url, 8) & "'")
For Each OBJStatus In obj
If IsNull(OBJStatus.StatusCode) Or OBJStatus.StatusCode <> 0 Then
Exit Sub
Else
Exit For '已连接则继续
End If
Next
End If

'通过下载网页头信息获取网络时间
Set 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 Sub
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
Set Retrieval = Nothing
Set OBJStatus = Nothing
Set obj = Nothing
End Sub

Answer 2

你去下载一个叫“时间精灵”的软件

附有OCX你自己去引用。。

Answer 3

去学习NTP吧
http://baike.baidu.com/view/60648.htm?fr=ala0_1_1
必须要用Socket才行，不管是控件或API都一样

Answer 4

http://blog.csdn.net/uruseibest/archive/2006/12/20/1450397.aspx