用ASP取出HTML里面的图片地址的函数

在做采集程序的时候,需要将被采集网页上的图片保存下来,这样,首先要得到被采集网页上的图片地址,然后将图片保存下来
　　
函数如下：
以下是引用片段：
Function 
ShowPic(str) 
 

　　Set 
objRegExp 
= 
New 
Regexp&
#39
设置配置对象 
 
 

　　objRegExp.IgnoreCase 
= 
True&
#39
忽略大小写 
 
 

　　objRegExp.Global 
= 
True&
#39
设置为全文搜索 
 
 

　　objRegExp.Pattern 
= 
"
<
img.+?>
"
 
 

　　&
#39
为了确保能准确地取出图片地址所以分为两层配置：首先找到里面的<
img>
标签，
然后再取出里面的图片地址后面的getimgs函数就是实现后一个功能的。 
 
 

strs=trim(str) 
 
 

Set 
Matches 
=objRegExp.Execute(strs)&
#39
开始执行配置 
 
 

For 
Each 
Match 
in 
Matches 
 
 

RetStr 
= 
RetStr 
&

#38
getimgs( 
Match.Value 
)&
#39
执行第二轮的匹配 
 
 

Next 
 
 

ShowPic 
= 
RetStr 
 

End 
Function 
 

Function 
getimgs(str) 
 
 

getimgs="
"
 
 
 

Set 
objRegExp1 
= 
New 
Regexp 
 
 

objRegExp1.IgnoreCase 
= 
True 
 
 

objRegExp1.Global 
= 
True 
 
 

objRegExp1.Pattern 
= 
"
http://.+?"
"
"
&
#39
取出里面的地址 
 
 

set 
mm=objRegExp1.Execute(str) 
 
 

For 
Each 
Match1 
in 
mm 
 
 

getimgs=getimgs&

#38
left(Match1.Value,len(Match1.Value)-1)&

#38
"
||"

 
&
#39
把里面的地址串起来备用 
 
 

next 
 
 

End 
Function 
 
 

&
#39
取得图片内容 
 

function 
getHTTPPage(url) 
 
 

on 
error 
resume 
next 
 
 

dim 
http 
 
 

set 
http=server.createobject("
MSXML2.XMLHTTP"
)
 
&
#39
使用xmlhttp的方法来获得图片的内容 
 
 

Http.open 
"
GET"
,url,false 
 
 

Http.send() 
 
 

if 
Http.readystate<
>
4 
then 
 
 

exit 
function 
 
 

end 
if 
 
 

getHTTPPage=Http.responseBody 
 
 

set 
http=nothing 
 
 

if 
err.number<
>
0 
then 
err.Clear 
 
 

end 
function 
 
 

&
#39
保存图片 
 

function 
saveimage(from,tofile) 
 
 

dim 
geturl,objStream,imgs 
 
 

geturl=trim(from) 
 
 

imgs=gethttppage(geturl)&
#39
取得图片的具休内容的过程 
 
 

Set 
objStream 
= 
Server.CreateObject("
ADODB.Stream"
)
&
#39
建立ADODB.Stream对象，必须要ADO 
2.5以上版本 
 
 

objStream.Type 
=1&
#39
以二进制模式打开 
 
 

objStream.Open 
 
 

objstream.write 
imgs&
#39
将字符串内容写入缓冲 
 
 

objstream.SaveToFile 
server.mappath(tofile),2&
#39
-将缓冲的内容写入文件 
 
 

objstream.Close()&
#39
关闭对象 
 
 

set 
objstream=nothing 
 
 

end 
function 
 
 

&
#39
调用实例 
 

Dim 
strpic,i,fname 
 

strpic 
= 
ShowPic("
<
DIV 
align=center>
<
IMG 
src="
"
图片地址"
"
 
border=0>
<
/DIV>
"
) 
 

strpic 
= 
Split(strpic,"
||"
) 
 

If 
UBound(strpic) 
>
 
0 
Then 
 
 

For 
i 
= 
0 
To 
UBound(strpic) 
- 
1 
 

&
#39
保存图片 
 

fname=cstr(i&

#38
mid(strpic(i),instrrev(strpic(i),"
."
))) 
 
 

saveimage(strpic(i),fname) 
 

Next 
 

Else 
 

End 
If