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

ASP
BytesToBstr获取的源码转换为中文的代码
PostHttpPage用asp是实现模拟登录效果的代码
asp下实现UrlEncoding转换编码的代码
GetBody asp实现截取字符串的代码
asp之GetArray提取链接地址,以$Array$分隔的代码
DefiniteUrl asp将相对地址转换为绝对地址的代码
ReplaceSaveRemoteFile 替换、保存远程图片 的代码
ReSaveRemoteFile函数之asp实现查找文件保存替换的代码
FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码
ReplaceTrim 函数之asp实现过滤掉字符中所有的tab和回车和换行的代码
CheckFile函数之asp实现检查某一文件是否存在的代码
SaveRemoteFile函数之asp实现保存远程的文件到本地的代码
FpHtmlEnCode 函数之标题过滤特殊符号的代码
GetPaing 函数之asp采集函数中用到的获取分页的代码
ScriptHtml 函数之过滤html标记的asp代码
asp实现检查目录是否存在与建立目录的函数
ShowPage 显示“上一页 下一页”等信息的封装代码
JoinChar 向地址中加入 ? 或 & 用于实现传参
CreateKeyWord asp实现的由给定的字符串生成关键字的代码
Server.Execute方法执行指定的ASP程序

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 97 ::
收藏到网摘: 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