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

站长资源 2024/11/25 佚名

50 1538 50

DDR爱好者之家 Design By 杰米

复制代码代码如下:
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

DDR爱好者之家 Design By 杰米

广告合作：本站广告合作请联系QQ：858582 申请时备注：广告合作（否则不回）
免责声明：本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除！

DDR爱好者之家 Design By 杰米

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

暂无评论...

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

JS:一个匹配日期的正则

正则表达式

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

更新日志

友情链接