Time Out - Mod - Posted (2064 Views)
Panhandler
Average Member
Panhandler
Posts: 783
783
I need a mod that will allow the admin to limit a user's account to only one post in a 10-day period until the "time out" is lifted from the user's account.
A $25 USD donation will be made to Snitz Forums for a working "time out" mod.

Last edited by Panhandler on 13 June 2010, 12:47
 Sort direction, for dates DESC means newest first  
 Page size 
Posted
Carefree
Advanced Member
Carefree
Posts: 4224
4224
If nobody else has already done so, I'll write it this afternoon.
Here: TimeOut
This has not been tested.
Last edited by Carefree on 13 June 2010, 20:36
Posted
Panhandler
Average Member
Panhandler
Posts: 783
783
Wow. . .fast work! Thanks. I'm testing now. admin_timeout.asp:
Line 81 is missing a "
Lines 133 & 136 are missing a )

Got them cured but now I'm stuck at line 212 with this error
Microsoft VBScript runtime error '800a000d'

Type mismatch: 'WriteFooter'
Oops. . .never mind - got it. There was a & _ before the WriteFooter. Still testing. . .
/campfire/admin_timeout.asp, line 212
Last edited by Panhandler on 14 June 2010, 10:04
Posted
HuwR
Forum Admin
HuwR
Posts: 20611
20611
could be missing an include, maybe inc_footer ?

MVC .net dev/test site | Snitz .NET Core running on Raspberry Pi

Posted
Panhandler
Average Member
Panhandler
Posts: 783
783
Originally posted by HuwR
could be missing an include, maybe inc_footer ?

The line prior to WriteFooter wasn't terminated. Still testing. . .
Posted
Panhandler
Average Member
Panhandler
Posts: 783
783
Now I'm really stuck. Sql problem now getting this error:

Microsoft OLE DB Provider for ODBC Drivers error '80040e14'

[MySQL][ODBC 3.51 Driver][mysqld-5.0.90-community-nt-log]You have an error in your SQL syntax; check the manual that corresponds to your MySQL server version for the right syntax to use near '' at line 1

/campfire/admin_timeout.asp, line 133
The dbs file looks pretty simple straight forward:
TimeOut 1.0

[ALTER] MEMBERS
ADD#TIMEOUT#INT#NULL#
[END]
Posted
Carefree
Advanced Member
Carefree
Posts: 4224
4224
I'll try and get it tested this afternoon and fix what ails it.
Posted
HuwR
Forum Admin
HuwR
Posts: 20611
20611
in admin_timeout.asp, look for this code
Code:

strSql="UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=1 WHERE M_NAME=" & strMember
there will be 2 instances around line 133ish

change it to the following (both instances)

Code:

strSql="UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=1 WHERE M_NAME='" & strMember & "'"

MVC .net dev/test site | Snitz .NET Core running on Raspberry Pi

Posted
Panhandler
Average Member
Panhandler
Posts: 783
783

The suggested code change helped. Here's what I got implemented now:

if Request.Form("Method_Type")="TimeSet" then
my_Conn.Execute("UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=1 WHERE M_NAME='" & Request.QueryString("Member") & "'")
SendBadMail
elseif Request.Form("Method_Type")="TimeRel" then
my_Conn.Execute("UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=0 WHERE M_NAME='" & Request.QueryString("Member") & "'")
SendRelMail
else |Full text code here|

Now have a new error:
ADODB.Field error '800a0bcd'

Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.
/campfire/admin_timeout.asp, line 93 The member is not deleted and I've tried it on three different members.
Posted
Carefree
Advanced Member
Carefree
Posts: 4224
4224
Zip file on SnitzBitz has been replaced with working code.
Replace "admin_timeout.asp" with the following:

Code:

<%
'###############################################################################
'##
'##			Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-06 Michael Anderson, Pierre Gorissen,
'##			Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output.	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 an 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:
'##
'##			Free Software Foundation, Inc.
'##			59 Temple Place, Suite 330
'##			Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'##			http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'##			manderson@snitz.com
'##
'###############################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<!--#INCLUDE FILE="inc_func_admin.asp" -->
<%
if Session(strCookieURL & "Approval") <> "15916941253" then
	scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
	Response.Redirect "admin_login.asp?target=" & scriptname(ubound(scriptname))
end if
Response.Write	"	<table border=""0"" width=""100%"">" & vbNewLine & _
	"		<tr>" & vbNewLine & _
	"			<td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
	"			" & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
	"			" & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpen,"","") & " <a href=""admin_home.asp"">Admin Section</a><br />" & vbNewLine & _
	"			" & getCurrentIcon(strIconBlank,"","") & getCurrentIcon(strIconBar,"","") & getCurrentIcon(strIconFolderOpenTopic,"","") & " Timeout Management<br /></font></td>" & vbNewLine & _
	"		</tr>" & vbNewLine & _
	"	</table>" & vbNewLine
dim tmpStrNames
tmpStrNames=""
if mLev < 3 then
	Response.Write	"<P><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b><a href=""default.asp"">No Access.  Returning to the forums.</a></b></font></p>" & vbNewLine & _
		"<meta http-equiv=""Refresh"" content=""2; URL=default.asp"">" & vbNewLine
end if
strMember=Request.Form("Member")
if Request.Form("Method_Type")="TimeSet" then
	strSql="UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=1 WHERE M_NAME='" & strMember & "'"
	my_Conn.Execute(strSql)
	SendBadMail
	Response.Write	"<meta http-equiv=""Refresh"" content=""2; URL=admin_timeout.asp"">" & vbNewLine
	Response.End
elseif Request.Form("Method_Type")="TimeRel" then
	strSql="UPDATE "& strMemberTablePrefix &"MEMBERS SET TIMEOUT=0 WHERE M_NAME='" & strMember & "'"
	my_Conn.Execute(strSql)
	SendRelMail
	Response.Write	"<meta http-equiv=""Refresh"" content=""2; URL=admin_timeout.asp"">" & vbNewLine
	Response.End
else
	Response.Write	"	<table width=""75%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">" & vbNewLine & _
		"		<tr>" & vbNewLine & _
		"			<td width=""100%"" bgcolor=""" & strPopUpBorderColor & """>" & vbNewLine & _
		"				<table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"">" & vbNewLine & _
		"					<tr valign=""middle"">" & vbNewLine & _
		"						<td align=""center"" width=""100%"" bgcolor=""" & strHeadCellColor & """>" & vbNewLine & _
		"							<font face=""" & strHeaderFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strHeadFontColor & """><b><br>Members on TimeOut<br> </b>" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr valign=""top"">" & vbNewLine & _
		"						<td width=""100%"" bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
		"							<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>" & vbNewLine
	strSql="SELECT M_NAME, MEMBER_ID, TIMEOUT FROM "& strMemberTablePrefix & "MEMBERS WHERE TIMEOUT = 1 ORDER BY M_NAME"
	set rsTimeOut=my_Conn.Execute(strSql)
	if not rsTimeOut.EOF and not rsTimeOut.BOF then
		rsTimeOut.MoveFirst
		Do while not rsTimeOut.EOF
			if tmpStrNames = "" then
				tmpStrNames = rsTimeOut("M_NAME")
			else
				tmpStrNames = tmpStrNames + rsTimeOut("M_NAME")
			end if
			rsTimeOut.MoveNext
		Loop
		Response.Write	tmpStrNames
		rsTimeOut.close	
	end if
	set rsTimeOut = Nothing
	Response.Write	"								</font>" & vbNewLine & _
		"						<br> </td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"					<tr>" & vbNewLine & _
		"						<td width=""100%"" bgcolor=""" & strForumCellColor & """>" & vbNewLine & _
		"								<form action=""admin_timeout.asp"" method=""post"" name=""TimeOut"">" & vbNewLine & _
		"									<input type=""hidden"" value=""TimeRel"" name=""Method_Type"">" & vbNewLine & _
		"										<table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">" & vbNewLine & _
		"											<tr>" & vbNewLine & _
		"												<td width=""100%"" align=""center"" bgcolor=""" & CategoryCellColor & """> <br>" & vbNewLine & _
		"													<input type=""text"" name=""Member"" size=""75"" maxlength=""75"">" & vbNewLine & _
		"													</input>" & vbNewLine & _
		"												</td>" & vbNewLine & _
		"											</tr>" & vbNewLine & _
		"											<tr valign=""middle"">" & vbNewLine & _
		"												<td width=""100%"" bgColor=""" & strForumCellColor & """ align=""center""><input type=""submit"" value=""Release From TimeOut"" id=""submit1"" name=""submit1"">" & vbNewLine & _
		"												</td>" & vbNewLine & _
		"											</tr>" & vbNewLine & _
		"										</table>" & vbNewLine & _
		"									</input>" & vbNewLine & _
		"								</form>" & vbNewLine & _
		"								<form action=""admin_timeout.asp"" method=""post"" name=""TimeOut"">" & vbNewLine & _
		"									<input type=""hidden"" value=""TimeSet"" name=""Method_Type"">" & vbNewLine & _
		"										<table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"">" & vbNewLine & _
		"											<tr>" & vbNewLine & _
		"												<td width=""100%"" align=""center"" bgcolor=""" & CategoryCellColor & """>" & vbNewLine & _
		"													<input type=""text"" name=""Member"" size=""75"" maxlength=""75"">" & vbNewLine & _
		"													</input>" & vbNewLine & _
		"												</td>" & vbNewLine & _
		"											</tr>" & vbNewLine & _
		"											<tr valign=""middle"">" & vbNewLine & _
		"												<td width=""100%"" bgColor=""" & strForumCellColor & """ align=""center""><input type=""submit"" value=""Place on TimeOut"" id=""submit1"" name=""submit1"">" & vbNewLine & _
		"												</td>" & vbNewLine & _
		"											</tr>" & vbNewLine & _
		"										</table>" & vbNewLine & _
		"									</input>" & vbNewLine & _
		"								</form>" & vbNewLine & _
		"							</font>" & vbNewLine & _
		"						</td>" & vbNewLine & _
		"					</tr>" & vbNewLine & _
		"				</table>" & vbNewLine & _
		"			</td>" & vbNewLine & _
		"		</tr>" & vbNewLine & _
		"	</table>" & vbNewLine & _
		"<p><center><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b><a href=""default.asp"">Return to Forums</a></b></font></center></p>" & vbNewLine
end if
WriteFooter

Function SendRelMail
	strSql = "SELECT M_EMAIL, M_NAME FROM " & strMemberTablePrefix & "MEMBERS " &_
		"WHERE M_NAME = '" & Request.Form("Member") & "'"
	set rsMail = my_Conn.Execute(strSql)
	strRecipients = rsMail("M_EMAIL")
	strRecipientsName = rsMail("M_NAME")
	strFrom = strForumTitle
	strSubject = "Release From TimeOut"
	strMessage = "You have been released from TimeOut on " & strForumURL & ".  You can now post regularly again."
	strExcon=strRecipientsName
	%>
	<!--#INCLUDE FILE="inc_mail.asp" -->
	<%
	'##  Administrator Notification ##
	strRecipients = strSender
	strRecipientsName = strForumTitle
	strFrom = strSender
	strFromName = strForumTitle
	strSubject = strForumTitle & " TimeOut Action"
	strMessage = "<a href="&strForumURL&"pop_profile.aspmode=display&id="&Request.Form("Member") & """>"&strRecipientsName&" has been released from TimeOut.</a>" & vbNewLine
	%>
	<!--#INCLUDE FILE="inc_mail.asp" -->
	<%
	rsMail.close
	set rsMail = nothing
End Function

Function SendBadMail
	strSql = "SELECT M_EMAIL, M_NAME FROM " & strMemberTablePrefix & "MEMBERS " &_
		"WHERE M_NAME = '" & Request.Form("Member") & "'"
	set rsMail = my_Conn.Execute(strSql)
	strRecipients = rsMail("M_EMAIL")
	strRecipientsName = rsMail("M_NAME")
	strFrom = strForumTitle
	strSubject = "TimeOut"
	strMessage = "Your account on " & strForumTitle & " has had its posting limits restricted "
	strMessage = strMessage & "until the moderators or administrators are satisfied.  "
	strMessage = strMessage & "You will be limited to one post per 10 days.  "
	strMessage = strMessage & "Please post any questions/comments/rebuttals to the issue to the administrators.  "
	strMessage = strMessage &	"Do not reply to this message, this service is not monitored."
	%>
	<!--#INCLUDE FILE="inc_mail.asp" -->
	<%
	'	##  Administrator Notification ##
	strRecipients = strSender
	strRecipientsName = strForumTitle
	strFrom = strSender
	strFromName = strForumTitle
	strSubject = strForumTitle & " TimeOut Action"
	strMessage = "<a href="&strForumURL&"pop_profile.aspmode=display&id="&Request.Form("Member") & """>"&strRecipientsName&" has been placed on TimeOut.</a>" & vbNewLine
	%>
	<!--#INCLUDE FILE="inc_mail.asp" -->
	<%
	rsMail.close
	set rsMail = nothing
End Function
%>

Replace "inc_timeout.asp" with the following:

Code:

<%
'###############################################################################
'##
'## 	                Snitz Forums 2000 v3.4.07
'##
'###############################################################################
'##
'## Copyright © 2000-06 Michael Anderson, Pierre Gorissen,
'## 	                Huw Reddick and Richard Kinser
'##
'## This program is free. You can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; either version 2 or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in
'## the scripts and in the HTML output.  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 an 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:
'##
'##		        Free Software Foundation, Inc.
'##		        59 Temple Place, Suite 330
'##		        Boston, MA 02111-1307
'##
'## Support can be obtained from our support forums at:
'##
'## 		        http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to:
'##
'## 		        manderson@snitz.com
'##
'###############################################################################
set TimeOut = Server.CreateObject("ADODB.Recordset")
strSql = "SELECT TIMEOUT FROM " & strMemberTablePrefix & "MEMBERS WHERE TIMEOUT = 1 AND MEMBER_ID = " & MEMBERID
set rsTimeOut = my_Conn.Execute(strSql)
if not rsTimeOut.EOF then
	rsTimeOut.Close
	Response.Write	"<table align=""center"" color=""" & trPageBGColor & """ width=""100%"">" & vbNewLine & _
		"	<tr valign=""middle"">" & vbNewLine & _
		"		<td align=""center"" width=""100%"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine & _
		"			<font face=""" & strCategoryFontFace & """ size=""" & strHeaderFontSize & """ color=""" & strCategoryFontColor & """> <br>System Announcement<br> " & vbNewLine & _
		"			</font>" & vbNewLine & _
		"		</td>" & vbNewLine & _
		"	</tr>" & vbNewLine & _
		"	<tr valign=""middle"">" & vbNewLine & _
		"		<td align=""center"" width=""100%"" bgcolor=""" & strCategoryCellColor & """>" & vbNewLine & _
		"			<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strDefaultFontColor & """>Sorry, your account is on ""timeout"".  You are limited to one post per 10 days.  Your last post was on:  """ & StrToDate(strLastPostDate) & """<br><br>" & vbNewLine & _
		"			</font>" & vbNewLine & _
		"			<a href=""javascript: history.go(-1)"">Back</a>" & vbNewLine & _
		"		</td>" & vbNewLine & _
		"	</tr>" & vbNewLine & _
		"</table>" & vbNewLine
	Response.End
end if
set rsTimeOut=Nothing
%>
Last edited by Carefree on 23 July 2010, 03:14
Posted
Panhandler
Average Member
Panhandler
Posts: 783
783
Yea! That's working now! smile Thanks Carefree. . .!
This should be a very handy mod for restricting without censoring when/if things become heated.
I think that just the threat of being on "time out" should calm some postings.
You Must enter a message