<%
'#################################################################################
'## Ver.3.4.07 multi-language Skin3D Portal V2
'#################################################################################
'## Copyright (C) 2001-07 Gaëtan Dupont All Rights Reserved
'##
'## By using this program, you are agreeing to the terms of the
'## GNU General Public License.
'##
'## 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 ImageForums2001 must remain intact
'## in the scripts and in the outputted HTML.
'## The "Image Forums 2001" text with a link back to 
'## http://www.forums2001.ca in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## Support can be obtained from support forums at:
'## http://www.forums2001.ca
'##
'## Email: image_forum_2001@hotmail.com
'##
'#################################################################################
'## This Page Contains source code of Snitz Forums 2000
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## 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
'##
'#################################################################################
%>
<% 
Dim activetab, activeborder, inactivetab, smallcalendar, largecalendarcell, stylecolor, CalAltForumCellColor, CalDefaultFontColor 
if strStylesCss = "1" and getStyles = "2" then
   activetab = "style=""background-color:" & strHeadCellColor & """"
   activeborder = "style=""background-color:" & strHeadCellColor & """"
   inactivetab = "style=""background-color:" & strAltForumCellColor & """"
   smallcalendar = "class=""smallcalendar"""
   largecalendarcell = "bgColor=""" & strAltForumCellColor & """ class=""largecalendarcell"""
   stylecolor = "style=""color:" & strForumFontColor & """"
   CalAltForumCellColor = strAltForumCellColor
   CalDefaultFontColor = strDefaultFontColor
else
   activetab = "class=""activetab"""
   activeborder = "class=""activetab"""
   inactivetab = "class=""inactivetab"""
   smallcalendar = "class=""smallcalendarbody"""
   largecalendarcell = "class=""strPopUpTableColor"""
   stylecolor = ""
   CalAltForumCellColor = ""
   CalDefaultFontColor = ""
end if

'############################################################################
 Sub DrawMonth(dateToDraw, enableHiLite, enableArrows, enableYearDisplay) '##
'############################################################################

'### Create a table, then write the name of the month and the year ###
Response.Write 	"<table border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
		"	<tr>" & vbNewLine & _
		"	  <td " & TableBorderColor1 & ">" & vbNewLine & _
		"	    <table border=""0"" " & Cellspacing & " cellpadding=""0"">" & vbNewLine & _
		"	      <tr align=""center"">" & vbNewLine & _
		"	        <td " & CategoryCellColor & ">" & vbNewLine
		if enableArrows = "1" then Response.Write 	"	<a href=cal.asp?rand=" & int(10000000*rnd) & "&sectionid=1&date=" & DateAdd("m", -1, datetoDraw) & ">" & getCurrentIcon(strIconLeftArrow,fLang("strLangCla00360"),"") & "</a>&nbsp;" & vbNewLine
Response.Write	"	<a href=""cal.asp?rand=" & int(10000000*rnd) & "&sectionid=1&view=monthly&date="& dateToDraw & """ style=""text-decoration:none"">" & vbNewLine & _
		"	<b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & CategoryFontColor & ">" & MonthName(Month(dateToDraw))
		if enableYearDisplay = "1" then Response.Write  "&nbsp;" & Year(dateToDraw)
Response.Write	"</font></b></a>" & vbNewLine
		if enableArrows = "1" then Response.Write 	"&nbsp;<a href=cal.asp?rand=" & int(10000000*rnd) & "&sectionid=1&date=" & DateAdd("m", 1, datetoDraw) & ">" & getCurrentIcon(strIconRightArrow,fLang("strLangCla00370"),"") & "</a>" & vbNewLine
Response.Write	"	        </td>" & vbNewLine & _
		"	      </tr>" & vbNewLine & _
		"	      <tr>" & vbNewLine & _
		"	        <td>" & vbNewLine & _
		"	          <table width=""158px"" " & smallcalendar & " cellspacing=""0"" cellpadding=""0"">" & vbNewLine

'### Generate the days of the week ###
Response.Write	"<tr>" & vbNewLine
Dim intDays, dayofWeek
dayofWeek = cLng(intFirstDayofWeekNum) - 1
For intDays=vbSunday To vbSaturday
	Response.Write 	"	<td><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & Left(WeekDayName(dayofWeek mod 7 + 1),1) & "</font></td>" & vbNewLine
	dayofWeek = dayofWeek + 1
Next
Response.Write	"</tr>" & vbNewLine

'### Get the first day of the month ###
Dim dateHolder
dateHolder = DateSerial(Year(dateToDraw), Month(dateToDraw), 1)

'### If first day of the month is not Sunday (or Monday or whatever) step back to the last Sunday (Monday or whatever) of the previous month ###
Do while Weekday(dateHolder) <> cLng(intFirstDayofWeekNum)
	dateHolder = DateAdd("d", -1, dateHolder)
Loop

strSql = "SELECT T_EVENT_DATE " & _
            "FROM " & strTablePrefix & "TOPICS " & _
            "WHERE (T_ISEVENT=1) " & _
            "AND (T_EVENT_DATE >= '" & datetostr(DateSerial(Year(dateToDraw),Month(dateToDraw),1)) & "') " & _
            "AND (T_EVENT_DATE < '" & datetostr(DateSerial(Year(dateToDraw),Month(dateToDraw)+1,1)) & "') " & _
            "ORDER BY T_EVENT_DATE ASC"

Set rs = Server.CreateObject("ADODB.Recordset")
rs.CursorLocation=AdUseClient
rs.open strSql, My_conn, adOpenStatic
intEventsforMonth=rs.recordcount

'### There are as many as 6 weeks in a month! ###
for i=1 to 6
	Response.Write "<tr>" & vbNewLine

	For intDays=vbSunday To vbSaturday
		Response.Write 	"	<td"
		if dateHolder=dateTodraw and enablehilite=1 then 
			Response.write " class=""dateselected""" 
		end if
		Response.Write "><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>"

		'### Don't draw the date if it doesn't fall within the month ###
		if dateHolder > dateSerial(Year(dateToDraw), Month(dateToDraw), 1-1) and dateHolder < dateSerial(Year(dateToDraw), Month(dateToDraw)+1, 1) then
			isevent=false

			'### Determine if the date is an event. Improved code a bit. ###

			'### Get events for current date ###

			'### Count the Events for this date ###
			if intEventsforMonth > 0 then
				rs.filter=0
				rs.filter="T_EVENT_DATE='" & DateToStr(dateHolder) & "'"
				if not(rs.EOF) then isevent=true
			end if

			if dateHolder=DateValue(strForumTimeAdjust) then Response.write " <div id=""datetoday"">"

			Response.Write "<a href=""cal.asp?rand=" & int(10000000*rnd) & "&date=" & dateHolder & """>"

			if isevent then Response.Write "<span class=""isevent"">"

			Response.Write Day(dateHolder)

			if isevent then Response.Write "</span>"
			Response.Write	"</a>" 



			if dateHolder=DateValue(strForumTimeAdjust) then Response.write " </div>"
		end if

		dateHolder=DateAdd ("d",1,dateHolder)
		Response.Write "</font></td>" & vbNewLine
	Next

	Response.Write "</tr>" & vbNewLine
next

rs.Close
Set rs = nothing
Response.Write	"	          </table>" & vbNewLine & _
		"	        </td>" & vbNewLine & _
		"	      </tr>" & vbNewLine & _
		"	    </table>" & vbNewLine & _
		"	  </td>" & vbNewLine & _
		"	</tr>" & vbNewLine & _
		" </table>" & vbNewLine
end sub '### DrawMonth ###

'############################################################################
 sub DrawMonthWeekly(dateToDraw) '##
'############################################################################

'### Create a table, then write the name of the month and the year ###
Response.Write 	"<table border=""0"" cellspacing=""0"" cellpadding=""0"">" & vbNewLine & _
		"	<tr>"  & vbNewLine & _
		"	  <td " & TableBorderColor1 & ">" & vbNewLine & _
		"	    <table border=""0"" " & Cellspacing & " cellpadding=""0"">" & vbNewLine & _
		"	      <tr align=""center"">" & vbNewLine & _
		"	        <td " & CategoryCellColor & "><a href=cal.asp?rand=" & int(10000000*rnd) & "&view=weekly&date=" & DateAdd("m", -1, datetoDraw) & ">" & getCurrentIcon(strIconLeftArrow,fLang("strLangCla00360"),"") & "</a>&nbsp;" & vbNewLine & _
		"	        <a href=""cal.asp?rand=" & int(10000000*rnd) & "&view=monthly&date="& dateToDraw & """ style=""text-decoration:none"">" & vbNewLine & _
		"	        <b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ " & CategoryFontColor & ">" & MonthName(Month(dateToDraw)) & "&nbsp;" & Year(dateToDraw) & "</font></b></a>" & vbNewLine & _
		"	        &nbsp;<a href=cal.asp?rand=" & int(10000000*rnd) & "&view=weekly&date=" & DateAdd("m", 1, datetoDraw) & ">" & getCurrentIcon(strIconRightArrow,fLang("strLangCla00370"),"") & "</a>" & vbNewLine & _
		"	        </td>" & vbNewLine & _
		"	      </tr>" & vbNewLine & _
		"	      <tr>" & vbNewLine & _
		"	        <td>" & vbNewLine & _
		"	          <table width=""158px"" " & smallcalendar & " cellspacing=""0"" cellpadding=""0"">" & vbNewLine

'### Generate the days of the week ###
Response.Write	"<tr>" & vbNewLine
Dim intDays, dayofWeek
dayofWeek = cLng(intFirstDayofWeekNum) - 1
For intDays=vbSunday To vbSaturday
	Response.Write 	"	<td><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & Left(WeekDayName(dayofWeek mod 7 + 1),1) & "</font></td>" & vbNewLine
	dayofWeek = dayofWeek + 1
Next
Response.Write	"</tr>" & vbNewLine

'### Get the first day of the month ###
Dim dateHolder
dateHolder = DateSerial(Year(dateToDraw), Month(dateToDraw), 1)

'### If first day of the month is not Sunday (or Monday or whatever) step back to the last Sunday (Monday or whatever) of the previous month ###
Do while Weekday(dateHolder) <> cLng(intFirstDayofWeekNum)
	dateHolder = DateAdd("d", -1, dateHolder)
Loop

strSql = "SELECT T_EVENT_DATE " & _
            "FROM " & strTablePrefix & "TOPICS " & _
            "WHERE (T_ISEVENT=1) " & _
            "AND (T_EVENT_DATE >= '" & datetostr(DateSerial(Year(dateToDraw),Month(dateToDraw),1)) & "') " & _
            "AND (T_EVENT_DATE < '" & datetostr(DateSerial(Year(dateToDraw),Month(dateToDraw)+1,1)) & "') " & _
            "ORDER BY T_EVENT_DATE ASC"

Set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, My_conn, adOpenStatic
intEventsforMonth=rs.recordcount

firstdayofWeek = dateToDraw
do while Weekday(firstdayofweek) <> cLng(intFirstDayofWeekNum)
	firstdayofWeek = DateAdd("d",-1,firstdayofWeek)
loop


'### There are as many as 6 weeks in a month! ###
do while dateHolder < dateSerial(Year(dateToDraw),Month(dateToDraw)+1,1)
	Response.Write	"<tr>" & vbNewLine

	For intDays=vbSunday To vbSaturday
		Response.Write 	"<td"
		if dateHolder >= firstdayofweek and dateHolder<= firstdayofweek+6 then Response.Write " class=dateselected"
		Response.Write   "><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>"

			isevent=false

			'### Determine if the date is an event. Improved code a bit. ###

			'### Get events for current date ###

			'### Count the Events for this date ###
			if intEventsforMonth > 0 then
				rs.filter=0
				rs.filter="T_EVENT_DATE='" & DateToStr(dateHolder) & "'"
				if not(rs.EOF) then isevent=true
			end if

			if dateHolder=DateValue(strForumTimeAdjust) then Response.write " <div id=""datetoday"">"

			Response.Write "<a href=""cal.asp?rand=" & int(10000000*rnd) & "&view=weekly&date=" & dateHolder & """>"

			if dateHolder < dateSerial(Year(dateToDraw), Month(dateToDraw), 1) or dateHolder > dateSerial(Year(dateToDraw), Month(dateToDraw)+1, 1-1) then
				Response.Write "<span class=""datedisabled"">"
			elseif isevent then 
				Response.Write "<span class=""isevent"">"
			end if
			

			Response.Write Day(dateHolder)

			if isevent or dateHolder > dateSerial(Year(dateToDraw), Month(dateToDraw), 1) or dateHolder < dateSerial(Year(dateToDraw), Month(dateToDraw)+1, 1-1) then 
				Response.Write "</span>"
			end if

			Response.Write	"</a>" 



			if dateHolder=DateValue(strForumTimeAdjust) then Response.write " </div>"

		dateHolder=DateAdd ("d",1,dateHolder)
		Response.Write "</font></td>" & vbNewLine
	Next

	Response.Write "</tr>" & vbNewLine
loop

rs.Close
Set rs = nothing
Response.Write	"	          </table>" & vbNewLine & _
		"	        </td>" & vbNewLine & _
		"	      </tr>" & vbNewLine & _
		"	    </table>" & vbNewLine & _
		"	  </td>" & vbNewLine & _
		"	</tr>" & vbNewLine & _
		" </table>" & vbNewLine
end sub '### DrawMonth ###
'#######################################################
 sub WriteUpcomingEvents                             '##
'#######################################################

strSql = "SELECT "
if strDBtype = "access" or strDBtype = "sqlserver" then strSql = strSql & "TOP " & intEventstoDisplay & " "
strSql = strSql & "T.TOPIC_ID, " & _
                  "T.T_SUBJECT, " & _
                  "T.FORUM_ID, " & _
                  "T.T_STATUS, " & _
                  "T.T_EVENT_DATE, " & _
                  "C.CAT_MODERATION, " & _
                  "F.F_MODERATION " & _
          "FROM " & strTablePrefix & "TOPICS T, " & _
                    strTablePrefix & "CATEGORY C, " & _
                    strTablePrefix & "FORUM F " & _
          "WHERE T.T_ISEVENT=1 " & _
          "AND   T_EVENT_DATE > '" & datetostr(DateValue(strForumTimeAdjust)) & "' " & _
          "AND   F.FORUM_ID = T.FORUM_ID " & _
          "AND   C.CAT_ID = T.CAT_ID " & _
          "ORDER BY T.T_EVENT_DATE ASC"

Set rs = Server.CreateObject("ADODB.Recordset")
if strDBtype = "mysql" then rs.MaxRecords = intEventstoDisplay
rs.open strSql, My_conn

Response.Write "<ul style=""list-style: square inside; margin:5px;"">"
if rs.EOF then
	Response.Write "<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & fLang("strLangCla00160") & "</font></li>" & vbNewLine
else do while not rs.eof
	Topic_ID = rs("TOPIC_ID")
	Topic_Subject = rs("T_SUBJECT")
	Forum_ID = rs("FORUM_ID")
	Topic_Status = rs("T_STATUS")
	Event_Date = StrToDate(rs("T_EVENT_DATE"))
	Cat_Moderation = rs("CAT_MODERATION")
	Forum_Moderation = rs("F_MODERATION")

	'###########  Check for access ###########
	if mLev = 4 then
		AdminAllowed = 1
		ForumChkSkipAllowed = 1
	elseif mLev = 3 then
		if chkForumModerator(Forum_ID, chkString(strDBNTUserName,"decode")) = "1" then
			AdminAllowed = 1
			ForumChkSkipAllowed = 1
		else
			if lcase(strNoCookies) = "1" then
				AdminAllowed = 1
				ForumChkSkipAllowed = 0
			else
				AdminAllowed = 0
				ForumChkSkipAllowed = 0
			end if
		end if
	elseif lcase(strNoCookies) = "1" then
 		AdminAllowed = 1
		ForumChkSkipAllowed = 0
	else   
 		AdminAllowed = 0
		ForumChkSkipAllowed = 0
	end if

	if strPrivateForums = "1" and ForumChkSkipAllowed <> "1" then
		forumAccess = ChkForumAccess(Forum_ID, MemberID, false)
	else
		forumAccess = true
	end if
	
	if strModeration > 0 and Cat_Moderation > 0 and Forum_Moderation > 0 and AdminAllowed = 0 then
        	Moderation = "Y"
	else
        	Moderation = "N"
	end if
	'#########################################

	if forumAccess and not(Moderation = "Y" and Topic_Status > 1 and Topic_Author <> MemberID) then
		Response.Write	"<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & MonthName(Month(Event_Date)) & "&nbsp;" & Day(Event_Date) & "<br />-" & vbNewLine & _
				"<span class=""spnMessageText""><a href=""topic.asp?rand=" & int(10000000*rnd) & "&topic_ID=" & Topic_ID & """>" & Topic_Subject & "</a></span></font></li>"
	end if
	rs.movenext
	loop 
end if

Response.Write "</ul>"
rs.Close
Set rs = nothing
end sub '### WriteUpcomingEvents ###
'#######################################################
 Sub WriteRecentEvents                               '##
'#######################################################
strSql = "SELECT "
if strDBtype = "access" or strDBtype = "sqlserver" then strSql = strSql & "TOP " & intEventstoDisplay & " "
strSql = strSql & "T.TOPIC_ID, " & _
                  "T.T_SUBJECT, " & _
                  "T.FORUM_ID, " & _
                  "T.T_STATUS, " & _
                  "T.T_EVENT_DATE, " & _
                  "C.CAT_MODERATION, " & _
                  "F.F_MODERATION " & _
          "FROM " & strTablePrefix & "TOPICS T, " & _
                    strTablePrefix & "CATEGORY C, " & _
                    strTablePrefix & "FORUM F " & _
          "WHERE T.T_ISEVENT=1 " & _
          "AND   (T_EVENT_DATE < '" & datetostr(DateValue(strForumTimeAdjust)) & "') " & _
          "AND   F.FORUM_ID = T.FORUM_ID " & _
          "AND   C.CAT_ID = T.CAT_ID " & _
          "ORDER BY T.T_EVENT_DATE DESC"


Set rs = Server.CreateObject("ADODB.Recordset")
if strDBtype = "mysql" then rs.MaxRecords = intEventstoDisplay
rs.open strSql, My_conn

Response.Write "<ul style=""list-style: square inside; margin:5px;"">"
if rs.EOF then
	Response.Write "<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & fLang("strLangCla00170") & "</font></li>" & vbNewLine
else do while not rs.eof
	Topic_ID = rs("TOPIC_ID")
	Topic_Subject = rs("T_SUBJECT")
	Forum_ID = rs("FORUM_ID")
	Topic_Status = rs("T_STATUS")
	Event_Date = StrToDate(rs("T_EVENT_DATE"))
	Cat_Moderation = rs("CAT_MODERATION")
	Forum_Moderation = rs("F_MODERATION")

	'###########  Check for access ###########
	if mLev = 4 then
		AdminAllowed = 1
		ForumChkSkipAllowed = 1
	elseif mLev = 3 then
		if chkForumModerator(Forum_ID, chkString(strDBNTUserName,"decode")) = "1" then
			AdminAllowed = 1
			ForumChkSkipAllowed = 1
		else
			if lcase(strNoCookies) = "1" then
				AdminAllowed = 1
				ForumChkSkipAllowed = 0
			else
				AdminAllowed = 0
				ForumChkSkipAllowed = 0
			end if
		end if
	elseif lcase(strNoCookies) = "1" then
 		AdminAllowed = 1
		ForumChkSkipAllowed = 0
	else   
 		AdminAllowed = 0
		ForumChkSkipAllowed = 0
	end if

	if strPrivateForums = "1" and ForumChkSkipAllowed <> "1" then
		forumAccess = ChkForumAccess(Forum_ID, MemberID, false)
	else
		forumAccess = true
	end if
	
	if strModeration > 0 and Cat_Moderation > 0 and Forum_Moderation > 0 and AdminAllowed = 0 then
        	Moderation = "Y"
	else
        	Moderation = "N"
	end if
	'#########################################

	if forumAccess and not(Moderation = "Y" and Topic_Status > 1 and Topic_Author <> MemberID) then
		Response.Write	"<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & MonthName(Month(Event_Date)) & "&nbsp;" & Day(Event_Date) & "<br />-" & vbNewLine & _
				"<span class=""spnMessageText""><a href=""topic.asp?rand=" & int(10000000*rnd) & "&topic_ID=" & Topic_ID & """>" & Topic_Subject & "</a></span></font></li>"
	end if
	rs.movenext
	loop 
end if

Response.Write "</ul>"
rs.Close
Set rs = nothing
end sub '### WriteRecentEvents ###
'#######################################################
sub AddEventForm(dateToAdd)                          '##
'#######################################################
if dateToAdd="" then 
	dateToAdd=DateValue(strForumTimeAdjust)
else
	dateToAdd=DateValue(CDate(dateToAdd))
end if

if chkUserPermissions(intEventPermission) then

	Response.Write	"<form name=""FORUM_ID"" method=""get"" action=""post.asp"">" & vbNewLine & _
			"	<input type=""hidden"" name=""event"" value=""1"">" & vbNewLine & _
			"	<input type=""hidden"" name=""method"" value=""Topic"">" & vbNewLine & _
			"	<input type=""hidden"" name=""date"" value=""" & dateToAdd & """>" & vbNewLine & _
			"	<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & fLang("strLangCla00110") & "<select name=""forum_id"" style=""font-size:11px"">" & vbNewLine

'### Select code taken from search.asp ###

if strPrivateForums = "1" and mLev < 4 then
	allAllowedForums = ""

	allowSql = "SELECT FORUM_ID, F_SUBJECT, F_PRIVATEFORUMS, F_PASSWORD_NEW"
	allowSql = allowSql & " FROM " & strTablePrefix & "FORUM"
	allowSql = allowSql & " WHERE F_TYPE = 0"
	allowSql = allowSql & " ORDER BY FORUM_ID"

	set rsAllowed = Server.CreateObject("ADODB.Recordset")
	rsAllowed.open allowSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText

	if rsAllowed.EOF then
		recAllowedCount = ""
	else
		allAllowedData = rsAllowed.GetRows(adGetRowsRest)
		recAllowedCount = UBound(allAllowedData,2)
	end if

	rsAllowed.close
	set rsAllowed = nothing

	if recAllowedCount <> "" then
		fFORUM_ID = 0
		fF_SUBJECT = 1
		fF_PRIVATEFORUMS = 2
		fF_PASSWORD_NEW = 3

		for RowCount = 0 to recAllowedCount

			Forum_ID = allAllowedData(fFORUM_ID,RowCount)
			Forum_Subject = allAllowedData(fF_SUBJECT,RowCount)
			Forum_PrivateForums = allAllowedData(fF_PRIVATEFORUMS,RowCount)
			Forum_FPasswordNew = allAllowedData(fF_PASSWORD_NEW,RowCount)

			if mLev = 4 then
				ModerateAllowed = "Y"
			elseif mLev = 3 and ModOfForums <> "" then
				if (strAuthType = "nt") then
					if (chkForumModerator(Forum_ID, Session(strCookieURL & "username")) = "1") then ModerateAllowed = "Y" else ModerateAllowed = "N"
				else 
					if (instr("," & ModOfForums & "," ,"," & Forum_ID & ",") > 0) then ModerateAllowed = "Y" else ModerateAllowed = "N"
				end if
			else
				ModerateAllowed = "N"
			end if
			if chkForumAccessNew(Forum_PrivateForums,Forum_FPasswordNew,Forum_Subject,Forum_ID,MemberID) = true then
				if allAllowedForums = "" then
					allAllowedForums = Forum_ID
				else
					allAllowedForums = allAllowedForums & "," & Forum_ID
				end if
			end if
		next
	end if
	if allAllowedForums = "" then allAllowedForums = 0
end if

	strSql = "SELECT F.FORUM_ID, F.F_SUBJECT FROM " & strTablePrefix & "FORUM F, " & strTablePrefix & "CATEGORY C"
	strSql = strSql & " WHERE (F_TYPE = 0 AND (F_EVENT = 1))"
	if strPrivateForums = "1" and allAllowedForums <> "" and mLev < 4 then
		strSql = strSql & " AND F.FORUM_ID IN (" & allAllowedForums & ")"
	end if
   if strShowUserGroups = "1" then
	   strDeniedForums = Session(strCookieURL & "DeniedForums" & MemberID)
	   if strDeniedForums <> "" and strDeniedForums <> "-1" then
		   strSql = strSql & " AND F.FORUM_ID NOT IN(" & Session(strCookieURL & "DeniedForums" & MemberID) & ") "
	   end if
    end if
	strSql = strSql & " AND C.CAT_ID = F.CAT_ID"
	strSql = strSql & " ORDER BY C.CAT_ORDER, C.CAT_NAME, F.F_ORDER, F.F_SUBJECT"

	Set rs = Server.CreateObject("ADODB.Recordset")
	rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText

	if rs.EOF then
		recForumCount = ""
	else
		allForumData = rs.GetRows(adGetRowsRest)
		recForumCount = UBound(allForumData,2)
		fFORUM_ID = 0
		fF_SUBJECT = 1
	end if

	rs.Close
	Set rs = nothing

	if recForumCount <> "" then
		for iForum = 0 to recForumCount
			ForumForumID = allForumData(fFORUM_ID, iForum)
			ForumSubject = allForumData(fF_SUBJECT, iForum)
			Response.Write	"                	<option value=""" & ForumForumID & """"
			Response.Write	">" & chkString(left(ForumSubject, 50),"display") & "</option>" & vbNewLine
		next
	end if

	Response.Write	"	</select></font>" & vbNewLine & _
			"<input class=""bouton"" type=""submit"" value=' " & fLang("strLangGo00010") & " ' style=""font-size:11px""></form>" & vbNewLine
end if
end sub '### AddEventForm ##
'### Birthday Mod - Must Use Birthdate in Member Profile - Huntress Beta v2.2 ###
'#######################################################
sub PrepBdayTables                                   '##
'#######################################################

todaysdate = now()

strSql = " SELECT BT_TS FROM " & strTablePrefix & "BIRTHDAY_TS "
set rs = my_Conn.Execute(strSql)

if rs.EOF then
	'do nothing - show no errors to user. If birthdays not showing, check here!!!
else
	if rs("BT_TS") <> FormatDateTime(todaysdate,vbShortDate) then
		strSql = " UPDATE " & strTablePrefix & "BIRTHDAY_TS SET BT_TS = '" & FormatDateTime(todaysdate,vbShortDate) & "'"
		my_Conn.Execute (strSql)

		strSql = " DELETE FROM " & strMemberTablePrefix & "MEMBERS_BDATES "
		my_conn.execute (strSql)

		strSql = " INSERT INTO " & strMemberTablePrefix & "MEMBERS_BDATES(MEMBER_ID, M_NAME, DOB) " 
		strSql = strSql & " SELECT MEMBER_ID, M_NAME, M_DOB " 
		strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " 
		strSql = strSql & " WHERE M_LASTPOSTDATE > '" & DateToStr(DateAdd("d",-31,todaysdate)) & "' AND M_DOB <> '' And M_DOB Is Not Null "
		my_conn.execute (strSql)

		if strDBType = "access" then
			strSql = " SELECT MB_ID, DOB FROM " & strMemberTablePrefix & "MEMBERS_BDATES " 
			strSql = strSql & " ORDER BY MID(DOB,5,4) "
			set MBrs = my_Conn.Execute(strSql)
		else
			strSql = " SELECT MB_ID, DOB FROM " & strMemberTablePrefix & "MEMBERS_BDATES " 
			strSql = strSql & " ORDER BY SUBSTRING(DOB,5,4) "
			set MBrs = my_Conn.Execute(strSql)
		end if

		YYYYMMDDpast = DateToStr(dateadd("d",-BdayDays,todaysdate))
		CurYYYYpast = mid(YYYYMMDDpast,1,4)
		CurMMDDpast = mid(YYYYMMDDpast,5,4)
		YYYYMMDDfut = DateToStr(dateadd("d",BdayDays,todaysdate))
		CurYYYYfut = mid(YYYYMMDDfut,1,4)
		CurMMDDfut = mid(YYYYMMDDfut,5,4)

		do while not MBrs.EOF
			'deal with that damn leap year baby :) - February 29th birthdays changed to March 1st on non leap years
			if mid(MBrs("DOB"),5,4) = "0229" and mid(datetostr(todaysdate),1,4) mod 4 <> 0 then
				mbDOB = "0301"
			else
				mbDOB = mid(MBrs("DOB"),5,4)
			end if
			'set the year for the next occurance of members birthday

            If Cint(CurYYYYpast)<Cint(year(todaysdate)) Then
              If Cint(CurMMDDpast)<Cint(mbDOB) AND Cint(mbDOB)<Cint("1231") Then
			    newdate = mid(DateToStr(DateAdd("yyyy",-1,todaysdate)),1,4) & mbDOB
			  Else
			    newdate = mid(DateToStr(todaysdate),1,4) & mbDOB
			  End If
			ElseIf Cint(CurYYYYfut)>Cint(year(todaysdate)) Then
			  If Cint(mbDOB)>=Cint("0101") AND Cint(mbDOB)<Cint(CurMMDDfut) Then
			    newdate = mid(DateToStr(DateAdd("yyyy",1,todaysdate)),1,4) & mbDOB
			  Else
			    newdate = mid(DateToStr(todaysdate),1,4) & mbDOB
			  End If
			Else
			  if cint(mbDOB) > cint(CurMMDDpast) AND cint(mbDOB) < cint(CurMMDDfut) then
				newdate = year(todaysdate) & mbDOB
			  ElseIf Cint(mbDOB)<Cint(CurMMDDpast) Then
				newdate = mid(DateToStr(DateAdd("yyyy",1,todaysdate)),1,4) & mbDOB
			  Else
			    newdate = mid(DateToStr(DateAdd("yyyy",-1,todaysdate)),1,4) & mbDOB
			  end if
			End If
			strSql = " UPDATE " & strMemberTablePrefix & "MEMBERS_BDATES " 
			strSql = strSql & " SET DOB = '" & newdate & "'" 
			strSql = strSql & " WHERE MB_ID = " & MBrs("MB_ID")
			my_Conn.Execute (strSql)

			MBrs.movenext
		loop
		MBrs.close
		set MBrs = nothing
	end if
end if
rs.close
set rs = nothing

End sub '### PrepBdayTables ###



'#######################################################
sub WriteBirthdays                                   '##
'#######################################################

strSql = " SELECT * FROM " & strMemberTablePrefix & "MEMBERS_BDATES ORDER BY DOB "
set rs = my_Conn.Execute(strSql)

if rs.EOF then
	'no birthdays at all :D
else
		'todays birthdays
		Response.Write 	"<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""0"">" & vbnewline & _
				"<TR><TD " & TableBorderColor &">" & vbNewLine
		Response.Write 	"	<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""2"" class=""smalleventslist"">" & vbNewLine & _
				"	<TR align=center>" & vbnewline & _
		"	<TD colspan=""3"" " & CategoryCellColor & "><FONT face=" & strDefaultFontFace & " size=" & strDefaultFontSize & """ " & CategoryFontColor & ">" & vbNewLine & _
		"	<B>" & fLang("strLangCla00480") & "</B></TD></TR>" & vbNewLine & _
				"	<TR><TD colspan=""3"" " & strForumCellColor &"> " & vbNewLine
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor &">"
			Response.Write "</TD></TR>"
bTodayFound = False
	do while not(rs.EOF)
		if DateToStr(rs("DOB")&"235900") > DateToStr(todaysdate) and DateToStr(rs("DOB")&"000000") < DateToStr(todaysdate) then
			bTodayFound = true
			Response.Write "<TR><TD height='12' " & strForumCellColor &" width=""1"">"
			Response.Write "<img src=""" & StrImageURL & "bdaycake.gif"" border=""0"">"
			Response.Write "</td><td height='12' " & strForumCellColor &" width=""100%"">"
			Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & """><span class=""spnMessageText""><a href=""pop_profile.asp?mode=display&id="& rs("member_id") & """>" & rs("M_NAME") & "</a></span></FONT>"
			Response.Write "</TD><TD height='12' align=""right"" " & strForumCellColor &" width=""100%"" nowrap>"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize & """ " & DefaultFontColor & ">" & ChkDate(rs("DOB"),"",false) & "&nbsp;</FONT>"
			Response.Write "</TD></TR>"	
			Response.Write "<TR><TD colspan=""3"" height='4' "& strForumCellColor & ">"
			Response.Write "</TD></TR>"
		end if
		      '	EmailBirthdays
		rs.Movenext
	loop
	if bTodayFound = False then
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor &">"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize - 1 & """ " & DefaultFontColor & "></FONT>"
			Response.Write "</TD></TR>"
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor & ">"
			Response.Write "<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & strForumFontColor & ">" & fLang("strLangCla00470") & "</font></li>" & vbNewLine
			Response.Write "</TD></TR>"
			Response.Write "<TR><TD colspan=""3"" height='4' "& strForumCellColor &">"
			Response.Write "</TD></TR>"
	end if
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor & ">"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize - 1 & """ " & DefaultFontColor & "></FONT>"
			Response.Write "</TD></TR>"
			Response.Write 	"	</TD></TR></TABLE>" & vbNewLine & _
					"</TD></TR></TABLE>" & vbNewLine
	rs.movefirst
		'upcoming birthdays
		Response.Write 	"<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""0"">" & vbnewline & _
				"<TR><TD "& TableBorderColor & ">" & vbNewLine
		Response.Write 	"	<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""2"" class=""smalleventslist"">" & vbNewLine & _
				"	<TR align=center>" & vbnewline & _
				"		<TD colspan=""3"" " & CategoryCellColor & "><FONT face=" & strDefaultFontFace & " size=" & strDefaultFontSize & """ " & CategoryFontColor & ">" & vbNewLine & _
				"			<B>" & fLang("strLangCla00490") & "</B></TD></TR>" & vbNewLine & _
				"	<TR><TD colspan=""3"" "& strForumCellColor &"> " & vbNewLine
			Response.Write "<TR><TD colspan=""3"" height='4' "& strForumCellColor &">"
			Response.Write "</TD></TR>"
bUpcomingFound = False
	do while not(rs.EOF)
	    if DateToStr(rs("DOB")&" 000000") > DateToStr(todaysdate) and DateToStr(rs("DOB")&"000000") < DateToStr(DateAdd("d",BdayDays,todaysdate)) then
			bUpcomingFound = true
			Response.Write "<TR><TD height='12' " & strForumCellColor &" width=""1%"">"
			Response.Write "<img src=""" & StrImageURL & "bdayprsbox.gif"" border=""0"">"
			Response.Write "</td><td height='12' " & strForumCellColor &" width=""100%"">"
			Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & """><span class=""spnMessageText""><a href=""pop_profile.asp?mode=display&id="& rs("member_id") & """>" & rs("M_NAME") & "</a></span></FONT>"
			Response.Write "</TD><TD height='12' align=""right"" " & strForumCellColor &" width=""100%"" nowrap>"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize & """ " & DefaultFontColor & ">" & ChkDate(rs("DOB"),"",false) & "&nbsp;</FONT>"
			Response.Write "</TD></TR>"	
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor & ">"
			Response.Write "</TD></TR>"
		end if
		rs.Movenext
	loop
	if bUpcomingFound = False then
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor & ">"
			Response.Write "<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & strForumFontColor & ">" & fLang("strLangCla00500") & "</font></li>" & vbNewLine
			Response.Write "</TD></TR>"	
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor & ">"
			Response.Write "</TD></TR>"
	end if
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor & ">"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize - 1 & """ " & DefaultFontColor & "></FONT>"
			Response.Write "</TD></TR>"
			Response.Write 	"	</TD></TR></TABLE>" & vbNewLine & _
					"</TD></TR></TABLE>" & vbNewLine
	rs.movefirst
		'recent birthdays
		Response.Write 	"<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""0"">" & vbnewline & _
				"<TR><TD "& TableBorderColor & ">" & vbNewLine
		Response.Write 	"	<TABLE width=""100%"" border=""0"" cellSpacing=""0"" cellPadding=""2"" class=""smalleventslist"">" & vbNewLine & _
				"	<TR align=center>" & vbnewline & _
				"	<TD colspan=""3"" " & CategoryCellColor & "><FONT face=" & strDefaultFontFace & " size=" & strDefaultFontSize & """ " & CategoryFontColor & ">" & vbNewLine & _
				"			<B>" & fLang("strLangCla00510") & "</B></TD></TR>" & vbNewLine & _
				"	<TR><TD colspan=""3"" " & strForumCellColor &"> " & vbNewLine
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor & ">"
			Response.Write "</TD></TR>"
bRecentFound = False
rs.Close
strSql = " SELECT * FROM " & strMemberTablePrefix & "MEMBERS_BDATES ORDER BY DOB DESC"
set rs = my_Conn.Execute(strSql)
do while not(rs.EOF)
		if DateToStr(rs("DOB")&"235900") < DateToStr(todaysdate) and DateToStr(rs("DOB")&"000000") > DateToStr(DateAdd("d",-BdayDays,todaysdate)) then
			bRecentFound = true
			Response.Write "</TD></TR>"
			Response.Write "<TR><TD height='12' " & strForumCellColor &" width=""1"">"
			Response.Write "<img src=""" & StrImageURL & "bdayprsbox2.gif"" border=""0"">"
			Response.Write "</td><td height='12' " & strForumCellColor &" width=""100%"">"
			Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & """><span class=""spnMessageText""><a href=""pop_profile.asp?mode=display&id="& rs("member_id") & """>" & rs("M_NAME") & "</a></span></FONT>"
			Response.Write "</TD><TD height='12' align=""right"" " & strForumCellColor &" width=""100%"" nowrap>"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize & """ " & DefaultFontColor & ">" & ChkDate(mid(datetostr(todaysdate),1,4) & mid(rs("DOB"),5,4),"",false) & "&nbsp;</FONT>"
			Response.Write "</TD></TR>"	
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor & ">"
			Response.Write "</TD></TR>"
		end if
		rs.Movenext
	loop
	if bRecentFound = False then
			Response.Write "<TR><TD colspan=""3"" "& strForumCellColor &">"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize - 1 & """ " & DefaultFontColor & "></FONT>"
			Response.Write "</TD></TR>"
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor &">"
Response.Write "<li><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ " & ForumFontColor & ">" & fLang("strLangCla00520") & "</font></li>" & vbNewLine
			Response.Write "</TD></TR>"
			Response.Write "<TR><TD colspan=""3"" height='4' " & strForumCellColor &">"
			Response.Write "</TD></TR>"
	end if
			Response.Write "<TR><TD colspan=""3"" " & strForumCellColor & ">"
			Response.Write "<font face=" & strDefaultFontFace & " size=" & strFooterFontSize - 1 & """ " & DefaultFontColor & "></FONT>"
			Response.Write "</TD></TR>"
			Response.Write 	"	</TD></TR></TABLE>" & vbNewLine & _
					"</TD></TR></TABLE>" & vbNewLine
end if

rs.close
set rs = nothing

End sub '### WriteBirthdays ###
sub EmailBirthdays                                   '##
'#######################################################

strSql = " SELECT * FROM " & strMemberTablePrefix & "MEMBERS_BDATES ORDER BY DOB "
set rs = my_Conn.Execute(strSql)

if rs.EOF then
	'no birthdays at all :D
else
	
'bTodayFound = False
	rs.movefirst
	do while not(rs.EOF)
	idmembro = rs("MEMBER_ID")
	sentmail = rs("M_SENTEMAIL")

	 If sentmail = 0 then
	      	if DateToStr(rs("DOB")&"235900") > DateToStr(todaysdate) and DateToStr(rs("DOB")&"000000") < DateToStr(todaysdate) then
		       '	bTodayFound = true
			strSQL1 = " SELECT M_NAME, M_EMAIL, M_RECEIVE_EMAIL  FROM " & strMemberTablePrefix & "MEMBERS "
			strSQL1 = strSQL1 & " WHERE MEMBER_ID = " & idmembro
			set rsmail= my_Conn.Execute(strSQL1)
			 	mricevimail = rsmail("M_RECEIVE_EMAIL") 
			strFromName = strForumTitle
					strRecipientsName = rsMail("M_NAME")
					strRecipients = rsMail("M_EMAIL")
					strSender = strSender
					strSubject = "Buon Compleanno!!"
					strMessage = "Ciao " & strRecipientsName &  vbNewline & vbNewline
					strMessage = strMessage & "Tanti Auguri di buon Compleanno da tutti noi!!" &  vbNewline & vbNewline
					strMessage = strMessage & "Da:  " & strForumURL & vbNewline & vbNewline

					htmlflag = 0
					if mricevimail = "1" then
				%><!--#INCLUDE FILE="inc_mail.asp" --><%
				end if
				strMessage =""
			   	rsmail.close
				set rsmail = nothing
			
	              	strSql = " UPDATE " & strMemberTablePrefix & "MEMBERS_BDATES SET M_SENTEMAIL = 1 WHERE MEMBER_ID = " & idmembro
		my_Conn.Execute (strSql)
	      	end if
	      	end if
		rs.Movenext
	loop
       '	rs.movefirst
	
		
end if
rs.close
set rs = nothing

End sub '### EmailBirthdays ###
'### Birthday Mod - Must Use Birthdate in Member Profile - Huntress Beta v2.2 ###
%>