一次性下载远程页面上的所有内容第1/2页

一次性下载远程页面上的所有内容
使用方法,将上面的代码保存为一个比如:downfile.asp
在浏览器上输入:
http://你的地址/downfile.asp?url=http://www.baidu.com/index.html

<%
'设置超时的时间
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

1