附录A:
#If Win32 Then
Declare Function GetTickCount Lib "kernel32" () As Long
#Else
Declare Function GetTickCount Lib "User" () As Long
#End If
Private Sub Command1_Click()
On Error Resume Next
Dim objClient As MSXML2.ServerXMLHTTP
Dim lngStartTime As Long
Dim lngFinnishTime As Long
Dim lngOpenTime As Long
Dim lngSendTime As Long
Dim lngRespTime As Long
Dim strMessage As String
Set objClient = New MSXML2.ServerXMLHTTP
txtOpen.Text = ""
txtSend.Text = ""
txtResponse.Text = ""
objClient.setTimeouts 650, 650, 650, 650
lngStartTime = GetTickCount()
objClient.open "GET", "http://localhost:80/asp/rs.asp", False
' no failure here - the operation succeeds in 0 ms
lngFinnishTime = GetTickCount()
lngOpenTime = lngFinnishTime - lngStartTime
strMessage = CStr(lngOpenTime)
If Err.Number <> 0 Then
strMessage = strMessage & ": " & Err.Description
Err.Clear
End If
txtOpen.Text = strMessage
lngStartTime = GetTickCount()
objClient.send ' this is the operation that times out.
lngFinnishTime = GetTickCount()
lngSendTime = lngFinnishTime - lngStartTime
strMessage = CStr(lngSendTime)
If Err.Number <> 0 Then
strMessage = strMessage & ":ErrNumber-" & _
Err.Number & "|ErrDescription-" & Err.Description
Err.Clear
End If
txtSend.Text = strMessage
' this value is set to 672ms appended to a timeout error message
' example: "672: The operation timed out"
Dim respDom As MSXML2.DOMDocument
lngStartTime = GetTickCount()
Set respDom = objClient.responseXML
' no failure here - the operation succeeds in 0 ms
lngFinnishTime = GetTickCount()
lngRespTime = lngFinnishTime - lngStartTime
strMessage = CStr(lngRespTime)
If Err.Number <> 0 Then
strMessage = strMessage & ": " & Err.Description
Err.Clear
End If
txtResponse.Text = strMessage
Set objClient = Nothing
Exit Sub
ERR_HANDLER:
MsgBox Err.Description
End Sub |