擷取軟體下載的真真實位址!再談擷取Response.redirect重新導向的URL

來源:互聯網
上載者:User

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 Thenr = r & Chr(t)Elsen = AscB(MidB(v,i+1,1))r = r & Chr(CLng(t) * &H100 + CInt(n))i = i + 1End IfNextBytes2BSTR = rEnd Function'==========================================================================================If Request.QueryString="ViewSource" ThenDim 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=NothingResponse.ContentType="text/plain"Response.Write sTxtResponse.ENdEnd 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")<>"" THenResponse.Write Trim(Request.Form("URL"))ElseResponse.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,bDatIf iStep>15 ThenErr.Raise vbObejctError,"遞迴錯誤","遞迴嵌套超過15層可能會引起程式崩潰"End IfIf InStr(sUrl,"://")<=0 Then sUrl="http://" & sUrlIf InStr(sUrl,"?")>0 THenDim tmpUrl : tmpUrl=split(sUrl,"?")bUrl=tmpUrl(0)bDat=tmpUrl(1)ElsebUrl=sUrlbDat=""End IfResponse.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+1if bDat<>"" Then Response.Write "  >>參數: " & bDat & "<br />"Dim oHttp : Set oHttp=Server.CreateObject("WinHttp.WinHttpRequest.5.1")oHttp.Option(6)=0'禁止自動Redirect,最關鍵的'oHttp.Option()oHttp.SetTimeouts 5000,5000,30000,5000oHttp.Open "GET",sUrl,FalseOn Error Resume NextoHttp.Send bDatIf Err.Number<>0 ThenResponse.Write "<font color=""red"">發生錯誤:" & Err.Description & "</font><br />"Err.ClearGetAbsoluteURL=""Set oHttp=NothingResponse.Write "</p>"Exit FunctionEnd IfOn Error Goto 0Response.Write "  >>HTTP 狀態:" & oHttp.Status & "<br />"If oHttp.Status<>200 And oHttp.Status<>302 ThenResponse.Write "<font color=""red"">HTTP錯誤:" & oHttp.StatusText & "</font><br />"Err.ClearGetAbsoluteURL=""Set oHttp=NothingResponse.Write "</p>"Exit FunctionEnd IfDim sLoca On Error Resume NextsLoca=oHttp.getResponseHeader("Location")If Err.Number<>0 ThenErr.ClearsLoca=""End IfOn Error Goto 0If sLoca = "" ThenResponse.Write "  >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"Response.Write "  >>Content-Length:" On Error Resume NextResponse.Write oHttp.getResponseHeader("Content-Length")If Err.Number<>0 THen Err.ClearOn Error Goto 0Response.Write "<br />"Response.Write "  >>沒有返回Location頭,繼續分析頁面<br />"If oHttp.getResponseHeader("Content-Type")="text/html" Then'是HTML類型才繼續處理Dim sBody : sBody=Bytes2BStr(oHttp.responseBody)Dim r : Set r=new Regexpr.MultiLine=Truer.Global=Truer.IgnoreCase=Truer.Pattern="<meta.+http\-equiv\=\""refresh\"".+content=\""[^\;]+;url\=([^\""\s\>]*).*$"If r.Test(sBody) ThenResponse.Write "  >>發現 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 & tRefUrlEnd IfSet r=NothingSet oHttp=NothingResponse.Write "  >>準備分析 <u>" & tRefUrl & "</u><br />"Response.Write "</p>"GetAbsoluteURL=GetAbsoluteURL(tRefUrl,iStep)Exit FunctionElseResponse.Write "  >>沒發現 Refresh Meta 轉向,這可能就是最終的URL<br />"GetAbsoluteURL=sUrlSet r=NothingSet oHttp=NothingResponse.Write "</p>"Exit FunctionEnd IfElseGetAbsoluteURL=sUrlSet oHttp=NothingResponse.Write "</p>"Exit FunctionEnd If'這裡要繼續分析網頁內容ElseResponse.Write "  >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"Response.Write "  >>Content-Length:" On Error Resume NextResponse.Write oHttp.getResponseHeader("Content-Length")If Err.Number<>0 THen Err.ClearOn Error Goto 0Response.Write "<br />"Response.Write "  >><u>Location : " & sLoca& "</u><br />"Response.Write "</p>"'這裡要產生新的URLIf InStr(sLoca,"://")<=0 Then'沒有指定協議,按當前URL的位置重新設定Dim ind : ind=InstrRev(sUrl,"/")sUrl=Left(sUrl,ind)sLoca=sUrl & sLocaEnd IfGetAbsoluteURL=GetAbsoluteURL(sLoca,iStep)End IfEnd FunctionIf Request.Form("URL")<>"" THenDim iStep : iStep=1Dim 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>

相關文章

Alibaba Cloud 10 Year Anniversary

With You, We are Shaping a Digital World, 2009-2019

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。