当前位置: 编程技术>其它
asp下正则实现URL自动链接的一个函数
来源: 互联网 发布时间:2014-10-14
本文导语: 代码如下:Function AutoLinkURLs(strString) Dim match, matches, offset, url, email, link, relnkAutoLinkURL relnkAutoLinkURL = "[[%URLText%]]" If Not IsObject(regExp) Then Set regExp = New RegExp regExp.Global = True ...
代码如下:
Function AutoLinkURLs(strString)
Dim match, matches, offset, url, email, link, relnkAutoLinkURL
relnkAutoLinkURL = "[[%URLText%]]"
If Not IsObject(regExp) Then Set regExp = New RegExp
regExp.Global = True
regExp.IgnoreCase = True
'Look for URLs
regExp.Pattern = "(((ht|f)tps?://)|(www.))([w-]+.)+[w-:]+(/[w- ./?%#;&=]*)?"
Set matches = regExp.Execute(strString)
offset = 0
For Each match in matches
url = match
If Left(url, 4) = "www." Then url = "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
'Look for emails
regExp.Pattern = "[A-Za-z0-9_+-.']+@w+([-.]w+)*.w+([-.]w+)*"
Set matches = regExp.Execute(strString)
offset = 0
For Each match in matches
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
End Function