Excel 请问如何修改xmlhttp头协议中的cookie值
1个回答
展开全部
代码:
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
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
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询