asp+xml自动将远程页面中的图片下载到本地
来源:csdn 发布时间:2007-08-23 13:34:00
标签:xml,远程图片
很久没写过东西了,今天看了chinahuman 的《用asp自动解析网页中的图片地址,并将其保存到本地服务器》,于是优化了这个程序,并且将所有的功能都函数化了,希望对学习 XMLHTTP 的朋友有所帮助。
程序实现功能:自动将远程页面的文件中的图片下载到本地。
本文根据 chinahuman 的《用asp自动解析网页中的图片地址,并将其保存到本地服务器》改编和优化,自动创建目录,自动将原文件名更名,文件格式的限制以及其他功能的一些优化自动保存网页文件中 http://.... 格式的图片到本地。
<%
’将本文保存为 save2local.asp
’测试:save2local.asp?url=http://ent.sina.com.cn/s/m/2003-11-11/1411231388.html
’转载请注明出处:http://www.jaron.cn http://www.csdn.net/develop
’参数设置开始
url = request("url")
localaddr = server.MapPath("images_remote/") ’保存到本地的目录
localdir = "images_remote/" ’http 访问的相对路径
AllowFileExt = "jpg|bmp|png|gif" ’支持的文件名格式
’参数设置完毕
if createdir(localaddr) = false then
response.Write "创建目录失败,请检查目录权限"
response.End
end if
response.Write Convert2LocalAddr(url,localaddr,localdir)
function Convert2LocalAddr(url,localaddr,localdir)
’参数说明
’url 页面地址
’localaddr 保存本地的物理地址
’localdir 相对路径
strContent = getHTTPPage(url)
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = "<img.+?>"
Set Matches =objRegExp.Execute(strContent)
For Each Match in Matches
RetStr = RetStr & GetRemoteImages(Match.Value)
Next
ImagesArray=split(RetStr,"||")
RemoteImage=""
LocalImage=""
for i=1 to ubound(ImagesArray)
if ImagesArray(i)<>"" and instr(RemoteImage,ImagesArray(i))<1 then
fname=baseurl&cstr(i&mid(ImagesArray(i),instrrev(ImagesArray(i),".")))
ImagesFileName = ImagesArray(i)
AllowFileExtArray = split(AllowFileExt,"|")
isGetFile = false
for tmp = 0 to ubound(AllowFileExtArray)
if lcase(GetFileExt(ImagesFileName)) = ALlowFileExtArray(tmp) then
isGetFile=True
end if
next
if isGetFile = true then
newfilename = GenerateRandomFileName(fname)
call Save2Local(ImagesFileName,localaddr & "/" & newfilename)
RemoteImage=RemoteImage&"||"& ImagesFileName
LocalImage=LocalImage&"||" & localdir & newfilename
end if
end if
next
arrnew=split(LocalImage,"||")
arrall=split(RemoteImage,"||")
for i=1 to ubound(arrnew)
strContent=replace(strContent,arrall(i),arrnew(i))
next
Convert2LocalAddr = strContent
end function
function GetRemoteImages(str)
Set objRegExp1 = New Regexp
objRegExp1.IgnoreCase = True
objRegExp1.Global = True
objRegExp1.Pattern = "http://.+? "
set mm=objRegExp1.Execute(str)
For Each Match1 in mm
tmpaddr = left(Match1.Value,len(Match1.Value)-1)
GetRemoteImages=GetRemoteImages&"||" & replace(replace(tmpaddr,"""",""),"’","")
next
end function
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 thenexit 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
function getHTTPimg(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
getHTTPimg=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function
function Save2Local(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=gethttpimg(geturl)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile tofile,2
objstream.Close()
set objstream=nothing
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
Function GenerateRandomFileName(ByVal szFilename) ’根据原文件名,自动以日期YYYY-MM-DD-RANDOM格式生成新文件名
Randomize
ranNum = Int(90000 * Rnd) + 10000
If Month(Now) < 10 Then c_month = "0" & Month(Now) Else c_month = Month(Now)
If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day = Day(Now)
If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour = Hour(Now)
If Minute(Now) < 10 Then c_minute = "0" & Minute(Now) Else c_minute = Minute(Now)
If Second(Now) < 10 Then c_second = "0" & Second(Now) Else c_second = Minute(Now)
fileExt_a = Split(szFilename, ".")
FileExt = LCase(fileExt_a(UBound(fileExt_a)))
GenerateRandomFileName = Year(Now) & c_month & c_day & c_hour & c_minute & c_second & "_" & ranNum & "." & FileExt
End Function
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
%>
有一点要注意的是,这里只是分析了以 http开头的图片的地址。否则不下载图片,可以转换一下地址就行了,再提供几个小函数,分析地址用的:
Function findurl(thisurl)
if thisurl <> "" Then
findurl=""
strlen=InStr(8,thisurl,"/")
If strlen=0 Then strlen =1
findurl=Mid(thisurl,strlen,28)
end if
end Function
function findurlpath(thisurl)
thisurl = replace(thisurl,"//","@@")
ary_tmp = split(thisurl,"/")
for tmp = 0 to ubound(ary_tmp)
if tmp < ubound(ary_tmp) then
urltmp = urltmp & "/" & ary_tmp(tmp)
end if
next
urltmp = right(urltmp,len(urltmp)-1)
findurlpath = replace(urltmp,"@@","//") & "/"
end function
function findurlhost(thisurl)
thisurl = replace(thisurl,"//","@@")
ary_tmp = split(thisurl,"/")
urltmp = ary_tmp(0)
findurlhost = replace(urltmp,"@@","//") & "/"
findurlhost = left(findurlhost,len(findurlhost)-1)
end function
0
投稿
猜你喜欢
- 这是我以前发表在经典论坛的帖子,现在转贴回来。仿淘宝网站的导航效果。此方法有几个优点:根据字数自适应项目长度不同的项目使用不同的颜色来区分无
- 著名的老掉牙的IE6.0在我这里已经有六年工龄了,前几天朋友拿到个IE8.0新的Beta版本,我的Sever2003装不上,大为扫兴。Chr
- 我们怎样才能了解用户需求呢?大家都知道可用性测试、调查问卷之类与用户进行沟通的途径,这些方法各有各的利弊,如果逐一分析的话,恐怕至少要分成三
- CSSer与其他IT职位一样,在找工作的时候,都会面临着面试官提出的问题,或者给出的试卷。一、超链接点击过后hover样式就不出现的问题?被
- Web 标准要求一览表Russ WeakleyJjgod Jiang14-Aug-2004目录1 Web 标准,不仅仅是“不用表格的站点”2
- 静态页面是蜘蛛喜欢的,会得到蜘蛛经常光顾的,以至于网站上的内容会得到搜索引擎更多的收录。这里介绍一个asp伪静态的程序实现方法数据库是acc
- Mootools 1.2手风琴(Accordion)教程原文地址:30 Days of Mootools 1.2 Tutoria
- 从XML中读取数据到内存的实例: public clsSi
- asp函数代码 代码如下:<% Function RemoveHTML(str) Dim objRegExp, Match,strHT
- 要做好一个HTML邮件,说简单,还真不怎么复杂,说它复杂,其实也不难。-_-!!以前写过类似的[ 关于HTML邮件的总结 ],最近又犯愁,就
- 去年淘宝做了个“胖子”项目,就是把网页的默认宽度从780提升到了950。也就是说,基本放弃了800×600的用户(没有完全放弃,如果你仔细研
- Web_THBC 为表示层也就是页面(.aspx) BLL_THBC 为业务逻辑层 DAL_THBC 为数据库交互层 (向数据库执行SQL语
- 1、什么是AspJpeg?AspJpeg是一款功能强大的基于Microsoft IIS环境的图片处理组件,AspJpeg可以使用很少的代码在
- 如何在线压缩Access数据库?Access数据库可以在线压缩吗?可以的,代码和说明见下:compact.asp<%option&nb
- 一个网站空间,但是却可以实现多个域名的访问的一段ASP代码:<%if Request.ServerVariables("SE
- MySQL字符集多种多样,下面为列举了其中三种最常见的字符集查看方法,该方法供您参考,希望对学习MySQL数据库能有所启迪。一、查看MySQ
- asp三天学好ADO对象之第一天 今天说一下Recordset 对象的属性1、CursorType 属性AdOpenForwardOnly:
- 虽然说表单验证在客户端使用javascript来验证已经可以了,但是我们为了防止访客绕过客户端验证也为了数据安全最好还是在服务器端加上必要的
- 在任何编辑器中,获取光标位置都是非常重要的,很多人可能认为较难,其实只要处理好浏览器的兼容,还是比较容易实现的。下面我们一起来看看如何获取到
- 前言:最近某个时间开始,特别留意了一下Web标准中柱状图,也就是英文中的bar graph的实现。虽然实现方法各异,效果不尽相同,但是总体来