一次性下载远程页面上的所有内容

　　'设置超时的时间

　　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

　　'##############

　　'XML获取远程页面开始

　　'#############

　　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

　　'##############

　　'XML获取远程页面结束,这段是小偷程序都通用的部分

　　'#############

　　'##############

　　'分解地址,取得文件名

　　'#############

　　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

　　'##############

　　'FSO处理函数,创建目录

　　'#############

　　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

　　'建立一个文件夹,以便存放这些获取的数据

　　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>"

　　response.Write "成功取得"&filename&"这个文件<br>"

　　response.Write "并将"&filename&"保存在"&temp&"<br><br>"

　　response.Write "<HR>"

　　SaveToFile getRet,temp&filename

　　end if

　　Next

　　set Matches=nothing

　　end if

　　%>