当前位置: 首页 > 图文教程 > 网络编程 > ASP > 教你一次下载网页中的所有资源

ASP
提高SQL的执行效率的ASP的五种做法
asp的offset的一个go to page
asp中command的在单条记录时,有些字段显示为空的问题
asp,php一句话木马整理方便查找木马
asp 合并记录集并删除的sql语句
asp下循环一行多少个
asp循环行数输出函数
asp access重新开始编号
ASP生成数字相加求和的BMP图片验证码
静态页面利用JS读取cookies记住用户信息
比较详细的Asp伪静态化方法及Asp静态化探讨
asp Response.flush 实时显示进度
Asp高级故障解决以及相关代码
asp智能脏话过滤系统v1.0
ASP文件中的安全问题
Access数据库中“所有记录中均未找到搜索关键字”的解决方法
asp两组字符串数据比较合并相同数据
asp MYSQL出现问号乱码的解决方法
asp文章中随机插入网站版权文字的实现代码
ASP利用XMLHTTP实现表单提交以及cookies的发送的代码

ASP 中的 教你一次下载网页中的所有资源


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 67 ::
收藏到网摘: n/a

       看过一篇关于下载网页中图片的文章,它只能下载以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
 &nbs