The Forum has been Updated
The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.
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<
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<
Posted
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
<
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
<
Posted
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.<
Sorry I didn't respond earlier, this particular post didn't get marked as new to me somehow.<
Posted
Here are some updates to usergroup/prisoner/rules mods. First we have some instructions:
Next, we have a slight change to the detection/assignment routine in default.asp (has to become a session variable):
Rules.asp changes to allow prisoners to have their own rules.
Code:
<%
' ############################ 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 ##############################
Code:
' ############################# 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 #########################
Code:
<%
'################################################################################
'## 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
%>