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

ASP
一个ASP版的图片浏览管理器
无组件上传图片至SQLSERVER数据库
利用Jmail.Message发送邮件
用Web页面执行客户端程序
多图片上传到指定的目录并存到数据库
dreamweaverMX通用分页代码研究
下拉菜单输入,根据输入内容自动定位
中文的无组件文件上传ASP函数
一个利用adsi得到局域网信息的asp文件
根据需要动态include不同的文件
让自定义文件下载支持断点续传
用数组实现数据记录的批量录入方法
上传的进度条 实时反映上传情况
用ASP动态生成javascript的表单验证代码
ASP 编程中20个非常有用的例子
ASP生成Word文档的又一方法
用asp解析图片地址，并将其保存。
利用ASP的文件操作实现用户管理
创建 Visual Basic COM 组件在 ASP 中使用
调试 ASP 中使用的 Visual Basic COM 组件

No. « 195 196 197 198 »

技术文章搜索

关键字

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

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-10-12   浏览: 145 ::
收藏到网摘: 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
%>