asp下正则实现URL自动链接的一个函数

复制代码 代码如下:
FunctionAutoLinkURLs(strString)
Dimmatch,matches,offset,url,email,link,relnkAutoLinkURL
relnkAutoLinkURL="[[%URLText%]]"
IfNotIsObject(regExp)ThenSetregExp=NewRegExp
regExp.Global=True
regExp.IgnoreCase=True
'LookforURLs
regExp.Pattern="(((ht|f)tps?://)|(www.))([w-]+.)+[w-:]+(/[w-./?%#;&=]*)?"
Setmatches=regExp.Execute(strString)
offset=0
ForEachmatchinmatches
url=match
IfLeft(url,4)="www."Thenurl="http://"&url
link=Replace(Replace(relnkAutoLinkURL,"[[%URLText%]]",match),"[[%URL%]]",url)
strString=Mid(strString,1,match.FirstIndex+offset)&link&Mid(strString,match.FirstIndex+1+match.Length+offset,Len(strString))
offset=offset+Len(link)-Len(match)
Next
'Lookforemails
regExp.Pattern="[A-Za-z0-9_+-.']+@w+([-.]w+)*.w+([-.]w+)*"
Setmatches=regExp.Execute(strString)
offset=0
ForEachmatchinmatches
email=match
link=Replace(Replace(relnkAutoLinkURL,"[[%URLText%]]",match),"[[%URL%]]","mailto:"&email)
strString=Mid(strString,1,match.FirstIndex+offset)&link&Mid(strString,match.FirstIndex+1+match.Length+offset,Len(strString))
offset=offset+Len(link)-Len(match)
Next
AutoLinkURLs=strString
EndFunction