首页 > 编程 > Regex > 正文

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

2020-03-16 21:21:13
字体:
来源:转载
供稿:网友
代码如下:

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
发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表