'CLAN MOD START - find uncoded URLs and turn into clickable URLs
dim testMsg, testPos
testMsg = strMessage
'PRE-PROCESS STEPS (remove URLs which already have valid codes around them)
'remove images
lngStartPos = InStr(1, testMsg, "<img", 1)
While lngStartPos > 0
lngEndPos = Instr(lngStartPos, testMsg, ">", 1)
if lngEndPos = 0 then
lngEndPos = len(testMsg)+1
else
lngEndPos = lngEndPos + 1
end if
strMessageLink = Mid(testMsg,lngStartPos,lngEndPos-lngStartPos)
testMsg = replace(testMsg, strMessageLink, "")
lngStartPos = InStr(1, testMsg, "<img", 1)
Wend
'remove linked URLs
lngStartPos = InStr(1, testMsg, "<a", 1)
While lngStartPos > 0
lngEndPos = Instr(lngStartPos, testMsg, "</a", 1)
if lngEndPos = 0 then
lngEndPos = len(testMsg)+1
else
lngEndPos = lngEndPos + 4
end if
strMessageLink = Mid(testMsg,lngStartPos,lngEndPos-lngStartPos)
testMsg = replace(testMsg, strMessageLink, "")
lngStartPos = InStr(1, testMsg, "<a", 1)
Wend
'remove Flash links
lngStartPos = InStr(1, testMsg, "[flash", 1)
While lngStartPos > 0
lngEndPos = Instr(lngStartPos, testMsg, "[/flash", 1)
if lngEndPos = 0 then
lngEndPos = len(testMsg)+1
else
lngEndPos = lngEndPos + 8
end if
strMessageLink = Mid(testMsg,lngStartPos,lngEndPos-lngStartPos)
testMsg = replace(testMsg, strMessageLink, "")
lngStartPos = InStr(1, testMsg, "[flash", 1)
Wend
'look for uncoded URLs
lngStartPos = InStr(1, testMsg, "http://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "https://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "ftp://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "mailto:", 1)
While lngStartPos > 0
'determine full URL by finding the first "break" type character
lngEndPos = Instr(lngStartPos, testMsg, " ", 1)
testPos = Instr(lngStartPos, testMsg, " ", 1)
if lngEndPos = 0 or (testPos > 0 and testPos < lngEndPos) then lngEndPos = testPos
testPos = Instr(lngStartPos, testMsg, VbCr)
if lngEndPos = 0 or (testPos > 0 and testPos < lngEndPos) then lngEndPos = testPos
testPos = Instr(lngStartPos, testMsg, "<", 1)
if lngEndPos = 0 or (testPos > 0 and testPos < lngEndPos) then lngEndPos = testPos
if lngEndPos = 0 then 'no break character found, assume end of message
lngEndPos = len(testMsg)+1
end if
'extract link
strMessageLink = Mid(testMsg,lngStartPos,lngEndPos-lngStartPos)
'remove from test message so we don't process it again
testMsg = replace(testMsg, strMessageLink, "")
'turn into clickable URL in main message
strMessage = replace(strMessage,strMessageLink, "<a href=""" & strMessageLink & """>" & strMessageLink & "</a>", 1, -1, 1)
'look for next link
lngStartPos = InStr(1, testMsg, "http://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "https://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "ftp://", 1)
if lngStartPos = 0 then lngStartPos = InStr(1, testMsg, "mailto:", 1)
wend
'CLAN MOD END - find uncoded URLs and turn into clickable URLs
|
Topic Options
Post Options
Thanks(0)
