当前位置:主页 > 查看内容

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

发布时间:2021-07-23 00:00| 位朋友查看

简介:复制代码 代码如下: FunctionAutoLinkURLs(strString) Dimmatch,matches,offset,url,email,link,relnkAutoLinkURL relnkAutoLinkURL="ahref=""[[%URL%]]""[[%URLText%]]/a" IfNotIsObject(regExp)ThenSetregExp=NewRegExp regExp.Global=True regExp.IgnoreC……

复制代码 代码如下:

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


原文链接:https://m.jb51.net/article/9156.htm
本站部分内容转载于网络,版权归原作者所有,转载之目的在于传播更多优秀技术内容,如有侵权请联系QQ/微信:153890879删除,谢谢!
上一篇:JS:一个匹配日期的正则 下一篇:没有了

推荐图文


随机推荐