大大这个代码为什么只获取一次服务器的时间啊如何修改成每次获取
请教各位大大这个代码为什么只获取一次服务器的时间啊？怎么修改成每次获取？
我在网上找的这个，代码如下，我是VB自学新手，不懂请大家多多指教下！
我现在的要求就是每次点击按钮都能获取服务器的时间！求解答！
Private Sub Command1_Click()
If MsgBox("本地时间：" + Format(Now) + vbCrLf + vbCrLf + "是否网络校时？", vbYesNo) = vbYes Then
Dim Result As String: Result = TimeChecks(TC_BOTH)
If Len(Result) > 0 Then
Date = CDate(Result): Time = CDate(Result)
MsgBox "网络时间：" + Result + vbCrLf + vbCrLf + "现在已经校准！"
Else: MsgBox "网络校时失败，请稍后再尝试！"
End If
End If
End Sub
模块如下：
Option Explicit
Public Enum TIMECHECKSFLAGS
TC_TIME = &H1&
TC_DATE = &H2&
TC_BOTH = &H3&
End Enum
Public Function TimeChecks(ByVal tcFlags As TIMECHECKSFLAGS) As String
On Error GoTo ErrLineOut
Dim XmlHttp As Object, Result As String
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
If tcFlags And TC_DATE Then
XmlHttp.Open "Get", "http://www.symental.com/time/date.asp", False
XmlHttp.send: Result = StrConv(XmlHttp.ResponseBody, vbUnicode)
End If
If tcFlags And TC_TIME Then
XmlHttp.Open "Get", "http://www.symental.com/time/time.asp", False
XmlHttp.send: Result = Result + " " + StrConv(XmlHttp.ResponseBody, vbUnicode)
End If
Set XmlHttp = Nothing: TimeChecks = Trim(Result): Exit Function
ErrLineOut:
Err.Clear: Set XmlHttp = Nothing: TimeChecks = ""
End Function
------解决方案--------------------
o(︶︿︶)o 唉，自己搞定了~
我在网上找的这个，代码如下，我是VB自学新手，不懂请大家多多指教下！
我现在的要求就是每次点击按钮都能获取服务器的时间！求解答！
Private Sub Command1_Click()
If MsgBox("本地时间：" + Format(Now) + vbCrLf + vbCrLf + "是否网络校时？", vbYesNo) = vbYes Then
Dim Result As String: Result = TimeChecks(TC_BOTH)
If Len(Result) > 0 Then
Date = CDate(Result): Time = CDate(Result)
MsgBox "网络时间：" + Result + vbCrLf + vbCrLf + "现在已经校准！"
Else: MsgBox "网络校时失败，请稍后再尝试！"
End If
End If
End Sub
模块如下：
Option Explicit
Public Enum TIMECHECKSFLAGS
TC_TIME = &H1&
TC_DATE = &H2&
TC_BOTH = &H3&
End Enum
Public Function TimeChecks(ByVal tcFlags As TIMECHECKSFLAGS) As String
On Error GoTo ErrLineOut
Dim XmlHttp As Object, Result As String
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
If tcFlags And TC_DATE Then
XmlHttp.Open "Get", "http://www.symental.com/time/date.asp", False
XmlHttp.send: Result = StrConv(XmlHttp.ResponseBody, vbUnicode)
End If
If tcFlags And TC_TIME Then
XmlHttp.Open "Get", "http://www.symental.com/time/time.asp", False
XmlHttp.send: Result = Result + " " + StrConv(XmlHttp.ResponseBody, vbUnicode)
End If
Set XmlHttp = Nothing: TimeChecks = Trim(Result): Exit Function
ErrLineOut:
Err.Clear: Set XmlHttp = Nothing: TimeChecks = ""
End Function
------解决方案--------------------
o(︶︿︶)o 唉，自己搞定了~