发送 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