")
Str=Replace(Str, CHR(10), "
")
ReFormatted = "
" & Str & "
" End Function Function VetInput(cTestString) ' checks for HTML or profanities in a string ' each 'library!' word is searched for in the string ' if any of the library words are surrounded with text, then the word is passed (eg 'scunthorpe') ' if the word is at the beginning or end of another word, then it is blocked. VetInput = "OK" If (Instr(cTestString,"<") > 0 and Instr(cTestString,"<") > 0) then VetInput = "html" Else Dim aProf,Profanity, Suffix, Prefix,pointer, offset, alphachars aProf = Array("bum","tit","crap","fuck","phuck","tosser","fuk","bollo","cunt","bastard","wank","shit","wank","wog","coon","arse") Profanity = "" alphachars = "abcdefghijklmnopqrstuvwxyzABSDEFGHIJKLMNOPQRSTUVWXYZ" cTestString = " " & cTestString & " " ' insert a space at each end of the string For pointer = 0 To UBound(aProf) - 1 offset = InStr(UCase(cTestString), UCase(aProf(pointer))) If offset > 0 Then Prefix = Mid(cTestString, offset - 1, 1) Suffix = Mid(cTestString, offset + Len(aProf(pointer)), 1) If InStr(alphachars, Prefix) > 0 And InStr(alphachars, Suffix) > 0 Then ' it's embedded in another word, so we'll take a chance Else Profanity = Mid(cTestString, offset, Len(aProf(pointer))) Exit For End If End If Next If Len(Profanity) > 0 Then VetInput = "suspect" 'VetInput = "sorry, your entry contained the word " & Profanity & " and cannot be saved." End If End If End Function %> <%function VetMessage If not (Editor or Master) then VetString = request("Subject") & request("MsgText") If (Instr(VetString,"<") > 0 and Instr(VetString,"<") > 0) then VetMessage = "Sorry, you cannot use HTML, please try again" Response.Write "" Response.end end if End if end function function EditButtons if guest then reminder="Please note, with Guest User access, your message will not appear until it has been checked by the Moderator"%> <%else %> <%end if %> <% end function function EditPointers %>")
StrText=Replace(StrText, CHR(10), "
")
if Instr(StrText,"www") > 0 then
safety = 1
do while true
BoundaryChars = " <>," 'potential characters bounding a passive href link string
for n = 1 to len(BoundaryChars)
FoundAt = InStr(StrText,mid(BoundaryChars,n,1)&"www.")
If Foundat > 0 then StrText = ActivateLinks(StrText,BoundaryChars)
FoundAt = InStr(StrText,mid(BoundaryChars,n,1)&"http://")
If FoundAt > 0 then StrText = ActivateLinks(StrText,BoundaryChars)
next
if n >= len(BoundaryChars) then
if left(StrText,4) = "www." or left(StrText,7) = "http://" then
StrText = ActivateLinks(StrText,BoundaryChars)
end if
exit do
end if
safety = safety+1
if safety >= 20 then ' escape route, just in case !
response.write("*
")
exit do
end if
loop
end if
FormatMessage = "
" & StrText & "
" end function function ActivateLinks(StrText,BoundaryChars) for n=1 to len(BoundaryChars) FoundAt = InStr(StrText,mid(BoundaryChars,n,1)&"www.") If Foundat > 0 then CheckStr = mid(StrText,Foundat-16,7) exit for end if FoundAt = InStr(StrText,mid(BoundaryChars,n,1)&"http://") If Foundat > 0 then CheckStr = mid(StrText,Foundat-8,7) exit for end if next if FoundAt = 0 then ' check if the href text is right at the start of the message text if left(StrText,4) = "www." or left(StrText,7) = "http://" then FoundAt = 1 end if if FoundAt > 0 and CheckStr <> " 0 'find the pos of the first char of the string with www in it if TestChar = 1 then ' if href is right at the start StartChar = TestChar exit do elseif InStr(BoundaryChars,mid(StrText,TestChar,1)) > 0 then StartChar = TestChar + 1 exit do else TestChar = TestChar-1 end if loop TestChar = FoundAt+1 do while TestChar <= len(StrText) ' find the last char of the string if InStr(BoundaryChars,mid(StrText,TestChar,1)) > 0 then EndChar = TestChar - 1 exit do elseif TestChar = len(StrText) then ' if href is right at the end EndChar = TestChar exit do else TestChar = TestChar+1 end if loop if StartChar > 0 and EndChar > 0 then LinkStr = mid(StrText,StartChar,EndChar-StartChar+1) if left(LinkStr,7) = "http://" then LinkStr = mid(LinkStr,8) ' trim off the http if already there OutStr = left(StrText,StartChar-1) &_ ""& chr(11)& "http://" & LinkStr & "" &_ mid(StrText,EndChar+1) ' the string after the link end if StrText = OutStr '& "StartChar= " & StartChar & ", EndChar= " & EndChar & "LinkStr= " & LinkStr end if ActivateLinks = StrText End Function %><% if Editor or Master then select case Request("pagemode") case "publish","hide" OpenOleConn(datadir&"npc_forums.mdb") set rs = Server.CreateObject("ADODB.Recordset") sqlStr = "select checked from tblMessages WHERE MsgID = " & Request("msgid") & " " rs.Open sqlStr, objConn, 2, 3 if Request("pagemode") = "publish" then rs("checked") = 2 else rs("checked") = 0 end if rs.update case "deletemessage" OpenOleConn(datadir&"npc_forums.mdb") objConn.execute("delete from tblmessages where msgid=" & request("msgid")) closedata() response.redirect("forums.asp") end select end if OpenOleConn(datadir&"npc_forums.mdb") set rs = Server.CreateObject("ADODB.Recordset") if editor or master then sqlStr = "select * from tblMessages WHERE ReplyID = " & Request("replyID") & " order by msgID " else sqlStr = "select * from tblMessages WHERE (ReplyID = " & Request("replyID") & " and checked > 0) order by msgID " end if rs.Open sqlStr, objConn, 2, 3 If lForumID >= 0 and lForumID < ubound(mForumNames,1)-1 then mBullet = mForumNames(lForumID,1) else mBullet = "" end if %>
Forums
/ "><%=mForumNames(rs("ForumID"),0)%>
/ "<%=rs("Subject")%>"
(message threads are listed in date order, with the most recent replies at the bottom)
| <%=rs("fromname")%> on <%=formatdatetime(rs("dateposted"),2)%> at <%=formatdatetime(rs("dateposted"),4)%> <%Author = false if gUserID = rs("AuthorID") and gUserID > 0 then Author = true if Editor or Master or Author then %> ">edit<% end if if Editor or Master then if rs("checked") = 2 then%> &ReplyID=<%=rs("ReplyID")%>">hide <%else %> &ReplyID=<%=rs("ReplyID")%>">publish <%end if %> ');">delete <%end if %> |
|
||
|
" class="ar">send a reply |