復(fù)制代碼 代碼如下:
Function AutoLinkURLs(strString)
Dim match, matches, offset, url, email, link, relnkAutoLinkURL
relnkAutoLinkURL = "a href=""[[%URL%]]"">[[%URLText%]]/a>"
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
您可能感興趣的文章:- 讓URL只允許一些字符的正則表達式
- JS 正則表達式（學(xué)習(xí)筆記2）匹配網(wǎng)址url參數(shù)
- javascript 獲取url參數(shù)的正則表達式(用來獲取某個參數(shù)值)
- php 正則表達式提取網(wǎng)頁超級鏈接url的函數(shù)
- 用Javascript正則實現(xiàn)url鏈接的解析類
- php利用正則表達式取出圖片的URL
- JS驗證URL函數(shù) 正則
