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
asp下正则实现URL自动链接的一个函数
内容版权声明:除非注明,否则皆为本站原创文章。
