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

262 阅读 0 评论 173 点赞

我是靠谱客的博主完美高山，最近开发中收集的这篇文章主要介绍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