Home > Industries > Software
Http://www.im286.com/viewthread.php? Tid = 1550010 & extra = Page % 3d1
In fact, this problem is outdated and has been discussed for n times.
Among them, care4 also said twice. So if you have any problems, you 'd better search for them first. Maybe the problem has been solved.
Http://www.im286.com/viewthread...; Highlight = % 2bcare4
Http://www.im286.com/viewthread...; Highlight = % 2bcare4
Care4CodeA minor disadvantage is that components are required.
The first is. NET Component 2. No, but it is not easy to use components. Is there any way to directly obtain them using ASP?
The answer is yes.
I wrote a simple VB Winsock code.
Http://www.im286.com/viewthread... t = response. Redirect
At that time, I said that ASP could not be obtained, but I didn't mix it with csdn. Now I have done it.
First, we need to know why the XMLHTTP component cannot get such a jump address.
Use response. Redirect to jump. php contains header ("location", $ URL );
Both methods share the same principle, that is, adding a location field to the output HTTP header.
At the same time, set the returned HTTP status value to 302, And the browser will think that the page of the current request has
Moved to the specified path of location
Why can't XMLHTTP be obtained?
The reason is simple.
The XMLHTTP component is too intelligent to process 302 messages containing the location header. It directly jumps to the final page, that is ~ We cannot see the intermediate process! Bill is smart!
Fortunately, msxml4 provides a new available component: WinHTTP. winhttprequest.5.1, which is also the core of the msxml4 XMLHTTP component. WinHTTP. winhttprequest has a key attribute: option. The sixth index of this attribute indicates whether to automatically jump, then you can easily use the getResponseHeader and getAllResponseHeaders methods of the XMLHTTP component to obtain the returned HTTP header information.
Okay. Now let's look at the code.
Dim ohttp
Set ohttp = server. Createobject ("WinHTTP. winhttprequest.5.1"
Ohttp. Option (6) = 0' disable automatic redirect. The most important thing to do is simply reading data.
Ohttp. settimeouts, 'sets timeout ~ Same as the serverxmlhttp component
Ohttp. Open "get", Surl, false' open the URL in synchronous Mode
If ohttp. Status <> 200 and ohttp. Status <> 302 then
'Http. status' corresponds to the returned HTTP status. If it is 200, it indicates that this is the final page and no location jump.
'If it is 302, it indicates that the URL of the current request has been moved and needs to be redirected according to the HTTP header.
'Basically, we do not want to process the status of other values, but you can also process the status of 440 or other values by yourself!
Else
'Here we will process the returned HTTP header and document content
End if
Okay. The complete code is long.
I passed it to the space and checked it myself.
Http://test.aymtv.com/url.asp
The code in the default input column is crsky. You can test it and you will know it.
Click to viewSource codeYou can see the source code of this ASP file!
All done. Over. Continue to csdn.
complete code: the code is as follows:
<%
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
%><?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 to detect: <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="submit" />
<input type="button" value="View source code" onclick="JavaScript:window.open('<%=URLSelf%>?ViewSource');" />
</form>
<%
Public Function GetAbsoluteURL(sUrl,ByRef iStep)
Dim bUrl, bDat
If iStep>15 Then
Err.Raise vbObejctError, "Recursive error", "Recursive nesting of more than 15 layers may cause the program to crash"
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 & " Step:"
Response.Write "Ready to get" & bUrl & "<br />"
iStep=iStep+1
If bDat<>"" Then Response.Write " >>Parameter: " & bDat & "<br />"
Dim oHttp : Set oHttp=Server.CreateObject("WinHttp.WinHttpRequest.5.1")
oHttp.Option(6)=0 'Automatic Redirect is disabled, the most critical
'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"">An error occurred: " & Err.Description & "</font><br />"
Err.Clear
GetAbsoluteURL=""
Set oHttp=Nothing
Response.Write "</p>"
Exit Function
End If
On Error Goto 0
Response.Write " >>HTTP Status:" & oHttp.Status & "<br />"
If oHttp.Status<>200 And oHttp.Status<>302 Then
Response.Write "<font color=""red"">HTTP Error: " & 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 " >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"
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 "<br />"
Response.Write " >> does not return the Location header, continue to analyze the page<br />"
If oHttp.getResponseHeader("Content-Type")="text/html" Then ' is the HTML type to continue processing
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 " >>Found Refresh Address<br />"
Dim m : Set m=r.Execute(sBody)
Dim tRefUrl : tRefUrl=r.Replace(m(0).Value,"$1")
If InStr(tRefUrl,"://")<=0 Then 'No protocol specified, reset according to the location of the current URL
Dim ind1 : ind1=InstrRev(sUrl,"/")
sUrl=Left(sUrl, ind1)
tRefUrl=sUrl & tRefUrl
End If
Set r=Nothing
Set oHttp=Nothing
Response.Write " >>Prepare for analysis <u>" & tRefUrl & "</u><br />"
Response.Write "</p>"
GetAbsoluteURL=GetAbsoluteURL(tRefUrl,iStep)
Exit Function
Else
Response.Write " >> did not find Refresh Meta turn, this may be
Final 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
'To continue to analyze web content here
Else
Response.Write " >>Content-Type:" & oHttp.getResponseHeader("Content-Type") & "<br />"
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 "<br />"
Response.Write " >><u>Location : " & sLoca& "</u><br />"
Response.Write "</p>"
'Here to generate a new URL
If InStr(sLoca,"://")<=0 Then
'No protocol specified, reset according to the location of the current 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;"">The end result is: " & sAbs & "</strong> "
End If
%>
<script src="/T/mystat.asp?siteid=1"></script>
</body>
</html>
Start building with 50+ products and up to 12 months usage for Elastic Compute Service
1 on 1 presale consultation
24/7 Technical Support 6 Free Tickets per Quarter Faster Response
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.
A comprehensive suite of global cloud computing services to power your business
Payment Methods We Support
