用Msxml2.XMLHTTP 与 Msxml2.ServerXMLHTTP 发生网页请求

发送 HTTP 请求时，首先想到的一般是 Msxml2.XMLHTTP（Microsoft.XMLHTTP 已经不提倡使用了）。

ServerXMLHTTP 为不同 Web 服务器之间的服务器安全 HTTP 访问提供方法和属性。您可以使用此对象在不同的 Web 服务器之间交换 XML 数据。

ServerXMLHTTP 随 Microsoft XML Parser (MSXML) 版本 3.0 或更高版本提供。

由于 XMLHTTP 内部使用 WinInet，所以不支持在服务器端应用程序（例如 Active Server Pages (ASP)）、宿主在 COM+ 中的组件，或 Windows 服务中使用 XMLHTTP。

XMLHTTP 为客户端应用程序而设计，并依赖于基于 Microsoft Win32 Internet (WinInet) 而构建的 URLMon。ServerXMLHTTP 为服务器应用程序而设计，并依赖于新的 HTTP 客户端堆栈 WinHTTP。ServerXMLHTTP 提供了可靠性和安全性，并且是服务器安全的。

ServerXMLHTTP 推荐用于服务器应用程序，而 XMLHTTP 推荐用于客户端应用程序。

在大部分情况下，Msxml2.XMLHTTP 能够很好地完成工作，因为它是有缓存的。比如，我们用 Msxml2.XMLHTTP 发送 HTTP POST 请求模拟登陆了某个网站，它会把登陆时的 Cookie 和 Session 缓存下来，当我们想获取网站的数据时直接 HTTP GET 就行了，不需要人工发送 Cookie 和 Session。

但是，在有些时候，缓存会给我们造成麻烦。比如我们要写一个 VBS 脚本暴力破解某个网站的账号，假设我们已经破解了一个账号，继续破解时，由于缓存的关系，网站会认为我们已经登陆了，这样会干扰我们判断账号是否破解成功。也就是说，当成功破解一个账号后，需要多加几行代码登出这个账号。在这种情况下，就应该使用没有缓存的 Msxml2.ServerXMLHTTP。

总结一下就是，如果需要缓存，则用 Msxml2.XMLHTTP；否则应该用 Msxml2.ServerXMLHTTP。

简单的发送Get请求方法

Public Function getWeb(ByVal url As String) As String
On Error GoTo ErrHandle

    If Len(url) > 4 And LCase(Left(url, 4)) = "http" Then
        Dim x As XMLHTTP
        Set x = New XMLHTTP
        x.Open "GET", url, False
        x.send
        getWeb = x.responseText
    Else
        getWeb = ""
    End If
   
    Exit Function
ErrHandle:
   
    getWeb = ""
End Function

下面是可以设定超时时间的请求类
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "serverXMLHTTP_Class"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'///////////////////////CODE BY ENVON,goojjie@163.com//////////////////////////////////////
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Http
Private Sub wait(tt)
    Dim t, t1, t2, i
    t = tt
    If t > 10 Then
        t1 = Int(t / 10)
        t2 = t - t1 * 10
        For i = 1 To t1
        Call Sleep(10)
        DoEvents
        Next i
        If t2 > 0 Then Call Sleep(t2)
    Else
        If t > 0 Then Call Sleep(t)
    End If
End Sub

Public Function GetCode(ByVal gUrl As String, pm, Optional gRef, Optional gCok)
    On Error Resume Next
    If LCase(left(gUrl, 4)) <> "http" Then gUrl = "http://" & gUrl
    Http.Open "GET", gUrl, True
    If gRef <> "" Then Http.SetRequestHeader "Referer", gRef
    If gCok <> "" Then Http.SetRequestHeader "Cookie", gCok
    Http.Send
    Dim waitTimeOut, secondNumber
    waitTimeOut = 0
    secondNumber = 30 '超时多少秒
    Do
    DoEvents
    wait 10
    waitTimeOut = waitTimeOut + 1
    Loop Until (Http.ReadyState = 4 Or waitTimeOut >= 100 * secondNumber)
    If Http.ReadyState = 4 Then
        GetCode = BytesToBstr(Http.ResponseBody, pm)
    Else
        GetCode = ""
    End If
End Function

Public Function PostData(PostUrl, PostStr, PostCok, PostRef, pm, Optional header)
    On Error Resume Next
    If LCase(left(PostUrl, 4)) <> "http" Then PostUrl = "http://" & PostUrl
    If PostCok = "" Then PostCok = "ASPSESSIONIDAQACTAQB=HKFHJOPDOMAIKGMPGBJJDKLJ;"
    PostCok = Replace(PostCok, Chr(32), "%20")
    With Http
        .Open "POST", PostUrl, True
        .SetRequestHeader "Content-Length", Len(PostStr)
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .SetRequestHeader "Referer", PostRef
        .SetRequestHeader "Cookie", PostCok
        .Send PostStr
    End With
    Dim waitTimeOut, secondNumber
    waitTimeOut = 0
    secondNumber = 30 '超时多少秒
    Do
    DoEvents
    wait 10
    waitTimeOut = waitTimeOut + 1
    Loop Until (Http.ReadyState = 4 Or waitTimeOut >= 100 * secondNumber)
    If Http.ReadyState = 4 Then
        PostData = BytesToBstr(Http.ResponseBody, pm)
    Else
        PostData = ""
    End If
    header = Http.getAllResponseHeaders()
End Function

Private Function BytesToBstr(body, Cset)
    On Error Resume Next
    Dim objstream
    Set objstream = CreateObject("adodb.stream")
    objstream.Type = 1
    objstream.mode = 3
    objstream.Open
    objstream.write body
    objstream.Position = 0
    objstream.Type = 2
    objstream.Charset = Cset
    BytesToBstr = objstream.ReadText
    objstream.Close
    Set objstream = Nothing
End Function

Private Sub Class_Initialize()
    Set Http = CreateObject("Msxml2.XMLHTTP")
End Sub

Private Sub Class_Terminate()
    Set Http = Nothing
End Sub