<%
Function LinkURLs(inText)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd
strBuf = ""
iStart = 1
iEnd = 1
inText = server.htmlencode(""& inText & "")
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", "")
Else
strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK")
End If
iStart = iEnd+objMatch.Length+1
Next
strBuf = strBuf & Mid(inText, iStart)
strBuf = Replace(strBuf,":)","<img src='images/smile.gif'>")
strBuf = Replace(strBuf,";)","<img src='images/wink.gif'>")
strBuf = Replace(strBuf,":(","<img src='images/sad.gif'>")
strBuf = Replace(strBuf,";(","<img src='images/reallysad.gif'>")
strBuf = Replace(strBuf,":-","<img src='images/angry.gif'>")
strBuf = Replace(strBuf,":|","<img src='images/less.gif'>")
LinkURLs = 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 & """>link</a> ]"
Else
strBuf = "[ <a href=""" & url & """ Target=""" & _
Target & """>link</a> ]"
End If
ElseIf UCase(urlType) = "EMAIL" Then
strBuf = "[ <a href=""mailto:" & url & """>email</a> ]"
End If
GetHref = strBuf
End Function
%>