To read the article online, visit http://www.4GuysFromRolla.com/webtech/tips/t110900-1.shtml

User Tips: Converting URLs into Hyperlinks


By Wallace

I just finished reading Designing Active Server Pages and was inspired by the regular expressions section. I would like to contribute some code... two functions which are fresh out of the oven!

These functions are to cater for web content stored in a database where URLs & email address are part of the content. The function uses Regular Expression to search and replace URLs and Email address and turn them into viable hyperlinks...

The main function, InsertHyperlinks, has the following definition:

InsertHyperlinks(inText)

The function returns a modified version of inText, replacing all URLs and email addresses with hyperlinks! The needed code is displayed below... be sure to give the live demo a whirl too! (To learn more about regular expressions (which the functions below use heavily) check out the: Regular Expressions Article Index
'----------------------------------------------
' InsertHyperlinks(inText)
' Returns a inText with "<a href="URL" target="_BLANK">URL</a>"
' inserted where there is URL found.
'
' URL can start with "www" or "http"
' or
' URL can be a email address "*@*"
'----------------------------------------------
Function InsertHyperlinks(inText)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd

  strBuf = ""
  iStart = 1
  iEnd = 1
  Set objRegExp = New RegExp

  objRegExp.Pattern = "\b(www|http|\S+@)\S+\b"  ' Match URLs and emails
  objRegExp.IgnoreCase = True                   ' Set case insensitivity.
  objRegExp.Global = True                       ' Set global applicability.
  Set objMatches = objRegExp.Execute(inText)
  For Each objMatch in objMatches
    iEnd = objMatch.FirstIndex
    strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1)
    If InStr(1, objMatch.Value, "@") Then
      strBuf = strBuf & GetHref(objMatch.Value, "EMAIL", "_BLANK")
    Else
      strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK")
    End If
    iStart = iEnd+objMatch.Length+1
  Next
  strBuf = strBuf & Mid(inText, iStart)
  InsertHyperlinks = strBuf
End Function


Function GetHref(url, urlType, Target)
Dim strBuf

  strBuf = "<a href="""
  If UCase(urlType) = "WEB" Then
    If LCase(Left(url, 3)) = "www" Then
      strBuf = "<a href=""http://" & url & """ Target=""" & _
               Target & """>" & url & "</a>"
    Else
      strBuf = "<a href=""" & url & """ Target=""" & _
               Target & """>" & url & "</a>"
    End If
  ElseIf UCase(urlType) = "EMAIL" Then
    strBuf = "<a href=""mailto:" & url & """ Target=""" & _
             Target & """>" & url & "</a>"
  End If
  
  GetHref = strBuf

End Function
[
View a live demo!]

For an alternative way to accomplish this, check out: URL Linker Code Sample. This example uses VBScript string functions, not Regular Expressions...

Happy Programming!

Return to user tips...


Article Information
Article Title: User Tips: Converting URLs into Hyperlinks
Article Author: Wallace
Article URL: http://www.4GuysFromRolla.com/webtech/tips/t110900-1.shtml


Copyright 2017 QuinStreet Inc. All Rights Reserved.
Legal Notices, Licensing, Permissions, Privacy Policy.
Advertise | Newsletters | E-mail Offers