欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2022-06-15 14:22:13
一次性下载远程页面上的所有内容使用方法,将上面的代码保存为一个比如:downfile.asp在浏览器上输入:http://你的地址/downfile.asp?url=htt...

一次性下载远程页面上的所有内容
使用方法,将上面的代码保存为一个比如: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