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

1、ASP教程之用ASP编写下载网页中所有资源的程序 看过一篇关于下载网页中图片的文章，它只能下载以http头的图片，我做了些改进，可以下载网页中的所有连接资源，并按照网页中的目录结构建立本地目录，存放资源。 download.asp?url=你要下载的网页download.asp代码如下：% Server.ScriptTimeout=9999function SaveToFile(from,tofile)on error resume nextdim geturl,objStream,imgsgeturl=trim(from)Mybyval=getHTTPstr(geturl)Set objSt

2、ream = Server.CreateObject(ADODB.Stream)objStream.Type =1objStream.Openobjstream.write Mybyvalobjstream.SaveToFile tofile,2objstream.Close()set objstream=nothingif err.number0 then err.Clearend functionfunction geturlencodel(byval url)中文文件名转换Dim i,codegeturlencodel=if trim(Url)= then exit functionfo

3、r i=1 to len(Url)code=Asc(mid(Url,i,1)if code0 Then code = code + 65536If code255 Thengeturlencodel=geturlencodel&%&Left(Hex(Code),2)&%&Right(Hex(Code),2) elsegeturlencodel=geturlencodel&mid(Url,i,1)end if nextend functionfunction getHTTPPage(url)on error resume nextdim httpset http=Server.createobj

4、ect(Msxml2.XMLHTTP)Http.open GET,url,falseHttp.send()if Http.readystate4 then exit functiongetHTTPPage=bytes2BSTR(Http.responseBody)set http=nothing if err.number0 then err.Clearend functionFunction bytes2BSTR(vIn)dim strReturndim i,ThisCharCode,NextCharCodestrReturn = For i = 1 To LenB(vIn)ThisChar

5、Code = AscB(MidB(vIn,i,1)If ThisCharCode &H80 ThenstrReturn = strReturn & Chr(ThisCharCode)ElseNextCharCode = AscB(MidB(vIn,i+1,1)strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode) i = i + 1End IfNextbytes2BSTR = strReturnEnd Functionfunction getFileName(byval filename)if in

6、str(filename,/)0 thenfileExt_a=split(filename,/)getFileName=lcase(fileExt_a(ubound(fileExt_a)if instr(getFileName,?)0 thengetFileName=left(getFileName,instr(getFileName,?)-1)end ifelsegetFileName=filenameend ifend functionfunction getHTTPstr(url)on error resume nextdim httpset http=server.createobje

7、ct(MSXML2.XMLHTTP)Http.open GET,url,falseHttp.send() if Http.readystate4 thenexit functiongetHTTPstr=Http.responseBodyset http=nothingif err.number0 thenerr.Clear end functionFunctionCreateDIR(ByVal LocalPath) 建立目录的程序，如果有多级目录，则一级一级的创建On Error Resume NextLocalPath = Replace(LocalPath, , /)Set FileObj

8、ect = server.CreateObject(Scripting.FileSystemObject)patharr = Split(LocalPath, /)path_level = UBound(patharr)For I = 0 To path_levelIf I = 0 Thenpathtmp = patharr(0) & / Elsepathtmp = pathtmp & patharr(I) & / cpath = Left(pathtmp, Len(pathtmp) - 1) If Not FileObject.FolderExists(cpath) Then FileObj

9、ect.CreateFoldercpath NextSet FileObject = NothingIf Err.Number 0 ThenCreateDIR = False Err.ClearElseCreateDIR = True End IfEnd Functionfunction GetfileExt(byval filename)fileExt_a=split(filename,.)GetfileExt=lcase(fileExt_a(ubound(fileExt_a) end functionfunction getvirtual(str,path,urlhead) if left

10、(str,7)=http:/ thenurl=str elseif left(str,1)=/ thenstart=instrRev(str,/)if start=1 thenurl=/ else url=left(str,start)end ifurl=urlhead&urlelseifleft(str,3)=./ thenstr1=mid(str,inStrRev(str,./)+2)ar=split(str,./)lv=ubound(ar)+1ar=split(path,/)url=/ for i=1 to (ubound(ar)-lv)url=url&ar(i) nexturl=url

11、&str1 url=urlhead&urlelse url=urlhead&strend if getvirtual=urlend function 示例代码dim dlpathvirtual=/downweb/truepath=server.MapPath(virtual)if request(url) thenurl=request(url)fn=getFileName(url)urlhead=left(url,(instr(replace(url,/,),/)+1)urlpath=replace(left(url,instrRev(url,/),urlhead,)strContent =

12、 getHTTPPage(url) mystr=strContentSet objRegExp = New RegexpobjRegExp.IgnoreCase = TrueobjRegExp.Global = TrueobjRegExp.Pattern = (src|href)=.+? Set Matches =objRegExp.Execute(strContent)For Each Match in Matchesstr=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 start0 thenrepl=virtual&mid(temp,start)& response.Write repl&brmystr=Replace(mystr,str,repl)dir=mid(temp,start,endt)temp=truepat