复制代码 代码如下:

FunctionAutoLinkURLs(strString)

Dimmatch,matches,offset,url,email,link,relnkAutoLinkURL

relnkAutoLinkURL="<ahref=""[[%URL%]]"">[[%URLText%]]</a>"

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