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

  

复制代码 代码如下:

  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