点击带格式的URL标题

自动保持URL我用下面的代码来自动创建我的琴弦链接。但我怎么转换像一个链接：点击带格式的URL标题

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

来源

2014-12-01 Thaven

'objRegExp.replace（ “> HTTP：//”， “>”）'会摆脱'为http：// '在链接文字。添加'>'到REPLACE语句应确保href属性不受影响 – John 2014-12-01 23:31:02

我终于用下面的代码解决了这个问题：

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

来源

2015-04-15 13:01:57 Thaven

点击带格式的URL标题

回答

相关问题