目前还是有BUG的,最新的测试页面在:http:///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
%>