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

发布时间：2023-07-20 14:42:46 所属栏目：Asp教程来源：

导读：看过一篇关于下载网页中图片的文章，它只能下载以http头的图片，我做了些改进，可以下载网页中的所有连接资源，并按照网页中的目录结构建立本地目录，存放资源。

　　download.asp?url=你要下载的网页

　　d

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

%＞

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!