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

     看过一篇关于下载网页中图片的文章，它只能下载以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
  
  %＞　　
  
  
    做人要厚道，请注明转自chinazhan中国站长(www.ChinaZhan.com)。