<% '################################################################################# '## Snitz Forums 2000 v3.4.05 '################################################################################# '## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen, '## Huw Reddick and Richard Kinser '## '## This program is free software; you can redistribute it and/or '## modify it under the terms of the GNU General Public License '## as published by the Free Software Foundation; either version 2 '## of the License, or (at your option) any later version. '## '## All copyright notices regarding Snitz Forums 2000 '## must remain intact in the scripts and in the outputted HTML '## The "powered by" text/logo with a link back to '## http://forum.snitz.com in the footer of the pages MUST '## remain visible when the pages are viewed on the internet or intranet. '## '## This program is distributed in the hope that it will be useful, '## but WITHOUT ANY WARRANTY; without even the implied warranty of '## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the '## GNU General Public License for more details. '## '## You should have received a copy of the GNU General Public License '## along with this program; if not, write to the Free Software '## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. '## '## Support can be obtained from our support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## manderson@snitz.com '## '################################################################################# %> <% if Session(strCookieURL & "Approval") <> "15916941253" then scriptname = split(request.servervariables("SCRIPT_NAME"),"/") Response.Redirect "admin_login_short.asp?target=" & scriptname(ubound(scriptname)) end if strRqMethod = trim(chkString(Request.QueryString("method"),"SQLString")) intBadwordID = trim(chkString(Request.QueryString("B_ID"),"SQLString")) if intBadwordID <> "" then if isNumeric(intBadwordID) <> True then intBadwordID = "0" end if strPageSize = 10 mypage = trim(chkString(request("whichpage"),"SQLString")) if ((mypage = "") or (IsNumeric(mypage) = FALSE)) then mypage = 1 mypage = cLng(mypage) Response.Write " " & vbNewLine Select Case strRqMethod Case "Add" if Request.Form("Method_Type") = "Write_Configuration" then Err_Msg = "" txtBadword = chkBString(Request.Form("strBadword"),"SQLString") txtReplace = chkBString(Request.Form("strReplace"),"SQLString") if txtBadword = " " then Err_Msg = Err_Msg & "
  • You Must Enter a Badword.
  • " end if if txtBadword = "" then Err_Msg = Err_Msg & "
  • You Must Enter a Badword.
  • " end if if (Instr(txtBadword, " ") > 0 ) then Err_Msg = Err_Msg & "
  • Two or more consecutive spaces are not allowed in the Badword.
  • " end if if txtReplace = " " then Err_Msg = Err_Msg & "
  • You Must Enter a Replacement word for the Badword.
  • " end if if txtReplace = "" then Err_Msg = Err_Msg & "
  • You Must Enter a Replacement word for the Badword.
  • " end if if (Instr(txtReplace, " ") > 0 ) then Err_Msg = Err_Msg & "
  • Two or more consecutive spaces are not allowed in the Replacement word.
  • " end if if Err_Msg = "" then '## Forum_SQL - Do DB Update strSql = "INSERT INTO " & strFilterTablePrefix & "BADWORDS (" strSql = strSql & "B_BADWORD" strSql = strSql & ", B_REPLACE" strSql = strSql & ") VALUES (" strSql = strSql & "'" & txtBadword & "'" strSql = strSql & ", '" & txtReplace & "'" strSql = strSql & ")" my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords Application.Lock Application(strCookieURL & "STRBADWORDWORDS") = "" Application(strCookieURL & "STRBADWORDREPLACE") = "" Application.UnLock Response.Write "

    Badword Added!

    " & vbNewLine & _ " " & vbNewLine & _ "

    Congratulations!

    " & vbNewLine & _ "

    Back To Badword Filter Configuration

    " & vbNewLine else Response.Write "

    There Was A Problem With Your Details

    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
      " & Err_Msg & "
    " & vbNewLine & _ "

    Go Back To Enter Data

    " & vbNewLine end if end if Case "Delete" if Request.Form("Method_Type") = "Delete_Badword" then '## Forum_SQL - Delete badword from Badwords table strSql = "DELETE FROM " & strFilterTablePrefix & "BADWORDS " strSql = strSql & " WHERE B_ID = " & Request.Form("B_ID") my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords Application.Lock Application(strCookieURL & "STRBADWORDWORDS") = "" Application(strCookieURL & "STRBADWORDREPLACE") = "" Application.UnLock Response.Write "

    Badword Deleted!

    " & vbNewLine & _ " " & vbNewLine & _ "

    Back To Badword Filter Configuration

    " & vbNewLine else Response.Write "
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "

    Are you sure?

    " & vbNewLine & _ "

     

    " & vbNewLine & _ "
    " & vbNewLine end if Case "Edit" if Request.Form("Method_Type") = "Write_Configuration" then txtBadword = chkBString(Request.Form("strBadword"),"SQLString") txtReplace = chkBString(Request.Form("strReplace"),"SQLString") if txtBadword = " " then Err_Msg = Err_Msg & "
  • You Must Enter a Badword.
  • " end if if (Instr(txtBadword, " ") > 0 ) then Err_Msg = Err_Msg & "
  • Two or more consecutive spaces are not allowed in the Badword.
  • " end if if txtReplace = " " then Err_Msg = Err_Msg & "
  • You Must Enter a Replacement word for the Badword.
  • " end if if (Instr(txtReplace, " ") > 0 ) then Err_Msg = Err_Msg & "
  • Two or more consecutive spaces are not allowed in the Replacement word.
  • " end if if Err_Msg = "" then '## Forum_SQL - Do DB Update strSql = "UPDATE " & strFilterTablePrefix & "BADWORDS " strSql = strSql & " SET B_BADWORD = '" & txtBadword & "'" strSql = strSql & ", B_REPLACE = '" & txtReplace & "'" strSql = strSql & " WHERE B_ID = " & Request.Form("B_ID") my_Conn.Execute (strSql),,adCmdText + adExecuteNoRecords Application.Lock Application(strCookieURL & "STRBADWORDWORDS") = "" Application(strCookieURL & "STRBADWORDREPLACE") = "" Application.UnLock Response.Write "

    Badword Filter Updated!

    " & vbNewLine & _ " " & vbNewLine & _ "

    Congratulations!

    " & vbNewLine & _ "

    Back To Badword Filter Configuration

    " & vbNewLine else Response.Write "

    There Was A Problem With Your Details

    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
      " & Err_Msg & "
    " & vbNewLine & _ "

    Go Back To Enter Data

    " & vbNewLine end if else '## Forum_SQL - Get Badword/Replacement word from DB strSql = "SELECT B_ID, B_BADWORD, B_REPLACE " strSql = strSql & " FROM " & strFilterTablePrefix & "BADWORDS " strSql = strSql & " WHERE B_ID = " & intBadwordID set rs = my_Conn.Execute (strSql) TxtBadword = rs("B_BADWORD") TxtReplace = rs("B_REPLACE") intB_ID = rs("B_ID") rs.close set rs = nothing Response.Write "
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    Edit Badword
    BadwordReplacement
    " & vbNewLine & _ "
    " & vbNewLine & _ "
    " & vbNewLine & _ "

    Back To Badword Filter Configuration

    " & vbNewLine end if Case Else '## Forum_SQL - Get Badwords from DB strSql = "SELECT B_ID, B_BADWORD, B_REPLACE " strSql2 = " FROM " & strFilterTablePrefix & "BADWORDS " strSql3 = " ORDER BY B_BADWORD ASC " if strDBType = "mysql" then 'MySql specific code if mypage > 1 then OffSet = cLng((mypage - 1) * strPageSize) strSql4 = " LIMIT " & OffSet & ", " & strPageSize & " " end if '## Forum_SQL - Get the total pagecount strSql1 = "SELECT COUNT(B_ID) AS PAGECOUNT " set rsCount = my_Conn.Execute(strSql1 & strSql2) iPageTotal = rsCount(0).value rsCount.close set rsCount = nothing If iPageTotal > 0 then maxpages = (iPageTotal \ strPageSize ) if iPageTotal mod strPageSize <> 0 then maxpages = maxpages + 1 end if if iPageTotal < (strPageSize + 1) then intGetRows = iPageTotal elseif (mypage * strPageSize) > iPageTotal then intGetRows = strPageSize - ((mypage * strPageSize) - iPageTotal) else intGetRows = strPageSize end if else iPageTotal = 0 maxpages = 0 end if if iPageTotal > 0 then set rs = Server.CreateObject("ADODB.Recordset") rs.open strSql & strSql2 & strSql3 & strSql4, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText arrBadwordData = rs.GetRows(intGetRows) iBadwordCount = UBound(arrBadwordData, 2) rs.close set rs = nothing else iBadwordCount = "" end if else 'end MySql specific code set rs = Server.CreateObject("ADODB.Recordset") rs.cachesize = strPageSize rs.open strSql & strSql2 & strSql3, my_Conn, adOpenStatic If not (rs.EOF or rs.BOF) then rs.movefirst rs.pagesize = strPageSize rs.absolutepage = mypage '** maxpages = cLng(rs.pagecount) arrBadwordData = rs.GetRows(strPageSize) iBadwordCount = UBound(arrBadwordData, 2) else iBadwordCount = "" end if rs.Close set rs = nothing end if Response.Write "

    Bad Word Filter Configuration

    " & vbNewLine Response.Write "
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine if maxpages > 1 then Call DropDownPaging() else Response.Write " " & vbNewLine end if Response.Write " " & vbNewLine if iBadwordCount = "" then '## No Badwords found in DB Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine else bB_ID = 0 bB_BADWORD = 1 bB_REPLACE = 2 rec = 1 intI = 0 for iBadword = 0 to iBadwordCount if (rec = strPageSize + 1) then exit for Badword_ID = arrBadwordData(bB_ID, iBadword) Badword_Badword = arrBadwordData(bB_BADWORD, iBadword) Badword_Replace = arrBadwordData(bB_REPLACE, iBadword) if intI = 1 then CColor = strAltForumCellColor else CColor = strForumCellColor end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine rec = rec + 1 intI = intI + 1 if intI = 2 then intI = 0 end if next end if Response.Write " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ " " & vbNewLine & _ "
    BadwordReplacement 
    No Badwords Found
    " & Badword_Badword & "" & Badword_Replace & "" & getCurrentIcon(strIconPencil,"Edit Badword","hspace=""0""") & " " & getCurrentIcon(strIconTrashcan,"Delete Badword","hspace=""0""") & "
    " & vbNewLine & _ "
    " & vbNewLine & _ "
    " & vbNewLine End Select WriteFooterShort Response.End sub DropDownPaging() if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if Response.Write " " & vbNewLine & _ " Page  of " & maxpages & "" & vbNewLine end if end sub function chkBString(fString,fField_Type) '## Types - SQLString if fString = "" then fString = " " end if Select Case fField_Type Case "SQLString" fString = Replace(fString, "'", "''") if strDBType = "mysql" then fString = Replace(fString, "\0", "\\0") fString = Replace(fString, "\'", "\\'") fString = Replace(fString, "\""", "\\""") fString = Replace(fString, "\b", "\\b") fString = Replace(fString, "\n", "\\n") fString = Replace(fString, "\r", "\\r") fString = Replace(fString, "\t", "\\t") fString = Replace(fString, "\z", "\\z") fString = Replace(fString, "\%", "\\%") fString = Replace(fString, "\_", "\\_") end if fString = HTMLBEncode(fString) chkBString = fString exit function End Select chkBString = fString end function function HTMLBEncode(fString) if fString = "" or IsNull(fString) then fString = " " fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") HTMLBEncode = fString end function %>