首页 > 编程 > regex > 正文

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

2020-01-20 22:26:32
字体:
来源:转载
供稿:网友

复制代码 代码如下:

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

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表