广

ASP编程

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

    4.2 用ASP编写下载网页中所有资源的程序

    2018-05-07 10:25:03 次阅读 稿源:互联网
    零七广告

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

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

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