Forum Moderators: open

Message Too Old, No Replies

autolink using regex and classic asp

I know it's been done a thousand times

         

dataguy

7:31 pm on Feb 14, 2007 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



I need to be able to find URL's in text and add anchor tags to turn them into clickable links on a web page. The site uses classic ASP.

I know it's been done thousands of times, but after an hour of searching I can't locate the code... any help would be greatly appreciated.

mattglet

4:03 am on Feb 15, 2007 (gmt 0)

WebmasterWorld Senior Member 10+ Year Member



Here's one that's not bulletproof, but is good nonetheless. If you have any improvements, let me know. Apologies in advance for the poor comments... I built this a lifetime ago. (I broke the RegEx into multiple lines for readability)

function ActivateURLs(strInput)
dim objRegEx
dim objMatches
dim match
dim strProtocol
dim strReturn
dim intCheck

strProtocol = ""
intCheck = 0
set objRegEx = new RegExp

objRegEx.Pattern = "((((ht¦f)tp(s?))\://)?(www.¦[a-zA-Z].)[a-zA-Z0-9\-\.]+\.(ac¦as¦be¦biz¦ca¦cc¦com¦co.il¦co.uk¦co.nz¦co.za¦com.ru¦com.ph¦
de¦dk¦edu¦fm¦gs¦gov¦il¦info¦jp¦kz¦lt¦ms¦mil¦museum¦nz¦net¦net.nz¦
name¦org¦org.il¦org.nz¦org.uk¦ph¦pro¦ro¦sh¦st¦tc¦to¦tv¦uk¦us¦vg¦vu¦
ws¦za)(\:[0-9]+)*(/($¦[a-zA-Z0-9\.\,\;\?\'\\\+&%\$#\=~_\-]+))*[^\<\.\,\)\(\s])"
objRegEx.IgnoreCase = true
objRegEx.Global = true

set objMatches = objRegEx.Execute(strInput)

if objMatches.count > 0 then
for each match in objMatches
'--- see if the value already has a protocol attached to it
if left(lcase(match.value), 7) = "http://" then
strProtocol = "http://"
elseif left(lcase(match.value), 8) = "https://" then
strProtocol = "https://"
elseif left(lcase(match.value), 6) = "ftp://" then
strProtocol = "ftp://"
end if

'--- if no protocol, see if there's already the same URL present
if strProtocol = "" then
intCheck = instr(1, strInput, "http://" & trim(match.value))
end if

'--- the replace function gets all the matching URLs, so you don't always have to find it
if intCheck = 0 then
strInput = replace(strInput, trim(match.value), AddHTTP(trim(match.value)))
end if
next
end if

strReturn = objRegEx.Replace(strInput, " <a href=""$1"" rel = ""nofollow"" target = ""_blank"">$1</a>")

set objRegEx = nothing

ActivateURLs = strReturn
end function