asp获取软件下载的真实地址!再谈获取Response.redirect重定向的URL!(2)
来源:落伍者 发布时间:2010-03-10 22:03:00
asp获取软件下载的真实地址完整代码:
<%
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:<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 " >>参数: " & 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 " >>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 " >>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 " >>没有返回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 " >>发现 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 " >>准备分析 <u>" & tRefUrl & "</u><br />"
Response.Write "</p>"
GetAbsoluteURL=GetAbsoluteURL(tRefUrl,iStep)
Exit Function
Else
Response.Write " >>没发现 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 " >>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>"
'这里要生成新的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>


猜你喜欢
- 1、Python函数函数是Python为了代码最大程度的重用和最小化代码冗余而提供的基本程序结构,用于将相关功能打包并参数化Python中可
- 案例解析这个问题描述起来有点违反直觉,要执行一个文件难道不应该需要可执行权限吗?让我们先来看一个例子:# module1.pydef tes
- 【导读】亚马逊的 Alexa 的巨大成功已经证明:在不远的将来,实现一定程度上的语音支持将成为日常科技的基本要求。整合了语音识别的 Pyth
- 很多查询类的存储过程会返回一个表结构的结果集,如果在其他存储过程中需要用到这个结果集,为了避免编写重复的sql脚本,可以直接使用前者的查询结
- 前言在对着产品高举中指怒发心中之愤后,真正能够解决问题的是自身上的改变,有句话说的好:你虽然改变不了全世界,但是你有机会改变你自己。秉承着“
- 前言最近在学习vue框架的基本原理,看了一些技术博客以及一些对vue源码的简单实现,对数据代理、数据劫持、模板解析、变异数组方法、双向绑定有
- 我介绍了 Systemd 的主要命令,今天介绍如何使用它完成一些基本的任务。一、开机启动对于那些支持 Systemd 的软件,安装的时候,会
- 本文为大家分享了两段PHP分页类,很实用,供大家参考,具体内容如下<?php class Page { private $
- 1,不用第三方库# coding: utf-8import loggingBLACK, RED, GREEN, YELLOW, BLUE,
- 处理json中不带双引号key问题在解析网页json数据的时候,我发现python标准库json模块无法加载数据。如下面数据import j
- 1. 主要内容从本节开始介绍windows开发实现记事本程序的逻辑实现部分。本节的主要内容有以下3点:1. 主窗口定义 —— 主要介绍记事本
- 论坛经常有人会问到用CSS如何美化Select标签,其实但凡你看到很酷的都是用javascript来实现的。昨天试着做了一下,基本实现的初级
- 简介因为javascript默认情况下是单线程的,这意味着代码不能创建新的线程来并行执行。但是对于最开始在浏览器中运行的javascript
- numpy 中 的random模块有多个函数用于生成不同类型的随机数,常见的有 uniform、rand、random、randint、ra
- 最近看到一个词叫css reset。什么叫做css reset呢?我理解为重置css,也就是重置默认样式。我在HTML下的默认样式中讲到,一
- 什么叫模板继承呢在我的理解就是:在前端页面中肯定有很多页面中有很多相同的地方,比如页面顶部的导航栏,底部的页脚等部分,这时候如果每一个页面都
- 在当今用户的显示器越来越大的今天,之前的1024*768固宽布局有点越来越不合时宜,对大屏幕的用户而言,两侧空空的留白给人第一眼的印象是严重
- Google以其简洁的搜索框引领着互联网,搜索系统似乎成了每个网站必备品,甚至于是那些本身几乎是由静态页面组成的企业网站都要来个搜索功能,这
- 本文实例讲述了js显示动态时间的方法。分享给大家供大家参考,具体如下:Date对象的方法Date 对象能够使你获得相对于国际标准时间(格林威
- 1. 欧几里德算法欧几里德算法又称辗转相除法, 用于计算两个整数a, b的最大公约数。其计算原理依赖于下面的定理:定理: gcd(a, b)