欢迎来到代码驿站!

当前位置:首页 >

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

时间:2021-04-17 09:51:20|栏目:|点击:

复制代码 代码如下:

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

上一篇:Git在Windows中安装与使用教程

栏    目:

下一篇:易语言打开文件件网页的方法

本文标题:asp下正则实现URL自动链接的一个函数

本文地址:http://www.codeinn.net/misctech/102874.html

推荐教程

广告投放 | 联系我们 | 版权申明

重要申明:本站所有的文章、图片、评论等,均由网友发表或上传并维护或收集自网络,属个人行为,与本站立场无关。

如果侵犯了您的权利,请与我们联系,我们将在24小时内进行处理、任何非本站因素导致的法律后果,本站均不负任何责任。

联系QQ:914707363 | 邮箱:codeinn#126.com(#换成@)

Copyright © 2020 代码驿站 版权所有