下载网页中的所有资源

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

end function