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

采集中 或者 在线添加文章中 都可以用到此功能
俺自己在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
%>