Forum Moderators: open
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