Question

我使用下面的代码在我的字符串中自动创建链接。但是如何转换如下链接：

http://stackoverflow.com/questions/ask

成：

<a href="http://stackoverflow.com/questions/ask">stackoverflow.com</a>

现在，输出是：

<a href="http://stackoverflow.com/questions/ask">http://stackoverflow.com/questions/ask</a>

提前致谢！

Function create_links(strText)
    strText = " " & strText
    strText = ereg_replace(strText, "(^|[\n ])([\w]+?://[^ ,""\s<]*)", "$1<a href=""$2"">$2</a>")
    strText = ereg_replace(strText, "(^|[\n ])((www|ftp)\.[^ ,""\s<]*)", "$1<a href=""http://$2"">$2</a>")
    strText = right(strText, len(strText)-1)
    create_links = strText
end function

Function ereg_replace(strOriginalString, strPattern, strReplacement)
    ' Function replaces pattern with replacement
    dim objRegExp : set objRegExp = new RegExp
    objRegExp.Pattern = strPattern
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    ereg_replace = objRegExp.replace(strOriginalString, strReplacement)
    set objRegExp = nothing
end function

Answer 1

我终于使用以下代码解决了它：

Function create_links(strText)
    strText = " " & strText
    strText = MakeLink(strText, "http(s)?://([\w+?\.\w+])+([a-zA-Z0-9\~\!\@\#\$\%\^\&amp;\*\(\)_\-\=\+\\\/\?\.\:\;\'\,]*)?")
    create_links = strText
End function

Function MakeLink(txt, strPattern)
    Dim re, targetString, colMatch, objMatch
    Set re = New RegExp
    With re
      .Pattern = strPattern
      .Global = True
      .IgnoreCase = True
    End With 

    Set colMatch = re.Execute(txt)
    For each objMatch in colMatch
        matchedValue = right(objMatch.Value, len(objMatch.Value))
        if instr(matchedValue, "://") Then
        Else
            matchedValue = "http://" & matchedValue
        End If
        urlName = replace(replace(replace(matchedValue, "http://", ""), "https://", ""), "www.", "")
        If instr(urlName, "/") Then
            Arr = split(urlName, "/")
            urlName = Arr(0)
        End If
        urlName = UCase(Left(urlName,1)) & LCase(Right(urlName, Len(urlName) - 1))
        txt = replace(txt, objMatch.Value, " <a href=""" & matchedValue & """ target=""_blank"">" & urlName & "</a>")
    Next 
    MakeLink = txt
End Function

使用格式化的网址标题自动创建可点击的网址

1 个答案: