广

ASP编程

  • IOS开发
  • android开发
  • PHP编程
  • JavaScript
  • ASP.NET
  • ASP编程
  • JSP编程
  • Java编程
  • 易语言
  • Ruby编程
  • Perl编程
  • AJAX
  • 正则表达式
  • C语言
  • 编程开发

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

    2018-05-04 21:20:52 次阅读 稿源:互联网
    零七广告

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

    零七网部分新闻及文章转载自互联网,供读者交流和学习,若有涉及作者版权等问题请及时与我们联系,以便更正、删除或按规定办理。感谢所有提供资讯的网站,欢迎各类媒体与零七网进行文章共享合作。

    零七广告
    零七广告
    零七广告
    零七广告