请教各位大侠XMLHTTP如何取COOKIES

可以设置cookies的

编码ing...

终于写好了。我只是把获取到的body输出了。关于要提取什么信息由你自己定制

代码：

baidu.asp

<%

Session.Timeout=30

if session("login")<>1 then

response.write getHTTP("http://www2.baidu.com/user/user.php","")

session("login")=1

response.end

else

body=getHTTP("http://www2.baidu.com/user/user.php",Request.form&"")

if instr(body,"欢迎访问百度竞价排名客户管理系统")<1 then

Session.Abandon

response.write "<meta http-equiv=""Refresh"" content=""0"" />"

response.end

end if

response.write server.htmlencode(body)

end if

Function getHTTP(url,sendStr)

'on error resume next

set Http=server.createobject("Msxml2.ServerXMLHTTP")

Http.setTimeouts 5000,5000,20000,20000

if sendStr <>"" then

Http.open "POST",url,false

Http.setRequestHeader "Content-Type","application/x-www-form-urlencoded"

Http.setRequestHeader "Accept","image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/msword, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/x-shockwave-flash, */*"

else

Http.open "GET",url,false

end if

if session("lastUrl")<>"" then Http.setRequestHeader "Referer",session("lastUrl")

if session("cookie")<>"" then Http.setRequestHeader "Cookie",session("cookie")

Http.send(sendStr)

cookies=RegExpSub("Set\-Cookie:\s?(.*?)", http.GetAllResponseHeaders,"")

if session("cookie")="" then

session("cookie")=cookies

else

session("cookie")=old_new_cookie(session("cookie"),cookies)

end if

getHTTP=BytesToBstr(Http.responsebody)

set http=nothing

if err.number<>0 then err.clear

End Function

Function BytesToBstr(vIn)

dim strReturn

dim i1,ThisCharCode,NextCharCode

strReturn = ""

For i1 = 1 To LenB(vIn)

ThisCharCode = AscB(MidB(vIn,i1,1))

If ThisCharCode <&H80 Then

strReturn = strReturn &Chr(ThisCharCode)

Else

NextCharCode = AscB(MidB(vIn,i1+1,1))

strReturn = strReturn &Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))

i1 = i1 + 1

End If

Next

BytesToBstr = strReturn

End Function

Function old_new_cookie(old_cookie,cookies)

dim i,j,cookie,g_cookie,flag

cookie=split(cookies,"")

g_cookie=split(old_cookie,"")

for i=lbound(cookie) to ubound(cookie)

flag=1

if cookie(i)<>"" then

for j=lbound(g_cookie) to ubound(g_cookie)

if g_cookie(j)<>"" then

if left(g_cookie(j),instr(g_cookie(j),"="))=left(cookie(i),instr(cookie(i),"=")) then g_cookie(j)=cookie(i):flag=0

end if

next

if flag then old_new_cookie=old_new_cookie&""&cookie(i)

end if

next

for j=lbound(g_cookie) to ubound(g_cookie)

if g_cookie(j)<>"" then old_new_cookie=old_new_cookie&""&g_cookie(j)

next

if len(old_new_cookie)>2 then old_new_cookie=right(old_new_cookie,len(old_new_cookie)-2)

End Function

Function RegExpSub(patrn, strng,split_s)

RegExpSub =""

Dim regEx, Match, Matches

Set regEx = New RegExp

regEx.Pattern = patrn

regEx.IgnoreCase = True

regEx.Global = True

Set Matches = regEx.Execute(strng)

For Each Match in Matches

RetStr = RetStr &""&Match.SubMatches.item(0)

Next

if len(RetStr)>len(split_s) then RegExpSub = right(RetStr,len(RetStr)-len(split_s))

End Function

%>

Function getHTTP(url,sendStr)

'on error resume next

set Http=server.createobject("Msxml2.ServerXMLHTTP")

Http.setTimeouts 5000,5000,20000,20000

if sendStr <>"" then

Http.open "POST",url,false

Http.setRequestHeader "Content-Type","application/x-www-form-urlencoded"

Http.setRequestHeader "Accept","image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/msword, application/vnd.ms-excel, application/vnd.ms-powerpoint, application/x-shockwave-flash, */*"

else

Http.open "GET",url,false

end if

if session("lastUrl")<>"" then Http.setRequestHeader "Referer",session("lastUrl")

if session("cookie")<>"" then Http.setRequestHeader "Cookie",session("cookie")

Http.send(sendStr)

cookies=RegExpSub("Set\-Cookie:\s?(.*?)", http.GetAllResponseHeaders,"")

if session("cookie")="" then

session("cookie")=cookies

else

session("cookie")=old_new_cookie(session("cookie"),cookies)

end if

getHTTP=BytesToBstr(Http.responsebody)

set http=nothing

if err.number<>0 then err.clear

End Function

---