用ASP编写下载网页中所有资源的程序
精贴
置顶
2462
0
看过一篇关于下载网页中图片的文章，它只能下载以http头的图片，我做了些改进，可以下载网页中的所有连接资源，并按照网页中的目录结构建立本地目录，存放资源。
download.asp?url=你要下载的网页
download.asp代码如下：
download.asp?url=你要下载的网页
download.asp代码如下：
＜%
Server.ScriptTimeout=9999
function SaveToFile(from,tofile)
on error resume next
dim geturl,objStream,imgs
geturl=trim(from)
Mybyval=getHTTPstr(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
if err.number＜＞0 then err.Clear
end function
function geturlencodel(byval url)'中文文件名转换
Dim i,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Url,i,1))
if code＜0 Then code = code + 65536
If code＞255 Then
geturlencodel=geturlencodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
else
geturlencodel=geturlencodel&mid(Url,i,1)
end if
next
end function
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate＜＞4 then exit function
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number＜＞0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i,ThisCharCode,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode ＜ &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
function getFileName(byval filename)
if instr(filename,"/")＞0 then
fileExt_a=split(filename,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
if instr(getFileName,"?")＞0 then
getFileName=left(getFileName,instr(getFileName,"?")-1)
end if
else
getFileName=filename
end if
end function
function getHTTPstr(url)
on error resume next
dim http
set http=server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate＜＞4 then exit function
getHTTPstr=Http.responseBody
set http=nothing
if err.number＜＞0 then err.Clear
end function
Function CreateDIR(ByVal LocalPath) '建立目录的程序，如果有多级目录，则一级一级的创建
On Error Resume Next
LocalPath = Replace(LocalPath, "\", "/")
Set FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPath, "/")
path_level = UBound(patharr)
For I = 0 To path_level
If I = 0 Then pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmp, Len(pathtmp) - 1)
If Not FileObject.FolderExists(cpath) Then FileObject.CreateFolder cpath
Next
Set FileObject = Nothing
If Err.Number ＜＞ 0 Then
CreateDIR = False
Err.Clear
Else
CreateDIR = True
End If
End Function
function GetfileExt(byval filename)
fileExt_a=split(filename,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
end function
function getvirtual(str,path,urlhead)
if left(str,7)="http://" then
url=str
elseif left(str,1)="/" then
start=instrRev(str,"/")
if start=1 then
url="/"
else
url=left(str,start)
end if
url=urlhead&url
elseif left(str,3)="../" then
str1=mid(str,inStrRev(str,"../")+2)
ar=split(str,"../")
lv=ubound(ar)+1
ar=split(path,"/")
url="/"
for i=1 to (ubound(ar)-lv)<
今日天气
···
···
···
···
近一月回答榜 - TOP 12
wuxuxiao
钻石VIP
qwe2466985
超级会员
yu_rebecca
黄金会员
wuxiao2882
青铜会员
a448155162
普通会员
messi
普通会员
85xinxi
普通会员
fushang369
普通会员
wawa512com
普通会员
zhuangjunhua
普通会员
ucase
普通会员
xuchunyun
普通会员
博客标签
- 热门排行
- CSS cursor鼠标样式一览表 2012-06-25
- .NET后台写JS代码 2011-11-03
- 网站地址多出jdfwkey的问题解析及... 2010-08-25
- 数据库xxx的日志已满,请备份该数... 2013-07-19
- 百度、google、Yahoo网站地图制作... 2011-01-30
- <a>标签的伪类书写顺序问题... 2010-09-04
- 什么是长尾关键词？ 2010-09-24
- CEO名言 2010-08-31
- Mysql 主从数据库同步 2010-09-12
- 用ASP实现网页BBS 2010-11-01
- 博主推荐
- 本个人博客微信公众平台上线啦~~... 2013-10-13
- 饼哥网络互联上线啦~~要买域名空... 2013-09-20
- 网站title标题如何正确修改不会被... 2013-08-26
- 饼哥通讯录系统上线啦，欢迎大家... 2013-08-24
- ASP .NET MYSQL 的简单分页 并不... 2013-08-19
- 网站有弹窗广告这样的站点，百度... 2013-08-17
- 做淘宝SEO优化需要注意的8大问题 2013-08-17
- 淘宝网怎么做SEO优化 2013-08-17
- 站长们要学习的“苍井空精神” 2013-08-17
- 苹果公司今日发布了iOS 7第五个开... 2013-08-07
- 随便看看
- 点后退按钮显示"网页已经过期" 2013-09-06
- 用cssText批量修改样式 2010-09-05
- Java base64 编码和解码案例 2013-06-26
- 如何使用标签阻止网页被收录？ 2010-09-30
- 基于DOS命令的批处理 2010-11-06
- IE6 li:hover兼容问题 2010-09-06
- ASP.NET不用设置iis .net 实现ur... 2010-09-13
- js表单不能为空或全为空格 2010-09-12
- css优先级和！important与ie6的B... 2010-08-31
- 整型数据 2010-10-16
- RSS新闻
- 传媒新闻
- CSDN
- 八卦新闻
- 女性新闻
- 台湾新闻
- 互联网
- 军事-新浪博客
- IT-新浪博客
- 汽车新闻
- 游戏新闻
- 国际新闻
- 国内新闻
- 体育新闻
- 我的微博
北京
上海
杭州
深圳
广州
成都