当前位置: 首页 > 图文教程 > 网络编程 > ASP > 一次性下载远程页面上的所有内容

ASP
asp实现取得数组中的最大值的代码
asp 将日期格式化为需要的格式
asp 下产生任意位数随机密码的代码
asp下返回以千分位显示数字格式化的数值
asp重定向页面的方法总结
asp下去除数组中重复的项的方法
asp下实现 重新排序数字数组的代码
asp 验证输入网址是否有效并可以访问 与正则验证输入网址
asp验证Ip格式的函数
asp实现生成由数字，大写字母，小写字母指定位数的随机数
asp 格式化sql中的like字符串
asp 实现显示所有的服务器变量值的函数
asp 取得用户真实IP，对代理地址仍然有效的函数
asp 通用数据库连接过程函数
asp 字符串截取函数
asp下实现格式化文件大小以MB显示的函数
asp 下用正则表达式检测邮箱格式的函数
asp 实现检测字符串是否为纯字母和数字组合的函数
asp代码实现检测组件是否安装的函数
asp通过JMAIL实现通用发送函数

No. « 63 64 65 66 »

技术文章搜索

关键字

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

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-09-13   浏览: 106 ::
收藏到网摘: n/a

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


'示例代码

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