【下载文档:  获取软件下载的真实地址！再谈获取Response.redirect重定向的URL.txt 】

---

获取软件下载的真实地址！再谈获取Response.redirect重定向的URL
http://www.im286.com/viewthread.php?tid=1550010&extra=page%3D1
其实这个问题落伍谈了n次了其中care4也说了两次所以如果你有问题最好先搜索一下 说不定问题早有人解决了http://www.im286.com/viewthread. ... ;highlight=%2Bcare4http://www.im286.com/viewthread. ... ;highlight=%2Bcare4care4的代码有一个小缺点 就是需要组件。第一个是.net组件 二不是 但用组件始终不太方便有没有asp直接获取的方式呢答案是有的我写的一个vb简单的winsock获取的代码http://www.im286.com/viewthread. ... t=Response.redirect当时我说用asp好像不能获得，那是当时没有去csdn混去，现在搞定了首先我们要了解为什么xmlhttp组件无法获得这样的跳转真实地址用Response.Redirect跳转，PHP里面是Header("Location",$URL);这两种方式都是一样的原理，就是在输出的HTTP头里面加上一个Location字段同时把返回的HTTP状态值设为302，浏览器就会认为当前请求的页面已经被移动到Location指定的路径那么为什么xmlhttp无法获得呢？原因很简单XMLHTTP组件在处理包含Location头的302消息时太智能了，直接给跳转到最后的页面，也就是说～我们看不到中间的过程！比尔自作聪明阿 ！不过还好MSXML4里面提供了一个可用的新的组件：WinHttp.WinHttpRequest.5.1，这个也是MSXML4 XMLHTTP组件的核心。 WinHttp.WinHttpRequest有一个十分关键的属性：Option，这个属性的第六个索引就是指示是否自动跳转，然后就可以轻松的使用XMLHTTP组件的getResponseHeader和getAllResponseHeaders方法来获取返回的HTTP头信息了。好接下来就看代码了Dim oHttp Set oHttp=Server.CreateObject("WinHttp.WinHttpRequest.5.1"oHttp.Option(6)=0 '禁止自动Redirect，最关键的 剩下的就简单读取数据都估计大家都会oHttp.SetTimeouts 5000,5000,30000,5000 '设置超时～和ServerXMLHTTP组件一样oHttp.Open "GET",sUrl,False '以同步模式打开URLIf oHttp.Status<>200 And oHttp.Status<>302 Then'oHttp.Status对应返回的HTTP状态，如果是200，表示这个就是最终页面，没有Location跳转'如果是302，表示当前请求的URL已经被移动，需要根据HTTP头来跳转'对于其他数值的状态，基本上我们不要处理，但是你要处理也可以比如 440或者别的状态你自己处理就可以了！Else '在这里对返回的HTTP头和文档内容进行处理End If好了比较完整的代码比较长我传了个到空间上自己看去http://test.aymtv.com/url.asp默认的输入栏里的代码是crsky的一个下载地址你可以测试一下就知道了点查看源代码就可以看见这个asp文件的源代码！一切搞定 over 继续去csdn混分去了完整代码：复制代码 代码如下:<%
Public Function Bytes2BSTR(v)
Dim r,i,t,n : r = ""
For i = 1 To LenB(v)
t = AscB(MidB(v,i,1))
If t < &H80 Then
r = r & Chr(t)
Else
n = AscB(MidB(v,i+1,1))
r = r & Chr(CLng(t) * &H100 + CInt(n))
i = i + 1
End If
Next
Bytes2BSTR = r
End Function
'==========================================================================================
If Request.QueryString="ViewSource" Then
Dim oFso : Set oFso=Server.CreateObject("Scripting.FileSystemObject")
Dim oFil : Set oFil=oFso.OpenTextFile(Server.MapPath("URL.Asp"))
Dim sTxt : sTxt=oFil.ReadAll()
oFil.Close : Set oFil=Nothing : Set oFso=Nothing
Response.ContentType="text/plain"
Response.Write sTxt
Response.ENd
End If
%>

要检测的URL："" THen
Response.Write Trim(Request.Form("URL"))
Else
Response.Write "http://www.crsky.com/view_down.asp?downd_id=8&downd=0&ID=20780&down=yes"
End If
%>" />

<%
Public Function GetAbsoluteURL(sUrl,ByRef iStep)
Dim bUrl,bDat
If iStep>15 Then
Err.Raise vbObejctError,"递归错误","递归嵌套超过15层可能会引起程序崩溃"
End If
If InStr(sUrl,"://")<=0 Then sUrl="http://" & sUrl
If InStr(sUrl,"?")>0 THen
Dim tmpUrl : tmpUrl=split(sUrl,"?")
bUrl=tmpUrl(0)
bDat=tmpUrl(1)
Else
bUrl=sUrl
bDat=""
End If
Response.Write "

"
Response.Write "第 " & iStep & " 步："
Response.Write "正在准备获取 " & bUrl & "
"
iStep=iStep+1
if bDat<>"" Then Response.Write " >>参数： " & bDat & "
"
Dim oHttp : Set oHttp=Server.CreateObject("WinHttp.WinHttpRequest.5.1")
oHttp.Option(6)=0 '禁止自动Redirect，最关键的
'oHttp.Option()
oHttp.SetTimeouts 5000,5000,30000,5000
oHttp.Open "GET",sUrl,False
On Error Resume Next
oHttp.Send bDat
If Err.Number<>0 Then
Response.Write "发生错误：" & Err.Description & "
"
Err.Clear
GetAbsoluteURL=""
Set oHttp=Nothing
Response.Write "

"
Exit Function
End If
On Error Goto 0
Response.Write " >>HTTP 状态：" & oHttp.Status & "
"
If oHttp.Status<>200 And oHttp.Status<>302 Then
Response.Write "HTTP错误：" & oHttp.StatusText & "
"
Err.Clear
GetAbsoluteURL=""
Set oHttp=Nothing
Response.Write "

"
Exit Function
End If
Dim sLoca
On Error Resume Next
sLoca=oHttp.getResponseHeader("Location")
If Err.Number<>0 Then
Err.Clear
sLoca=""
End If
On Error Goto 0
If sLoca = "" Then
Response.Write " >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "
"
Response.Write " >>Content-Length:"
On Error Resume Next
Response.Write oHttp.getResponseHeader("Content-Length")
If Err.Number<>0 THen Err.Clear
On Error Goto 0
Response.Write "
"
Response.Write " >>没有返回Location头，继续分析页面
"
If oHttp.getResponseHeader("Content-Type")="text/html" Then '是HTML类型才继续处理
Dim sBody : sBody=Bytes2BStr(oHttp.responseBody)
Dim r : Set r=new Regexp
r.MultiLine=True
r.Global=True
r.IgnoreCase=True
r.Pattern="]*).*$"
If r.Test(sBody) Then
Response.Write " >>发现 Refresh 地址
"
Dim m : Set m=r.Execute(sBody)
Dim tRefUrl : tRefUrl=r.Replace(m(0).Value,"$1")
If InStr(tRefUrl,"://")<=0 Then '没有指定协议，按当前URL的位置重新设置
Dim ind1 : ind1=InstrRev(sUrl,"/")
sUrl=Left(sUrl,ind1)
tRefUrl=sUrl & tRefUrl
End If
Set r=Nothing
Set oHttp=Nothing
Response.Write " >>准备分析 " & tRefUrl & "
"
Response.Write "

"
GetAbsoluteURL=GetAbsoluteURL(tRefUrl,iStep)
Exit Function
Else
Response.Write " >>没发现 Refresh Meta 转向，这可能就是最终的URL
"
GetAbsoluteURL=sUrl
Set r=Nothing
Set oHttp=Nothing
Response.Write "

"
Exit Function
End If
Else
GetAbsoluteURL=sUrl
Set oHttp=Nothing
Response.Write "

"
Exit Function
End If
'这里要继续分析网页内容
Else
Response.Write " >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "
"
Response.Write " >>Content-Length:"
On Error Resume Next
Response.Write oHttp.getResponseHeader("Content-Length")
If Err.Number<>0 THen Err.Clear
On Error Goto 0
Response.Write "
"
Response.Write " >>Location : " & sLoca& "
"
Response.Write "

"
'这里要生成新的URL
If InStr(sLoca,"://")<=0 Then
'没有指定协议，按当前URL的位置重新设置
Dim ind : ind=InstrRev(sUrl,"/")
sUrl=Left(sUrl,ind)
sLoca=sUrl & sLoca
End If
GetAbsoluteURL=GetAbsoluteURL(sLoca,iStep)
End If
End Function
If Request.Form("URL")<>"" THen
Dim iStep : iStep=1
Dim sAbs : sAbs=GetAbsoluteURL(Trim(Request.Form("URL")),iStep)
Response.Write "最终结果是：" & sAbs & ""
End If
%>