首页 > 编程 > ASP > 正文

获取软件下载的真实地址!再谈获取Response.redirect重定向的URL

2020-07-27 13:29:26
字体:
来源:转载
供稿:网友

http://www.im286.com/viewthread.php?tid=1550010&extra=page%3D1

其实这个问题落伍谈了n次了
其中care4也说了两次所以如果你有问题最好先搜索一下 说不定问题早有人解决了
http://www.im286.com/viewthread. ... ;highlight=%2Bcare4
http://www.im286.com/viewthread. ... ;highlight=%2Bcare4
care4的代码有一个小缺点 就是需要组件。
第一个是.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       '以同步模式打开URL
If 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 = rEnd 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%><?xml version="1.0" encoding="gb2312" standalone="yes"?><!doctype html public "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns:v="http://www.eglic.com/">	<head>		<title></title>		<meta name="Generator" content="EditPlus" />		<meta name="Author" content="eglic" />		<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />		<meta name="CharSet" content="GB2312" />		<link rel="stylesheet" type="text/css" href="/styles/default.css" />		<style type="text/css">			@media all{							}		</style>		<script language="javascript" src="/scripts/default.js"></script>		<script language="javascript" src="/scripts/xml.js"></script>		<script language="javascript">//<!--					//--></script>	</head>	<body>		<form action="" method="POST">			要检测的URL:<input type="text" name="URL" size="50" value="<%				If Request.Form("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			%>" />			<input type="submit" value="提交" />			<input type="button" value="查看源代码" onclick="JavaScript:window.open('<%=URLSelf%>?ViewSource');" />		</form>		<%			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 "<p style=""border:solid 1px silver;border-top:solid 2px red;padding:5px;margin:2px;"">"				Response.Write "第 " & iStep & " 步:"				Response.Write "正在准备获取 " & bUrl & "<br />"				iStep=iStep+1				if bDat<>"" Then Response.Write "&nbsp;&nbsp;>>参数: " & bDat & "<br />"				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 "<font color=""red"">发生错误:" & Err.Description & "</font><br />"						Err.Clear						GetAbsoluteURL=""						Set oHttp=Nothing						Response.Write "</p>"						Exit Function					End If				On Error Goto 0					Response.Write "&nbsp;&nbsp;>>HTTP 状态:" & oHttp.Status & "<br />"					If oHttp.Status<>200 And oHttp.Status<>302 Then						Response.Write "<font color=""red"">HTTP错误:" & oHttp.StatusText & "</font><br />"						Err.Clear						GetAbsoluteURL=""						Set oHttp=Nothing						Response.Write "</p>"						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 "&nbsp;&nbsp;>>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"						Response.Write "&nbsp;&nbsp;>>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 "<br />"						Response.Write "&nbsp;&nbsp;>>没有返回Location头,继续分析页面<br />"						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="<meta.+http/-equiv/=/""refresh/"".+content=/""[^/;]+;url/=([^/""/s/>]*).*$"							If r.Test(sBody) Then								Response.Write "&nbsp;&nbsp;>>发现 Refresh 地址<br />"								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 "&nbsp;&nbsp;>>准备分析 <u>" & tRefUrl & "</u><br />"								Response.Write "</p>"								GetAbsoluteURL=GetAbsoluteURL(tRefUrl,iStep)								Exit Function							Else								Response.Write "&nbsp;&nbsp;>>没发现 Refresh Meta 转向,这可能就是最终的URL<br />"								GetAbsoluteURL=sUrl								Set r=Nothing								Set oHttp=Nothing								Response.Write "</p>"								Exit Function							End If						Else							GetAbsoluteURL=sUrl							Set oHttp=Nothing							Response.Write "</p>"							Exit Function						End If						'这里要继续分析网页内容					Else						Response.Write "&nbsp;&nbsp;>>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"						Response.Write "&nbsp;&nbsp;>>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 "<br />"						Response.Write "&nbsp;&nbsp;>><u>Location : " & sLoca& "</u><br />"						Response.Write "</p>"						'这里要生成新的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 "<strong style=""color:white;background-color:red;font-size:15px;padding:3px;margin:10px;"">最终结果是:" & sAbs & "</strong>"			End If		%>	<script src="/T/mystat.asp?siteid=1"></script>	</body></html>

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表