asp通過xmlhttp獲取遠(yuǎn)程圖片流數(shù)據(jù)，并保存到本地，把第一張采集到的圖片生成縮略圖。

具體代碼如下：

<%
'==================================================
'函數(shù)名：checkdir2
'作 用：檢查文件夾是否存在
'參 數(shù)：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
'==================================================
'函數(shù)名：makenewsdir2
'作 用：創(chuàng)建新的文件夾
'參 數(shù)：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
'==================================================
'函數(shù)名：definiteurl
'作 用：將相對地址轉(zhuǎn)換為絕對地址
'參 數(shù)：primitiveurl ------要轉(zhuǎn)換的相對地址
'參 數(shù)：consulturl ------當(dāng)前網(wǎng)頁地址
'==================================================
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,"http://","/")
definiteurl=replace(definiteurl,":\\","://")
else
definiteurl="$false$"
end if
end function
'==================================================
'函數(shù)名：replacesaveremotefile
'作 用：替換、保存遠(yuǎn)程文件
'參 數(shù)：constr ------ 要替換的字符串
'參 數(shù)：starstr ----- 前導(dǎo)
'參 數(shù)：overstr -----
'參 數(shù)：inclul ------
'參 數(shù)：inclur ------
'參 數(shù)：savetf ------ 是否保存文件，false不保存，true保存
'參 數(shù)：savefilepath- 保存文件夾
'參 數(shù): tisturl------ 當(dāng)前網(wǎng)頁地址
'==================================================
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 & "/"

'圖片轉(zhuǎn)換/保存
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
'作 用：保存遠(yuǎn)程的文件到本地
'參 數(shù)：localfilename ------ 本地文件名
'參 數(shù)：remotefileurl ------ 遠(yuǎn)程文件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
'作 用：取得文章中第一張圖片
'參 數(shù)：str ------ 文章內(nèi)容
'參 數(shù)：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
%>

例:

程序代碼

<br><img height="180" src="http://cimg2.163.com/cnews/2006/8/21/200608210738371d0a8.jpg" width="240" border="0" /> <br><img class="left"src="http://news.163.com/img/netease_logo.gif" width="114" /> <br><img height="60" src="http://cimg2.163.com/cnews/2006/8/18/2006081811465369976.jpg" width="120" border="0" /> <br><img height="60" alt="中國維和人數(shù)大國之首" src="http://cimg2.163.com/cnews/2006/8/18/200608181506554fd8f.jpg" width="120" border="0" /> <br>

<%
if request.querystring("action")="test" then
'圖片開始的字符串
filesstartstr="src="
'圖片結(jié)束的字符串
filesoverstr="gif|jpg|bmp"
'保存圖片的文件夾
filespath="qq"
'取得保存圖片的網(wǎng)站url 自動判斷是絕對 還是相對路徑
newsurl="http://news.163.com"
'取得文章內(nèi)容
content =request.form("body")
'開始保存圖片
content=replacesaveremotefile(content,filesstartstr,filesoverstr,false,true,true,filespath,newsurl)
'對新聞中的第一張圖片創(chuàng)建縮略圖
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 則不創(chuàng)建縮略圖
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
'顯示結(jié)果
response.write("新聞中的第一張圖片是:")
response.write("")
response.write("
新聞中的第一張圖片的縮略圖是:")
response.write("")
response.write("
新的新聞內(nèi)容（圖片為本地）:
")
response.write(content)
response.end()
end if
%>