[会员中心]  [发布文章][发布软件]  [中文繁體] 
 文章·资料  电脑软件  手机软件  网站源码
   本 站 搜 索
[选项]
   推 荐 文 章       More...
华硕易电脑(ASUS Eee PC 1025C)驱动程序(Windows XP)安装参考(图) 华硕易电脑(ASUS Eee PC 1025C..
先来段开场白:为了外出携带方便..
Acronis True Image 使用说明 Acronis True Image 使用说明
  一款可以在Windows下使用..
Norton Ghost 使用详解 Norton Ghost 使用详解
一、分区备份   使用Ghost..
   阅 读 排 行
Windows 系统安装或备份时 ISO,GHO,WIM,ESD,PMF 都是什么文件类型 Windows 系统安装或备份时 ISO,GH..
【ISO 文件】 ISO 文件其实就..
使用“自动点击器”APP 在抖音直播间自动点赞 使用“自动点击器”APP 在抖音直..
看过抖音直播的朋友都知道,进入..
OPPO 手机的锁屏时间设置成横向显示 OPPO 手机的锁屏时间设置成横向..
第一次使用 OPPO 手机,桌面和锁..
电脑机箱(主板)前面板 USB 数据线的接线参考(图) 电脑机箱(主板)前面板 USB 数据..
  一、概述   因为每个 US..
抖音直播录屏的草稿保存位置 抖音直播录屏的草稿保存位置
抖音直播录屏,保存为“草稿”后,..
微信收到 flv 格式视频,如何播放? 微信收到 flv 格式视频,如何播放?
  微信上收到一个 flv 格式视频..
TrustAsia/DigiCert/Let s Encrypt 的免费 SSL 证书,多款网页浏览器都无法正常打开 TrustAsia/DigiCert/Let s Encryp..
云服务器安装了 Windows Server 2..
三星打印机(SCX-4521)提示“墨粉不足”设置 三星打印机(SCX-4521)提示“墨粉..
  三星打印机(SCX-4521)在添加..
文 章 信 息
用ASP编写下载网页中所有资源的程序
评论()][留言][收藏
[文章分类:电脑·手机·网络 / 网站设计·开发·优化][阅读选项
看过一篇关于下载网页中图片的文章,它只能下载以http头的图片,我做了些改进,可以下载网页中的所有连接资源,并按照网页中的目录结构建立本地目录,存放资源。

  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)
   url=url&ar(i)
  next
  url=url&str1
  url=urlhead&url
 else
  url=urlhead&str
 end if
 getvirtual=url
end function
’示例代码
dim dlpath

virtual="/downweb/"
truepath=server.MapPath(virtual)
if request("url")<> "" then
 url=request("url")
 fn=getFileName(url)
 urlhead=left(url,(instr(replace(url,"//",""),"/")+1))
 urlpath=replace(left(url,instrRev(url,"/")),urlhead,"")
 strContent = getHTTPPage(url)
 mystr=strContent
 Set objRegExp = New Regexp 
 objRegExp.IgnoreCase = True 
 objRegExp.Global = True 
 objRegExp.Pattern = "(src|href)=.[^\>]+? "
 Set Matches =objRegExp.Execute(strContent) 
 For Each Match in Matches 
  str=Match.Value
  str=replace(str,"src=","")
  str=replace(str,"href=","")
  str=replace(str,"""","")
 str=replace(str,"’","")
filename=GetfileName(str)
  getRet=getVirtual(str,urlpath,urlhead)
  temp=Replace(getRet,"//","**")
  start=instr(temp,"/")
  endt=instrRev(temp,"/")-start+1
  if start>0 then
   repl=virtual&mid(temp,start)&" "
   ’response.Write repl&"<br>"
   mystr=Replace(mystr,str,repl)

  dir=mid(temp,start,endt)
  temp=truepath&Replace(dir,"/","\")
  CreateDir(temp)
  ’response.Write getRet&"||"&temp&filename&"<br><br>"
  SaveToFile getRet,temp&filename
 end if
Next 
set Matches=nothing
end if

%> 

文章作者:未知  更新日期:2005-12-02
[文章浏览:][打印文章][发送文章
相关文章
·用ASP来发送邮件2005-12-17
·用ASP判断链接是否有效2005-12-12
·对学习,使用ASP的做网站的人的一点建议2006-05-13
·利用ASP程序来使用JMail发邮件的例子2006-05-22
·用ASP的Jmail发邮件2006-05-22
·用ASP判断某IP是否属于某网段的另类算法2006-09-07
·用ASP 按修改时间读取文件夹中文件并排序2008-03-07
·利用ASP小偷和Google实现在线翻译功能的代码2009-07-07
阅读说明
·本站大部分文章转载于网络,如有侵权请留言告知,本站即做删除处理。
·本站法律法规类文章转载自[中国政府网(www.org.cn)],相关法律法规如有修订,请浏览[中国政府网]网站。
·本站转载的文章,不为其有效性,实效性,安全性,可用性等做保证。
·如果有什么问题,或者意见建议,请联系[网站管理员]
  原“浪人文章”和“浪人下载”网站已合并为“老若尔文章软件站”,域名:https://lre.cn
  本站使用【啊估文章软件站】网站系统    网站管理员留言簿〗〖捐助     闽ICP备08009617号