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:
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!
