欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2022-03-27 12:10:20
复制代码 代码如下:function autolinkurls(strstring)       di...

复制代码 代码如下:

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