Det står ju klart och tydligt vad som gör vad. Antingen tar du bort allt utom raden som "Kollar efter länkar", eller ännu hellre, använd funktionen "checkForLinks" direkt, i ställer för "checkText"
Frågan#1
Har en drös med funktioner i denna kod, men vill bara ha den som formaterar "http://" till en länk när texten skrivs ut.
Vad ska jag ta bort?
'Formatterar text från databasen
function checkText(forumText)
'Radbrytning
forumText = replace(forumText, chr(13), "<br>")
forumText = Replace(forumText, "[app]", "'")
'Skapar intendering
forumText = replace(forumText, chr(32)&chr(32)&chr(32), " ")
'Söksträng markeras
if not request.querystring("search") = "" then
if not InStr(1, lcase(forumText), request.querystring("search")) = 0 then
forumText = replace(lcase(forumText), request.querystring("search"), "<span>" & request.querystring("search") & "</span>")
end if
end if
'Fet stil
forumText = replace(forumText, "[b]", "<b>")
forumText = replace(forumText, "[/b]", "</b>")
forumText = replace(forumText, "[B]", "<b>")
forumText = replace(forumText, "[/B]", "</b>")
'Kursiv stil
forumText = replace(forumText, "[i]", "<i>")
forumText = replace(forumText, "[/i]", "</i>")
forumText = replace(forumText, "[I]", "<i>")
forumText = replace(forumText, "[/I]", "</i>")
'Understruken stil
forumText = replace(forumText, "[u]", "<u>")
forumText = replace(forumText, "[/u]", "</u>")
forumText = replace(forumText, "[U]", "<u>")
forumText = replace(forumText, "[/U]", "</u>")
'Centrerad stil
forumText = replace(forumText, "[c]", "<center>")
forumText = replace(forumText, "[/c]", "</center>")
forumText = replace(forumText, "[C]", "<center>")
forumText = replace(forumText, "[/C]", "</center>")
'Kollar efter länkar
forumText = checkForLinks(forumText)
'Kollar efter länkar till polare
forumText = encode(forumText)
checkText = forumText
end function
Function encode(mess)
Set objRegExp = New regexp
objRegExp.Global = true
objRegExp.IgnoreCase = true
mess = mess
objRegExp.Pattern = "\[m](.*?)\[/m\]"
mess = objRegExp.Replace(mess,"<a href=""send.asp?what=touser&username=$1""><b>$1</b></a>")
encode = mess
End Function
Function checkForLinks(strInput)
dim intStartPos, intStopPos, intPos
dim strChar, strURL, strShowURL
dim bolFin
dim intRoof, k
dim arrURL
dim strOrg
strOrg = strInput
intRoof = 100
bolFin = false
k = 0
do until bolFin = true or k = intRoof
if not instr(1, strInput, "http://") = 0 then
intStartPos = instr(1, strInput, "http://")
intStopPos = len(strInput) + 1
for i = intStartPos to intStopPos
if i = intStopPos then
strChar = mid(strInput, i, 1)
bolFin = true
exit for
else
strChar = mid(strInput, i, 1)
end if
strURL = strURL & strChar
select case strChar
case " ",")","(","[","{","!"
strURL = left(strURL, len(strURL) - 1) & ","
if not mid(strInput, i, intStopPos) = strInput then
strInput = mid(strInput, i, intStopPos)
else
bolFin = true
end if
exit for
end select
next
else
bolFin = true
end if
k = k + 1
loop
strURL = replace(strURL, "<br>", ",")
if right(strURL, 1) = "," then
strURL = left(strURL, len(strURL) - 1)
end if
strURL = trim(strURL)
arrURL = split(strURL, ",")
for i = 0 to ubound(arrURL)
if asc(arrURL(i)) = 10 then
arrURL(i) = right(arrURL(i), len(arrURL(i)) - 1)
elseif right(arrURL(i), 1) = "." then
arrURL(i) = left(arrURL(i), len(arrURL(i)) - 1)
end if
if not arrURL(i) = "" then
if left(arrURL(i), 7) = "http://" then
strShowURL = arrURL(i)
strOrg = replace(strOrg, arrURL(i), "<a href=""" & replace(replace(arrURL(i), "<span>", ""), "</span>", "") & """ target=""_blank""><b>" & replace(strShowURL, "http://", "") & "</b></a>")
end if
end if
next
checkForLinks = strOrg
End Function
'Översätter svenska tecken till kod och tvärtom
function translateChars(tcStr, tcWay)
select case tcWay
case 0 'Svenska till kod
tcStr = replace(tcStr, "å", "å")
tcStr = replace(tcStr, "Å", "Å")
tcStr = replace(tcStr, "ä", "ä")
tcStr = replace(tcStr, "Ä", "Ä")
tcStr = replace(tcStr, "ö", "ö")
tcStr = replace(tcStr, "Ö", "Ö")
case 1 'Kod till svenska
tcStr = replace(tcStr, "å", "å")
tcStr = replace(tcStr, "Å", "Å")
tcStr = replace(tcStr, "ä", "ä")
tcStr = replace(tcStr, "Ä", "Ä")
tcStr = replace(tcStr, "ö", "ö")
tcStr = replace(tcStr, "Ö", "Ö")
end select
translateChars = tcStr
end function
'Ersätter ej tillåtna tecken
function cleanString(csStr)
csStr = replace(csStr, "'", "")
cleanString = csStr
end function
response.write checkText(server.HTMLEncode(rs("presentation")))