利用XMLHTTP检测URL及探测服务器信息

Option Explicit

Private XmlHTTP As New XMLHTTPRequest
Private vUrl As String
Private vNumber As String
Private vDescription As String
Private vSource As String

Public Sub Connect()

On Error GoTo ErrorHandle:

XmlHTTP.Open \"Get\", Url, False
XmlHTTP.send

ErrorHandle:
Call GetErrorHeadle(XmlHTTP)
End Sub

Private Sub GetErrorHeadle(ByRef XmlHTTP As XMLHTTPRequest)
If XmlHTTP.readyState <> 4 Then
Exit Sub
End If

If XmlHTTP.Status = 404 Then
Number = \"404\"
Description = \"该网页不存在\"
ElseIf XmlHTTP.Status < 200 Then
Number = XmlHTTP.Status
Description = \"客户端错误，信息：\" & CStr(XmlHTTP.Status) & \" \" & XmlHTTP.statusText
ElseIf XmlHTTP.Status < 300 Then
Number = XmlHTTP.Status
Description = \"成功，该网页能访问。\"
ElseIf XmlHTTP.Status < 400 Then
Number = XmlHTTP.Stauts
Description = \"重定向，信息：\" & CStr(XmlHTTP.Status) & \" \" & XmlHTTP.statusText
ElseIf XmlHTTP.Status < 500 Then
Number = XmlHTTP.Status
Description = \"客户端错误，信息：\" & CStr(XmlHTTP.Status) & \" \" & XmlHTTP.statusText
ElseIf XmlHTTP.Status < 600 Then
Number = XmlHTTP.Status
Description = \"服务器错误，信息：\" & CStr(XmlHTTP.Status) & \" \" & XmlHTTP.statusText
Else
Number = XmlHTTP.Status
Description = \"域名不可用或网络连接错误，信息：\" & CStr(XmlHTTP.Status) & \" \" & XmlHTTP.statusText
End If

If XmlHTTP.Status < 600 Then Call GetHTTPServer
End Sub

Private Sub GetHTTPServer()
Dim XmlServer As String
XmlServer = XmlHTTP.getResponseHeader(\"Server\")
If XmlServer <> \"\" Then
Source = Source & \"HTTP服务器：\" & XmlServer
End If
Source = Source & \"所有反馈信息：\" & XmlHTTP.getAllResponseHeaders
End Sub

Public Property Get Number() As String
Number = vNumber
End Property
Public Property Let Number(ByVal Val As String)
vNumber = Val
End Property

Public Property Get Description() As String
Description = vDescription
End Property
Public Property Let Description(ByVal Val As String)
vDescription = Val
End Property

Public Property Get Url() As String
Url = vUrl
End Property
Public Property Let Url(ByVal Val As String)
vUrl = Val
End Property

Public Property Get Source() As String
Source = vSource
End Property
Private Property Let Source(ByVal Val As String)
vSource = Val
End Property