| 
 附录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  |