點擊帶格式的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標題

回答

相關問題