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

download.asp代码如下

 <%
Server.ScriptTimeout=9999
function SaveToFile(fromhttp://www.zzchn.com/edu/20070914/,tofile)
on error resume next
dim geturlhttp://www.zzchn.com/edu/20070914/,objStreamhttp://www.zzchn.com/edu/20070914/,imgs
geturl=trim(from)
Mybyval=getHTTPstr(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write Mybyval
objstream.SaveToFile tofilehttp://www.zzchn.com/edu/20070914/,2
objstream.Close()
set objstream=nothing
if err.number<>0 then err.Clear
end function 

function geturlencodel(byval url)"中文文件名转换
Dim ihttp://www.zzchn.com/edu/20070914/,code
geturlencodel=""
if trim(Url)="" then exit function
for i=1 to len(Url)
code=Asc(mid(Urlhttp://www.zzchn.com/edu/20070914/,ihttp://www.zzchn.com/edu/20070914/,1))
if code<0 Then code = code + 65536
If code>255 Then
geturlencodel=geturlencodel&"%"&Left(Hex(Code)http://www.zzchn.com/edu/20070914/,2)&"%"&Right(Hex(Code)http://www.zzchn.com/edu/20070914/,2)
else
geturlencodel=geturlencodel&mid(Urlhttp://www.zzchn.com/edu/20070914/,ihttp://www.zzchn.com/edu/20070914/,1)
end if
next
end function
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Msxml2.XMLHTTP")
Http.open "GET"http://www.zzchn.com/edu/20070914/,urlhttp://www.zzchn.com/edu/20070914/,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 ihttp://www.zzchn.com/edu/20070914/,ThisCharCodehttp://www.zzchn.com/edu/20070914/,NextCharCode
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vInhttp://www.zzchn.com/edu/20070914/,ihttp://www.zzchn.com/edu/20070914/,1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vInhttp://www.zzchn.com/edu/20070914/,i+1http://www.zzchn.com/edu/20070914/,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(filenamehttp://www.zzchn.com/edu/20070914/,"/")>0 then
fileExt_a=split(filenamehttp://www.zzchn.com/edu/20070914/,"/")
getFileName=lcase(fileExt_a(ubound(fileExt_a)))
if instr(getFileNamehttp://www.zzchn.com/edu/20070914/,"?")>0 then
getFileName=left(getFileNamehttp://www.zzchn.com/edu/20070914/,instr(getFileNamehttp://www.zzchn.com/edu/20070914/,"?")-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"http://www.zzchn.com/edu/20070914/,urlhttp://www.zzchn.com/edu/20070914/,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(LocalPathhttp://www.zzchn.com/edu/20070914/, ""http://www.zzchn.com/edu/20070914/, "/")
Set FileObject = server.CreateObject("Scripting.FileSystemObject")
patharr = Split(LocalPathhttp://www.zzchn.com/edu/20070914/, "/")
path_level = UBound(patharr)
For I = 0 To path_level
If I = 0 Then pathtmp = patharr(0) & "/" Else pathtmp = pathtmp & patharr(I) & "/"
cpath = Left(pathtmphttp://www.zzchn.com/edu/20070914/, 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(filenamehttp://www.zzchn.com/edu/20070914/,".")
GetfileExt=lcase(fileExt_a(ubound(fileExt_a)))
end function

function getvirtual(strhttp://www.zzchn.com/edu/20070914/,pathhttp://www.zzchn.com/edu/20070914/,urlhead)
if left(strhttp://www.zzchn.com/edu/20070914/,7)="http://" then
url=str
elseif left(strhttp://www.zzchn.com/edu/20070914/,1)="/" then
start=instrRev(strhttp://www.zzchn.com/edu/20070914/,"/")
if start=1 then
url="/"
else
url=left(strhttp://www.zzchn.com/edu/20070914/,start)
end if
url=urlhead&url
elseif left(strhttp://www.zzchn.com/edu/20070914/,3)="../" then
str1=mid(strhttp://www.zzchn.com/edu/20070914/,inStrRev(strhttp://www.zzchn.com/edu/20070914/,"../")+2)
ar=split(strhttp://www.zzchn.com/edu/20070914/,"../")
lv=ubound(ar)+1
ar=split(pathhttp://www.zzchn.com/edu/20070914/,"/")
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(urlhttp://www.zzchn.com/edu/20070914/,(instr(replace(urlhttp://www.zzchn.com/edu/20070914/,"//"http://www.zzchn.com/edu/20070914/,"")http://www.zzchn.com/edu/20070914/,"/")+1))
urlpath=replace(left(urlhttp://www.zzchn.com/edu/20070914/,instrRev(urlhttp://www.zzchn.com/edu/20070914/,"/"))http://www.zzchn.com/edu/20070914/,urlheadhttp://www.zzchn.com/edu/20070914/,"")
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(strhttp://www.zzchn.com/edu/20070914/,"src="http://www.zzchn.com/edu/20070914/,"")
str=replace(strhttp://www.zzchn.com/edu/20070914/,"href="http://www.zzchn.com/edu/20070914/,"")
str=replace(strhttp://www.zzchn.com/edu/20070914/,""""http://www.zzchn.com/edu/20070914/,"")
str=replace(strhttp://www.zzchn.com/edu/20070914/,"""http://www.zzchn.com/edu/20070914/,"")
filename=GetfileName(str)
getRet=getVirtual(strhttp://www.zzchn.com/edu/20070914/,urlpathhttp://www.zzchn.com/edu/20070914/,urlhead)
temp=Replace(getRethttp://www.zzchn.com/edu/20070914/,"//"http://www.zzchn.com/edu/20070914/,"**")
start=instr(temphttp://www.zzchn.com/edu/20070914/,"/")
endt=instrRev(temphttp://www.zzchn.com/edu/20070914/,"/")-start+1
if start>0 then
repl=virtual&mid(temphttp://www.zzchn.com/edu/20070914/,start)&" "
"response.Write repl&"<br>"
mystr=Replace(mystrhttp://www.zzchn.com/edu/20070914/,strhttp://www.zzchn.com/edu/20070914/,repl)

dir=mid(temphttp://www.zzchn.com/edu/20070914/,starthttp://www.zzchn.com/edu/20070914/,endt)
temp=truepath&Replace(dirhttp://www.zzchn.com/edu/20070914/,"/"http://www.zzchn.com/edu/20070914/,"")
CreateDir(temp)
"response.Write getRet&"||"&temp&filename&"<br><br>"
SaveToFile getRethttp://www.zzchn.com/edu/20070914/,temp&filename
end if
Next
set Matches=nothing
end if
%>