目前还是有BUG的,最新的测试页面在:http://www.reallydo.com/getimg.asp

正则分析页面在:http://jorkin.reallydo.com/article.asp?id=380

发现BUG请在后面留言,谢谢.

1.31修正

src=后面有空格不能正确匹配.已修正.

src=''为空时出错.已修正.

发现BUG:图片路径有多个空格时只能保留一个.未修正.

2.18修正

图片路径有多个空格时只能保留一个的BUG.已修正.

复制代码 代码如下:

<%

'功能:获取全部图片地址,保存到一个数组.

'来源:http://jorkin.reallydo.com/article.asp?id=448

'需要ReplaceAll函数:http://jorkin.reallydo.com/article.asp?id=406

FunctiongetIMG(sString)

DimsReallyDo,regEx,iReallyDo

DimoMatches,cMatch

'//定义一个空数组

iReallyDo=-1

ReDimaReallyDo(iReallyDo)

IfIsNull(sString)Then

getIMG=""

ExitFunction

EndIf

'//格式化HTML代码

'//将每个<img换行方便正则替换

sReallyDo=sString

OnErrorResumeNext

sReallyDo=Replace(sReallyDo,vbCr,"")

sReallyDo=Replace(sReallyDo,vbLf,"")

sReallyDo=Replace(sReallyDo,vbTab,"")

sReallyDo=Replace(sReallyDo,"<img",vbCrLf&"<img",1,-1,1)

sReallyDo=Replace(sReallyDo,"/>","/>",1,-1,1)

sReallyDo=ReplaceAll(sReallyDo,"=","=",True)

sReallyDo=ReplaceAll(sReallyDo,">",">",True)

sReallyDo=Replace(sReallyDo,"><",">"&vbCrLf&"<")

sReallyDo=Trim(sReallyDo)

OnErrorGoTo0

SetregEx=NewRegExp

regEx.IgnoreCase=True

regEx.Global=True

'//去除onclick,onload等脚本

regEx.Pattern="s[on].+?=([""|'])(.*?)1"

sReallyDo=regEx.Replace(sReallyDo,"")

'//将SRC不带引号的图片地址加上引号

regEx.Pattern="<img.*?ssrc=([^""'s][^""'s>]*).*?>"

sReallyDo=regEx.Replace(sReallyDo,"<imgsrc=""$1""/>")

'//正则匹配图片SRC地址

regEx.Pattern="<img.*?ssrc=([""'])([^""']+?)1.*?>"

SetoMatches=regEx.Execute(sReallyDo)

'//将图片地址存入数组

ForEachcMatchinoMatches

iReallyDo=iReallyDo+1

ReDimPreserveaReallyDo(iReallyDo)

aReallyDo(iReallyDo)=regEx.Replace(cMatch.Value,"$2")

Next

getIMG=aReallyDo

EndFunction

%>