如何将远程页面的所有内容下载到本地

以前发过一个东西,是将远程的内容,按浏览器输入后,将它转为二进制流下载到本地,但局限性比较多,这个代码可以将远程页面的所有内容,包括远程服务器的CSS,JS,JPG,Gif,第一层下面的页面,swf,等等... 

　　代码的使用: 
　　将下面的代码保存为downfile.asp放到你的站点一个目录下,然后在那个目录里面建立一个叫downfile的文件夹,所有得到的内容都将保存在downfile文件夹里。 

　　在浏览器中输入 
http://你的地址/downfile.asp?url=http://www.baidu.com/index.html 
  

　　那么就将百度首页的所有文件都下载到本地的那个叫downfile的文件夹中.. 

　　这个代码比你的手工OE可要舒服多了,而且会将获取的文件,按照原来远程的路径,建立文件夹,分类别保存文件.. 
<% 
’#################### 
’代码的主体函数部分均源自于网络 
’修改:blue2004 
’转载注明:落伍者www.im286.com 
’#################### 
’设置超时的时间 
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 

’下面是示范性的代码 
dim dlpath 
’建立一个文件夹,以便存放这些获取的数据 
virtual="/downfile/" 
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 
else 
response.write "请输入一个地址!" 
end if 
%> 
  

　　经测试，还真不错！ 
　　不过，最好在页首加入<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>，否则提示页面会是乱码！