Snitz Forums 2000
Snitz Forums 2000
Home | Profile | Register | Active Topics | Members | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?

 All Forums
 Snitz Forums 2000 MOD-Group
 MOD Add-On Forum (W/Code)
 Add-on to Forum Rules Mod
 New Topic  Reply to Topic
 Printer Friendly
Author Previous Topic Topic Next Topic  

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 13 July 2008 :  07:26:40  Show Profile  Reply with Quote
This mod allows you to have custom rules for all different member_levels.

Just replace your "rules.asp" with the one you want to use, renaming it to "rules.asp".

1. With "bi-rules", non-members will see only rules in Category 1. All members will see all categories.

2. With "multi-rules", non-members will see only rules in Category 1. Regular members will see categories 1 & 2. Moderators & above will see all categories.

Get it here: SnitzBitz<

Etymon
Advanced Member

United States
2383 Posts

Posted - 14 July 2008 :  20:40:40  Show Profile  Visit Etymon's Homepage  Reply with Quote
I haven't cracked it open yet, but I did download it.

I like the idea!

How does it agree with the Usergroups MOD?

I'm thinking along the lines of the Amnesty MOD and other similar MODs so that a set of special rules like say, "How to get out on good behavior" can be posted just for those folks.

Thank you for the MOD, Carefree!

Cheers,

Etymon
<
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 26 July 2008 :  01:31:04  Show Profile  Reply with Quote
I can make allowances for prisoners, too; so they'd have their own exclusive rules (they'd also see the regular member rules - so they could review their conduct accordingly). I'll modify this so that anyone who implemented the prisoner/amnesty/usergroup mods can change a single line and use it.

Sorry I didn't respond earlier, this particular post didn't get marked as new to me somehow.<

Edited by - Carefree on 26 July 2008 01:32:16
Go to Top of Page

Carefree
Advanced Member

Philippines
4207 Posts

Posted - 26 July 2008 :  02:44:04  Show Profile  Reply with Quote
Here are some updates to usergroup/prisoner/rules mods. First we have some instructions:

<%
' ############################ User Group Redirection ##############################
' ##
' ##  To block any page from prisoner's access (auto return to prison forum), change
' ## default.asp's usergroup assignment to a session variable, then enclose the page
' ## you wish to block with the following routine:
' ##
'   if Session("USERGROUP_ID") <> 1 then
'    rest of code here
'   else
'    Response.Redirect "Default.asp"
'   end if
' ##
' ##  Note:  do not block the following pages with this routine:
' ## config.asp, default.asp, login.asp, password.asp, forum.asp, post.asp, topic.asp, rules.asp, faq.asp, (any inc_*.asp page)
' ##
' ############################ User Group Redirection ##############################

Next, we have a slight change to the detection/assignment routine in default.asp (has to become a session variable):

' ############################# User Group Age Check Mod #############################
    strSQL = "SELECT M_NAME, MEMBER_ID, M_DOB FROM " & strTablePrefix & "MEMBERS " & _
             "WHERE MEMBER_ID = " & MemberID
    set rsAdult = Server.CreateObject("ADODB.Recordset")
    rsAdult.open strSql, my_Conn
    if not rsAdult.EOF then
     Member_DOB = rsAdult("M_DOB")
     MMAge = DateDiff("yyyy", DOBToDate(Member_DOB), Date)
    end if
  rsAdult.close
  set rsAdult = Nothing

  strSql = "SELECT USERGROUP_ID, MEMBER_ID, MEMBER_TYPE FROM " & strTablePrefix & "USERGROUP_USERS " &_
   "WHERE MEMBER_ID = " & MemberID
  Set rsGroups = Server.CreateObject("ADODB.Recordset")
  rsGroups.open strSql, my_Conn
  if rsGroups.EOF or rsGroups.BOF then
   'some error msg
  else
   USERGROUP_ID = rsGroups("USERGROUP_ID")
  end if
  rsGroups.close
  set rsGroups = Nothing

  if (USERGROUP_ID = 8) AND (MMAge > 20) then           'Note:  Usergroup ID 8 is used to restrict minors - change these two lines to whatever you use.
   USERGROUP_ID = 7                       '    Usergroup ID 7 is for normal members
   MEMBER_TYPE = 1
   strSql = "UPDATE " & strTablePrefix & "USERGROUP_USERS "
   strSql = strSql & " SET USERGROUP_ID = 7, MEMBER_TYPE = 1 "  'Again, change usergroup ID 7 to your normal members' usergroup ID
   strSql = strSql & " WHERE MEMBER_ID = " & MemberID & ";"
   Set rsClr = Server.CreateObject("ADODB.Recordset")
   rsClr.open strSql, strConnString
   if rsState = 1 then rsClr.close
   set rsClr = Nothing
  end if
  Session("UserGroup_ID") = USERGROUP_ID
' ############################# User Group Age Check Mod End #########################

Rules.asp changes to allow prisoners to have their own rules.

<%
'################################################################################
'## Snitz Forums 2000 v3.4.06
'################################################################################
'## Copyright (C) 2000-06 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
'##
'################################################################################
'################################################################################
'## MOD: Forum Rules v1.3 for Snitz Forums v3.4
'## Author: Michael Reisinger (OneWayMule)
'## File: rules.asp
'##
'## Get the latest version of this MOD at
'## http://www.onewaymule.org/onewayscripts/
'################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<%
'##### intDisplayMethod:
'### 0 - Displays all rules/categories on one page
'### 1 - Displays each Category on a seperate page

' ############################# PRISONER MOD ONLY #####################################
' ##  If using the prisoner mod, set the value below to a category limited to their use.
' ##
PRISON=4
' ##
' ##  Note:
' ## To prevent prisoners having access to any specific page, change the default.asp's
' ## variable assignment to a session variable and then enclose the page to be blocked
' ## with the following code (eliminating the remark apostrophes):
' ##
' ## if Session("USERGROUP_ID") <> 1 then
' ##  rest of code here
' ## else
' ##  Response.Redirect "Default.asp"
' ## end if
' ##
' ########################### PRISONER MOD ONLY END ###################################

if Request.QueryString("ID") <> "" and IsNumeric(Request.QueryString("ID")) = True then
 intMemberID = cLng(Request.QueryString("ID"))
else
 intMemberID = 0
end if

Const intDisplayRulesMethod = 0

Sub DisplayRulesCat(cat_id)
 strsql = "SELECT RULES_ID, RULES_TITLE, RULES_DESCRIPTION, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE RULES_CAT=" & cat_id & " ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
 Set frs = my_conn.execute(strsql)
 If frs.EOF Or frs.BOF Then
  Response.Write  " <tr>" & vbNewLine & _
   "  <td bgcolor=""" & strForumCellColor & """ align=""center"">" & vbNewLine & _
   "   <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>No Rules found.</font>" & vbNewLine & _
   "  </td>" & vbNewLine & _
   " </tr>" & vbNewLine
 Else
  Response.Write  "  <ul>" & vbNewLine
  Do Until frs.EOF
   Response.Write  "   <tr>" & vbNewLine & _
    "    <td bgcolor=""" & strCategoryCellColor & """><a href=""#top"">" & getCurrentIcon(strIconGoUp,"Go To Top Of Page","align=""right""") & "</a>" & vbNewLine & _
    "     <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """>" & vbNewLine & _
    "     <b><a name=""rulesid" & frs("RULES_ID") & """>" & ChkString(frs("RULES_TITLE"),"display") & "</a></b></font>" & vbNewLine & _
    "    </td>" & vbNewLine & _
    "   </tr>" & vbNewLine & _
    "   <tr>"  & vbNewLine & _
    "    <td bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
    "     <font size=" & strDefaultFontSize & " face=""" & strDefaultFontFace & """ color=""" & strDefaultFontColor & """>" & vbNewLine & _
    "     <p>" & formatStr(frs("RULES_DESCRIPTION")) & "</p></font>" & vbNewLine & _
    "    </td>" & vbNewLine & _
    "   </tr>" & vbNewLine
  frs.Movenext
  Loop
 End if
 frs.close
End Sub

strAction = Request.QueryString("cat")

If strAction = "" then
 If mLev=0 then Response.Write "<br />" & vbNewLine
 Response.Write "<table width=""100%"" border=""0"">" & vbNewLine & _
  " <tr>" & vbNewLine & _
  "  <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
  "  " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Forum Rules</font>" & vbNewLine & _
  "  </td>" & vbNewLine & _
  " </tr>" & vbNewLine & _
  "</table>" & vbNewLine & _
  "<table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
  " <tr>" & vbNewLine & _
  "  <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
  "   <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _
  "    <tr>" & vbNewLine & _
  "     <td bgcolor=""" & strHeadCellColor & """ class=""header"">" & vbNewLine & _
  "      <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """>" & vbNewLine & _
  "      <b>Forum Rules</b></font>" & vbNewLine & _
  "     </td>" & vbNewLine & _
  "    </tr>" & vbNewLine & _
  "    <tr>" & vbNewLine & _
  "     <td bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
  "     <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine & _
  "     <br /><ul>" & vbNewLine
 If mLev = 0 then
   strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE RCAT_ID=1 ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
  elseif (mLev > 0 and mLev< 3) then
   strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE RCAT_ID<3 ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   if Session("USERGROUP_ID") = 1 then
    strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE (RCAT_ID<3 OR RCAT_ID=" & PRISON & ") ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   end if
 else
   strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
  end if
  Set crs = my_conn.Execute(strsql)
  If crs.EOF Or crs.BOF Then
    Response.Write  "     No Categories found." & vbNewLine
  Else
    Do Until crs.EOF
      If intDisplayRulesMethod = 1 then
        strRulesLink = "rules.asp?cat=" & crs("RCAT_ID")
      Else
        strRulesLink = ""
      End If
      Response.Write  "     <li><span class=""spnMessageText""><a href=""" & strRulesLink & "#catid" & crs("RCAT_ID") & " ""><b>" & ChkString(crs("RCAT_TITLE"),"display") & "</b></a></span>" & vbNewLine
 If mLev = 0 then
    strsql = "SELECT RULES_ID, RULES_TITLE, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE RULES_CAT=1 ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
  elseif (mLev > 0 and mLev< 3) then
  if Session("USERGROUP_ID") <> 1 then
     strsql = "SELECT RULES_ID, RULES_TITLE, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE (RULES_CAT=" & crs("RCAT_ID") & " AND RULES_CAT<3) ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
  else
     strsql = "SELECT RULES_ID, RULES_TITLE, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE (RULES_CAT=" & crs("RCAT_ID") & " AND (RULES_CAT<3 OR RULES_CAT=" & PRISON & ")) ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
   end if
  else
    strsql = "SELECT RULES_ID, RULES_TITLE, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE RULES_CAT=" & crs("RCAT_ID") & " ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
 end if
      Set frs = my_conn.execute(strsql)
      If frs.EOF Or frs.BOF Then
        Response.Write "     <br />No Rules found.</li>" & vbNewLine
      Else
        Response.Write "     <ul>" & vbNewLine
        Do Until frs.EOF
          Response.Write "     <li><span class=""spnMessageText""><a href=""" & strRulesLink& "#rulesid" & frs("RULES_ID") & " "">" & ChkString(frs("RULES_TITLE"),"display") & "</a></span></li>" & vbNewLine
          frs.Movenext
        Loop
        Response.Write "     </ul></li>" & vbNewLine
      End if
      frs.close
      Set frs = nothing
      crs.Movenext
      Response.Write "     <br />" & vbNewLine
    Loop
    Response.Write "     </ul>" & vbNewLine
  End If
    Response.Write "     </font></p>" & vbNewLine & _
   "     </td>" & vbNewLine & _
   "    </tr>" & vbNewLine
  If intDisplayRulesMethod = 0 then
   if mLev = 0 then
     strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE RCAT_ID=1 ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   elseif (mLev > 0 and mLev< 3) then
     strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE RCAT_ID<3 ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   if Session("USERGROUP_ID") = 1 then
    strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE (RCAT_ID<3 OR RCAT_ID=" & PRISON & ") ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   end if
  else
     strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
   end if
    Set crs = my_conn.Execute(strsql)
    If crs.EOF Or crs.BOF Then
      '## Do Nothing...
    Else
      Do Until crs.EOF
        Response.Write "    <tr>" & vbNewLine & _
         "     <td bgcolor=""" & strHeadCellColor & """ class=""header""><a href=""#top"">" & getCurrentIcon(strIconGoUp,"Go To Top Of Page","align=""right""") & "</a>" & vbNewLine & _
         "     <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """>" & vbNewLine & _
         "     <b><a name=""catid" & crs("RCAT_ID") & """>" & ChkString(crs("RCAT_TITLE"),"display") & "</a></b>" & vbNewLine & _
         "     </font>" & vbNewLine & _
         "     </td>" & vbNewLine & _
          "    </tr>" & vbNewLine
        Call DisplayRulesCat(crs("RCAT_ID"))
        Set frs = nothing
        crs.Movenext
      Loop
    End If
  End If
Else
  strsql = "SELECT RCAT_ID, RCAT_TITLE, RCAT_ORDER FROM " & strTablePrefix & "RULES_CATEGORY WHERE RCAT_ID=" & strAction & " ORDER BY RCAT_ORDER ASC, RCAT_TITLE ASC"
  Set crs = my_conn.Execute(strsql)
  If crs.EOF Or crs.BOF Then
    Response.Redirect("rules.asp")
  End If
  Response.Write "   <table width=""100%"" border=""0"">" & vbNewLine & _
   "    <tr>" & vbNewLine & _
    "     <td><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
  "     " & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""rules.asp"">Forum Rules</a><br />" & vbNewLine & _
  "     " & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " " & ChkString(crs("RCAT_TITLE"),"display") & "</font>" & vbNewLine & _
  "     </td>" & vbNewLine & _
  "    </tr>" & vbNewLine & _
  "   </table>" & vbNewLine & _
  "   <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewLine & _
  "    <tr>" & vbNewLine & _
  "     <td bgcolor=""" & strTableBorderColor & """>" & vbNewLine & _
  "      <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"">" & vbNewLine & _
  "       <tr>" & vbNewLine & _
  "        <td bgcolor=""" & strHeadCellColor & """ class=""header"">" & vbNewLine & _
  "        <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """>" & vbNewLine & _
  "        <b>" & ChkString(crs("RCAT_TITLE"),"display") & "</b></font>" & vbNewLine & _
  "        </td>" & vbNewLine & _
  "       </tr>" & vbNewLine & _
  "       <tr>" & vbNewLine & _
  "        <td bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
  "        <p><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strForumFontColor & """>" & vbNewLine & _
  "        <br />" & vbNewLine
  strsql = "SELECT RULES_ID, RULES_TITLE, RULES_ORDER, RULES_CAT FROM " & strTablePrefix & "RULES WHERE RULES_CAT=" & strAction & " ORDER BY RULES_ORDER ASC, RULES_TITLE ASC"
  Set frs = my_conn.execute(strsql)
  If frs.EOF Or frs.BOF Then
    Response.Write "        No Rules found.</li>" & vbNewLine
  Else
    Response.Write  "        <ul>" & vbNewLine
    Do Until frs.EOF
      Response.Write "        <li><span class=""spnMessageText""><a href=""" & strRulesLink& "#rulesid" & frs("RULES_ID") & " "">" & ChkString(frs("RULES_TITLE"),"display") & "</a></span></li>" & vbNewLine
      frs.Movenext
    Loop
    Response.Write  "        </ul>" & vbNewLine
  End if
  frs.close
  Set frs = nothing
  Response.Write  "        </font></p>" & vbNewLine & _
   "        </td>" & vbNewLine & _
   "       </tr>" & vbNewLine
  Call DisplayRulesCat(strAction)
End If
Response.Write  "      </table>" & vbNewLine & _
 "     </td>" & vbNewLine & _
 "    </tr>" & vbNewLine & _
 "   </table>" & vbNewLine & _
 "   <br />" & vbNewLine & _
 "  </td>" & vbNewLine & _
 " </tr>" & vbNewLine & _
 "</table>"
WriteFooter
Response.End
%>

Edited by - Carefree on 26 July 2008 02:48:52
Go to Top of Page
  Previous Topic Topic Next Topic  
 New Topic  Reply to Topic
 Printer Friendly
Jump To:
Snitz Forums 2000 © 2000-2021 Snitz™ Communications Go To Top Of Page
This page was generated in 0.11 seconds. Powered By: Snitz Forums 2000 Version 3.4.07