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

ASP保存远程图片到本地 同时取得第一张图片并创建缩略图的代码

程序员文章站 2022-05-03 12:40:20
采集中 或者 在线添加文章中 都可以用到此功能 俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂 俺从 sna新闻...
采集中 或者 在线添加文章中 都可以用到此功能
俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂
俺从 sna新闻采集系统 for 3.62 (程序制作:ansir)里提取了点函数 用下 比较简单好用
以下是函数
程序代码 
复制代码 代码如下:

<%
'==================================================
'函数名:checkdir2
'作 用:检查文件夹是否存在
'参 数:folderpath ------文件夹地址
'==================================================
function checkdir2(byval folderpath)
dim fso
folderpath=server.mappath(".")&"\"&folderpath
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(folderpath) then
'存在
checkdir2 = true
else
'不存在
checkdir2 = false
end if
set fso = nothing
end function
'==================================================
'函数名:makenewsdir2
'作 用:创建新的文件夹
'参 数:foldername ------文件夹名称
'==================================================
function makenewsdir2(byval foldername)
dim fso
set fso = server.createobject("scripting.filesystemobject")
fso.createfolder(server.mappath(".") &"\" &foldername)
if fso.folderexists(server.mappath(".") &"\" &foldername) then
makenewsdir2 = true
else
makenewsdir2 = false
end if
set fso = nothing
end function
'==================================================
'函数名:definiteurl
'作 用:将相对地址转换为绝对地址
'参 数:primitiveurl ------要转换的相对地址
'参 数:consulturl ------当前网页地址
'==================================================
function definiteurl(byval primitiveurl,byval consulturl)
dim contemp,pritemp,pi,ci,priarray,conarray
if primitiveurl="" or consulturl="" or primitiveurl="$false$" then
definiteurl="$false$"
exit function
end if
if left(consulturl,7)<>"http://" and left(consulturl,7)<>"http://" then
consulturl= "http://" & consulturl
end if
consulturl=replace(consulturl,"://",":\\")
if right(consulturl,1)<>"/" then
if instr(consulturl,"/")>0 then
if instr(right(consulturl,len(consulturl)-instrrev(consulturl,"/")),".")>0 then
else
consulturl=consulturl & "/"
end if
else
consulturl=consulturl & "/"
end if
end if
conarray=split(consulturl,"/")
if left(primitiveurl,7) = "http://" then
definiteurl=replace(primitiveurl,"://",":\\")
elseif left(primitiveurl,1) = "/" then
definiteurl=conarray(0) & primitiveurl
elseif left(primitiveurl,2)="./" then
definiteurl=conarray(0) & right(primitiveurl,len(primitiveurl)-1)
elseif left(primitiveurl,3)="../" then
do while left(primitiveurl,3)="../"
primitiveurl=right(primitiveurl,len(primitiveurl)-3)
pi=pi+1
loop
for ci=0 to (ubound(conarray)-1-pi)
if definiteurl<>"" then
definiteurl=definiteurl & "/" & conarray(ci)
else
definiteurl=conarray(ci)
end if
next
definiteurl=definiteurl & "/" & primitiveurl
else
if instr(primitiveurl,"/")>0 then
priarray=split(primitiveurl,"/")
if instr(priarray(0),".")>0 then
if right(primitiveurl,1)="/" then
definiteurl="http:\\" & primitiveurl
else
if instr(priarray(ubound(priarray)-1),".")>0 then
definiteurl="http:\\" & primitiveurl
else
definiteurl="http:\\" & primitiveurl & "/"
end if
end if
else
if right(consulturl,1)="/" then
definiteurl=consulturl & primitiveurl
else
definiteurl=left(consulturl,instrrev(consulturl,"/")) & primitiveurl
end if
end if
else
if instr(primitiveurl,".")>0 then
if right(consulturl,1)="/" then
if right(primitiveurl,3)=".cn" or right(primitiveurl,3)="com" or right(primitiveurl,3)="net" or right(primitiveurl,3)="org" then
definiteurl="http:\\" & primitiveurl & "/"
else
definiteurl=consulturl & primitiveurl
end if
else
if right(primitiveurl,3)=".cn" or right(primitiveurl,3)="com" or right(primitiveurl,3)="net" or right(primitiveurl,3)="org" then
definiteurl="http:\\" & primitiveurl & "/"
else
definiteurl=left(consulturl,instrrev(consulturl,"/")) & "/" & primitiveurl
end if
end if
else
if right(consulturl,1)="/" then
definiteurl=consulturl & primitiveurl & "/"
else
definiteurl=left(consulturl,instrrev(consulturl,"/")) & "/" & primitiveurl & "/"
end if
end if
end if
end if
if left(definiteurl,1)="/" then
definiteurl=right(definiteurl,len(definiteurl)-1)
end if
if definiteurl<>"" then
definiteurl=replace(definiteurl,"//","/")
definiteurl=replace(definiteurl,":\\","://")
else
definiteurl="$false$"
end if
end function
'==================================================
'函数名:replacesaveremotefile
'作 用:替换、保存远程文件
'参 数:constr ------ 要替换的字符串
'参 数:starstr ----- 前导
'参 数:overstr -----
'参 数:inclul ------
'参 数:inclur ------
'参 数:savetf ------ 是否保存文件,false不保存,true保存
'参 数:savefilepath- 保存文件夹
'参 数: tisturl------ 当前网页地址
'==================================================
function replacesaveremotefile(constr,startstr,overstr,inclul,inclur,savetf,savefilepath,tisturl)
if constr="$false$" or constr="" then
replacesaveremotefile="$false$"
exit function
end if
dim tempstr,tempstr2,ref,matches,match,tempi,temparray,temparray2,overtypearray
set ref = new regexp
ref.ignorecase = true
ref.global = true
ref.pattern = "("&startstr&").+?("&overstr&")"
set matches =ref.execute(constr)
for each match in matches
if instr(tempstr,match.value)=0 then
if tempstr<>"" then
tempstr=tempstr & "$array$" & match.value
else
tempstr=match.value
end if
end if
next
set matches=nothing
set ref=nothing
if tempstr="" or isnull(tempstr)=true then
replacesaveremotefile=constr
exit function
end if
if inclul=false then
tempstr=replace(tempstr,startstr,"")
end if
if inclur=false then
if instr(overstr,"|")>0 then
overtypearray=split(overstr,"|")
for tempi=0 to ubound(overtypearray)
tempstr=replace(tempstr,overtypearray(tempi),"")
next
else
tempstr=replace(tempstr,overstr,"")
end if
end if
tempstr=replace(tempstr,"""","")
tempstr=replace(tempstr,"'","")
dim remotefile,remotefileurl,savefilename,savefiletype,arrsavefilename,rannum
if right(savefilepath,1)="/" then
savefilepath=left(savefilepath,len(savefilepath)-1)
end if
if savetf=true then
if checkdir2(savefilepath)=false then
if makenewsdir2(savefilepath)=false then
savetf=false
end if
end if
end if
savefilepath=savefilepath & "/"
'图片转换/保存
temparray=split(tempstr,"$array$")
for tempi=0 to ubound(temparray)
remotefileurl=definiteurl(temparray(tempi),tisturl)
if remotefileurl<>"$false$" and savetf=true then'保存图片
arrsavefilename = split(remotefileurl,".")
savefiletype=arrsavefilename(ubound(arrsavefilename))'文件类型
rannum=int(900*rnd)+100
savefilename = savefilepath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&rannum&"."&savefiletype
call saveremotefile(savefilename,remotefileurl)
constr=replace(constr,temparray(tempi),savefilename)
elseif remotefileurl<>"$false$" and savetf=false then'不保存图片
savefilename=remotefileurl
constr=replace(constr,temparray(tempi),savefilename)
end if
if remotefileurl<>"$false$" then
if uploadfiles="" then
uploadfiles=savefilename
else
uploadfiles=uploadfiles & "|" & savefilename
end if
end if
next
replacesaveremotefile=constr
end function
'==================================================
'过程名:saveremotefile
'作 用:保存远程的文件到本地
'参 数:localfilename ------ 本地文件名
'参 数:remotefileurl ------ 远程文件url
'==================================================
sub saveremotefile(localfilename,remotefileurl)
dim ads,retrieval,getremotedata
set retrieval = server.createobject("microsoft.xmlhttp")
with retrieval
.open "get", remotefileurl, false, "", ""
.send
getremotedata = .responsebody
end with
set retrieval = nothing
set ads = server.createobject("adodb.stream")
with ads
.type = 1
.open
.write getremotedata
.savetofile server.mappath(localfilename),2
.cancel()
.close()
end with
set ads=nothing
end sub
'==================================================
'过程名:getimg
'作 用:取得文章中第一张图片
'参 数:str ------ 文章内容
'参 数:strpath ------ 保存图片的路径
'==================================================
function getimg(str,strpath)
set objregex = new regexp
objregex.ignorecase = true
objregex.global = true
zzstr=""&strpath&"(.+?)\.(jpg|gif|png|bmp)"
objregex.pattern = zzstr
set matches = objregex.execute(str)
for each match in matches
retstr = retstr &"|"& match.value
next
if retstr<>"" then
imglist=split(retstr,"|")
imgone=replace(imglist(1),strpath,"")
getimg=imgone
else
getimg=""
end if
end function
%>

以下是 例子
程序代码
复制代码 代码如下:

<form id="form1" name="form1" method="post" action="?action=test">
<textarea name="body" cols="50" rows="5" id="body">
<img height="180" src="http://cimg2.163.com/cnews/2006/8/21/200608210738371d0a8.jpg" width="240" border="0" />
<img class="left"src="http://news.163.com/img/netease_logo.gif" width="114" />
<img height="60" src="http://cimg2.163.com/cnews/2006/8/18/2006081811465369976.jpg" width="120" border="0" />
<img height="60" alt="中国维和人数大国之首" src="http://cimg2.163.com/cnews/2006/8/18/200608181506554fd8f.jpg" width="120" border="0" />
</textarea>
<input type="submit" name="submit" value="提交" />
</form>
<%
if request.querystring("action")="test" then
'图片开始的字符串
filesstartstr="src="
'图片结束的字符串
filesoverstr="gif|jpg|bmp"
'保存图片的文件夹
filespath="qq"
'取得保存图片的网站url 自动判断是绝对 还是相对路径 该例子中图片是绝对地址 所以newurl等于没用 如果是../images/123.gif这样的 就需要指定newurl了
newsurl="http://news.163.com"
'取得文章内容
content =request.form("body")
'开始保存图片
content=replacesaveremotefile(content,filesstartstr,filesoverstr,false,true,true,filespath,newsurl)
'对新闻中的第一张图片创建缩略图
if getimg(content,filespath)<>"" then
imgsrc=getimg(content,filespath)
imgsrc=replace(imgsrc,filespath,"")
set jpeg = server.createobject("persits.jpeg")
path = server.mappath(""&filespath&"") & "\"&imgsrc&""
jpeg.open path
'如果图片宽小于等于120 高小于等于90 则不创建缩略图
if jpeg.originalwidth<=120 and jpeg.height<=90 then
jpeg.width = jpeg.originalwidth
jpeg.height = jpeg.originalheight
smallimg=filespath&""&getimg(content,filespath)
else
'图片宽度高度/2
jpeg.width = jpeg.originalwidth / 2
jpeg.height = jpeg.originalheight / 2
jpeg.save server.mappath(""&filespath&"") & "\small_"&imgsrc&""
smallimg=""&filespath&"/small_"&imgsrc&""
end if
end if
'显示结果
response.write("新闻中的第一张图片是:")
response.write("<img src="&filespath&"/"&getimg(content,filespath)&">")
response.write("<br>新闻中的第一张图片的缩略图是:")
response.write("<img src="&smallimg&">")
response.write("<br>新的新闻内容(图片为本地):<br>")
response.write(content)
response.end()
end if
%>