| Author |
 Topic  |
|
Dave Goldman
New Member
USA
65 Posts |
 Posted - 17 September 2009 : 12:15:54
|
Amazing, that was the problem. So if I understand this correctly the system thinks the cookie is being redirected to another site. As soon as I made all of the changes from /Forum to /forum everything works as it should. The userName textbox is even populated with the user information.
You guys Rock!! |
Edited by - Dave Goldman on 17 September 2009 12:22:32 |
 |
|
|
HuwR
Forum Admin
United Kingdom
20584 Posts |
Posted - 17 September 2009 : 12:23:40
|
quote:
Originally posted by Davio
Huwr...the cookie path's we set when you log in, see's /Forum and /forum as 2 different sites. Remember?
I might have phrased it wrong when I said 2 different sites. Was trying to put it into layman terms. :D
Just that if you log into /Forum and visit /forum afterwards, it shows you as logged out.
Sounds like a bug we should fix 
A simple solution would be to set the cookie mode to site rather than forum in the admin options, then it wouldn't matter if you typed Forum or forum, it certainly doesn't here. |
|
|
|
Dave Goldman
New Member
USA
65 Posts |
Posted - 17 September 2009 : 12:27:39
|
| That is perfect. I have it fixed now, however I will make a note of it for the future!! You guys have a great day!!!! and thanks again! |
|
|
|
HuwR
Forum Admin
United Kingdom
20584 Posts |
Posted - 17 September 2009 : 12:56:20
|
| glad you are all sorted |
|
|
|
Dave Goldman
New Member
USA
65 Posts |
Posted - 17 September 2009 : 18:55:02
|
Hey guys, can you please help me with one last thing. Now that I have everything working I just want to make sure that this is not a side effect of the cookie / url problem.
I added this mod: Logged In Users Who Are Active: http://www.snitzbitz.com/mods/details.asp?Version=3.4&mid=207
What is strange is that I checked the database and I can see that the data is there, however when you login it will display a random user as well as Current number of users logged in is never gets past 1.
This is the inc_header.asp
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## Copyright (C) 2000-09 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
'##
'#################################################################################
%>
<!--#INCLUDE FILE="inc_func_common.asp" -->
<%
if strShowTimer = "1" then
'### start of timer code
'# Commented out because of Zules Avatar mod. This is now in the config.asp
'Dim StopWatch(19)
sub StartTimer(x)
StopWatch(x) = timer
end sub
function StopTimer(x)
EndTime = Timer
'Watch for the midnight wraparound...
if EndTime < StopWatch(x) then
EndTime = EndTime + (86400)
end if
StopTimer = EndTime - StopWatch(x)
end function
StartTimer 1
'### end of timer code
end if
strArchiveTablePrefix = strTablePrefix & "A_"
strScriptName = request.servervariables("script_name")
strReferer = chkString(request.servervariables("HTTP_REFERER"),"refer")
if Application(strCookieURL & "down") then
if not Instr(strScriptName,"admin_") > 0 then
Response.redirect("down.asp")
end if
end if
if strPageBGImageURL = "" then
strTmpPageBGImageURL = ""
elseif Instr(strPageBGImageURL,"/") > 0 or Instr(strPageBGImageURL,"\") > 0 then
strTmpPageBGImageURL = " background=""" & strPageBGImageURL & """"
else
strTmpPageBGImageURL = " background=""" & strImageUrl & strPageBGImageURL & """"
end if
If strDBType = "" then
Response.Write "<html>" & vbNewLine & _
"<head>" & vbNewline & _
"<title>" & strForumTitle & "</title>" & vbNewline
'## START - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "<meta name=""copyright"" content=""This Forum code is Copyright (C) 2000-09 Michael Anderson, Pierre Gorissen, Huw Reddick and Richard Kinser, Non-Forum Related code is Copyright (C) " & strCopyright & """>" & vbNewline
'## END - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "</head>" & vbNewLine & _
"<body" & strTmpPageBGImageURL & " bgColor=""" & strPageBGColor & """ text=""" & strDefaultFontColor & """ link=""" & strLinkColor & """ aLink=""" & strActiveLinkColor & """ vLink=""" & strVisitedLinkColor & """>" & vbNewLine & _
"<table border=""0"" cellspacing=""0"" cellpadding=""5"" width=""50%"" height=""40%"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td bgColor=""#9FAFDF"" align=""center""><p><font face=""Verdana, Arial, Helvetica"" size=""2"">" & _
"<b>There has been a problem...</b><br /><br />" & _
"Your <b>strDBType</b> is not set, please edit your <b>config.asp</b><br />to reflect your database type." & _
"</font></p></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""Verdana, Arial, Helvetica"" size=""2"">" & _
"<a href=""http://www.TheGunnersAcademy.com/forum/default.asp"" target=""_top"">Click here to retry.</a></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"</body>" & vbNewLine & _
"</html>" & vbNewLine
Response.End
end if
set my_Conn = Server.CreateObject("ADODB.Connection")
my_Conn.Open strConnString
if (strAuthType = "nt") then
call NTauthenticate()
if (ChkAccountReg() = "1") then
call NTUser()
end if
end if
if strGroupCategories = "1" then
if Request.QueryString("Group") = "" then
if Request.Cookies(strCookieURL & "GROUP") = "" Then
Group = 2
else
Group = cLng(Request.Cookies(strCookieURL & "GROUP"))
end if
else
Group = cLng(Request.QueryString("Group"))
end if
'set default
Session(strCookieURL & "GROUP_ICON") = "icon_group_categories.gif"
Session(strCookieURL & "GROUP_IMAGE") = strTitleImage
'Forum_SQL - Group exists ?
strSql = "SELECT GROUP_ID, GROUP_NAME, GROUP_ICON, GROUP_IMAGE "
strSql = strSql & " FROM " & strTablePrefix & "GROUP_NAMES "
strSql = strSql & " WHERE GROUP_ID = " & Group
set rs2 = my_Conn.Execute (strSql)
if rs2.EOF or rs2.BOF then
Group = 2
strSql = "SELECT GROUP_ID, GROUP_NAME, GROUP_ICON, GROUP_IMAGE "
strSql = strSql & " FROM " & strTablePrefix & "GROUP_NAMES "
strSql = strSql & " WHERE GROUP_ID = " & Group
set rs2 = my_Conn.Execute (strSql)
end if
Session(strCookieURL & "GROUP_NAME") = rs2("GROUP_NAME")
if instr(rs2("GROUP_ICON"), ".") then
Session(strCookieURL & "GROUP_ICON") = rs2("GROUP_ICON")
end if
if instr(rs2("GROUP_IMAGE"), ".") then
Session(strCookieURL & "GROUP_IMAGE") = rs2("GROUP_IMAGE")
end if
rs2.Close
set rs2 = nothing
Response.Cookies(strCookieURL & "GROUP") = Group
Response.Cookies(strCookieURL & "GROUP").Expires = dateAdd("d", intCookieDuration, strForumTimeAdjust)
if Session(strCookieURL & "GROUP_IMAGE") <> "" then
strTitleImage = Session(strCookieURL & "GROUP_IMAGE")
end if
end if
strDBNTUserName = Request.Cookies(strUniqueID & "User")("Name")
strDBNTFUserName = trim(chkString(Request.Form("Name"),"SQLString"))
if strDBNTFUserName = "" then strDBNTFUserName = trim(chkString(Request.Form("User"),"SQLString"))
if strAuthType = "nt" then
strDBNTUserName = Session(strCookieURL & "userID")
strDBNTFUserName = Session(strCookieURL & "userID")
end if
if strRequireReg = "1" and strDBNTUserName = "" then
if not Instr(strScriptName,"https://www.TheGunnersAcademy.com/forum/register.asp") > 0 and _
not Instr(strScriptName,"password.asp") > 0 and _
not Instr(strScriptName,"https://www.TheGunnersAcademy.com/forum/faq.asp") > 0 and _
not Instr(strScriptName,"https://www.TheGunnersAcademy.com/forum/login.asp") > 0 then
scriptname = split(request.servervariables("SCRIPT_NAME"),"/")
if Request.QueryString <> "" then
Response.Redirect("https://www.TheGunnersAcademy.com/forum/login.asp?target=" & lcase(scriptname(ubound(scriptname))) & "?" & Request.QueryString)
else
Response.Redirect("https://www.TheGunnersAcademy.com/forum/login.asp?target=" & lcase(scriptname(ubound(scriptname))))
end if
end if
end if
select case Request.Form("Method_Type")
case "login"
strEncodedPassword = sha256("" & Request.Form("Password"))
select case chkUser(strDBNTFUserName, strEncodedPassword,-1)
case 1, 2, 3, 4
Call DoCookies(Request.Form("SavePassword"))
strLoginStatus = 1
case else
strLoginStatus = 0
end select
case "logout"
Call ClearCookies()
end select
if trim(strDBNTUserName) <> "" and trim(Request.Cookies(strUniqueID & "User")("Pword")) <> "" then
chkCookie = 1
mLev = cLng(chkUser(strDBNTUserName, Request.Cookies(strUniqueID & "User")("Pword"),-1))
chkCookie = 0
else
MemberID = -1
mLev = 0
end if
'## Update LastActive column
strActiveSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
strActiveSql = strActiveSql & " SET M_LASTACTIVE = '" & strForumTimeAdjust & "'"
strActiveSql = strActiveSql & ", M_LAST_IP = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
strActiveSql = strActiveSql & " WHERE MEMBER_ID = " & MemberID
my_Conn.Execute (strActiveSql),,adCmdText + adExecuteNoRecords
if mLev = 4 and strEmailVal = "1" and strRestrictReg = "1" and strEmail = "1" then
'## Forum_SQL - Get membercount from DB
strSql = "SELECT COUNT(MEMBER_ID) AS U_COUNT FROM " & strMemberTablePrefix & "MEMBERS_PENDING WHERE M_APPROVE = " & 0
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn
if not rs.EOF then
User_Count = cLng(rs("U_COUNT"))
else
User_Count = 0
end if
rs.close
set rs = nothing
end if
Response.Write "<html>" & vbNewline & vbNewline & _
"<head>" & vbNewline & _
"<title>" & GetNewTitle(strScriptName) & "</title>" & vbNewline
'## START - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "<meta name=""copyright"" content=""This Forum code is Copyright (C) 2000-09 Michael Anderson, Pierre Gorissen, Huw Reddick and Richard Kinser, Non-Forum Related code is Copyright (C) " & strCopyright & """>" & vbNewline
'## END - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "<script language=""JavaScript"" type=""text/javascript"">" & vbNewLine & _
"<!-- hide from JavaScript-challenged browsers" & vbNewLine & _
"function openWindow(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=400,height=400')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindow2(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=400,height=450')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindow3(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=400,height=450,scrollbars=yes')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindow4(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=400,height=525')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindow5(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=450,height=525,scrollbars=yes,toolbars=yes,menubar=yes,resizable=yes')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindow6(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=500,height=450,scrollbars=yes')" & vbNewLine & _
"}" & vbNewLine & _
"function openWindowHelp(url) {" & vbNewLine & _
" popupWin = window.open(url,'new_page','width=470,height=200,scrollbars=yes')" & vbNewLine & _
"}" & vbNewLine & _
"function OpenSpellCheck()" & vbNewLine & _
"{" & vbNewLine & _
"var curCookie = ""strMessagePreview="" + escape(document.PostTopic.Message.value);" & vbNewLine & _
"document.cookie = curCookie;" & vbNewLine & _
"popupWin = window.open('pop_spellcheck.asp', 'preview_page', 'scrollbars=yes,width=650,height=400')" & vbNewLine & _
"}" & vbNewLine & _
"// done hiding -->" & vbNewLine & _
"</script>" & vbNewLine & _
"<style type=""text/css"">" & vbNewLine & _
"<!--" & vbNewLine & _
"a:link {color:" & strLinkColor & ";text-decoration:" & strLinkTextDecoration & "}" & vbNewLine & _
"a:visited {color:" & strVisitedLinkColor & ";text-decoration:" & strVisitedTextDecoration & "}" & vbNewLine & _
"a:hover {color:" & strHoverFontColor & ";text-decoration:" & strHoverTextDecoration & "}" & vbNewLine & _
"a:active {color:" & strActiveLinkColor & ";text-decoration:" & strActiveTextDecoration & "}" & vbNewLine & _
".spnMessageText a:link {color:" & strForumLinkColor & ";text-decoration:" & strForumLinkTextDecoration & "}" & vbNewLine & _
".spnMessageText a:visited {color:" & strForumVisitedLinkColor & ";text-decoration:" & strForumVisitedTextDecoration & "}" & vbNewLine & _
".spnMessageText a:hover {color:" & strForumHoverFontColor & ";text-decoration:" & strForumHoverTextDecoration & "}" & vbNewLine & _
".spnMessageText a:active {color:" & strForumActiveLinkColor & ";text-decoration:" & strForumActiveTextDecoration & "}" & vbNewLine & _
".spnSearchHighlight {background-color:" & strSearchHiLiteColor & "}" & vbNewLine & _
"input.radio {background:" & strPopUpTableColor & ";color:#000000}" & vbNewLine & _
"CODE, .cpp-inline { color: #990000; font-family: ""Courier New"", Courier, mono; } " & vbNewLine & _
"PRE, .cpp-pre{ background-color: #FBEDBB;padding: 7pt; font: 9pt ""Courier New"", Courier, mono; " & vbNewLine & _
" white-space: pre; width: 100%;} " & vbNewLine & _
".cpp-comment { color: #006633; } " & vbNewLine & _
".cpp-literal { color: #CC0000; } " & vbNewLine & _
".cpp-keyword { color:#0000FF; } " & vbNewLine & _
".cpp-preprocessor { color:#0000FF;} " & vbNewLine & _
".xml-tag { color:#AA4400 } " & vbNewLine & _
".xml-bracket { color:#0000FF } " & vbNewLine & _
".xml-comment { color:#008800} " & vbNewLine & _
".xml-cdata { color:#AA0088 } " & vbNewLine & _
".xml-attribute-name{ color=#FF0000 } " & vbNewLine & _
".xml-attribute-value{color:#0000FF} " & vbNewLine & _
"-->" & vbNewLine & _
"</style>" & vbNewLine & _
"</head>" & vbNewLine & _
vbNewLine & _
"<body" & strTmpPageBGImageURL & " bgColor=""" & strPageBGColor & """ text=""" & strDefaultFontColor & """ link=""" & strLinkColor & """ aLink=""" & strActiveLinkColor & """ vLink=""" & strVisitedLinkColor & """>" & vbNewLine & _
"<a name=""top""></a>" & vbNewLine & _
vbNewLine & _
"<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td valign=""top"" width=""50%""><a href=""http://www.TheGunnersAcademy.com/forum/default.asp"" tabindex=""-1"">" & getCurrentIcon(strTitleImage & "||",strForumTitle,"") & "</a></td>" & vbNewLine & _
" <td align=""center"" valign=""top"" width=""50%"">" & vbNewLine & _
" <table border=""0"" cellPadding=""2"" cellSpacing=""0"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><b>" & strForumTitle & "</b></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & vbNewLine
call sForumNavigation()
Response.Write "</font></td>" & vbNewLine & _
" </tr>" & vbNewLine
select case Request.Form("Method_Type")
case "login"
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
if strLoginStatus = 0 then
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>Your username and/or password were incorrect.</font></p>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>Please either try again or register for an account.</font></p>" & vbNewLine
else
Response.Write "<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You logged on successfully!</font></p>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>Thank you for your participation.</font></p>" & vbNewLine
end if
Response.Write "<meta http-equiv=""Refresh"" content=""2; URL=" & strReferer & """>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""" & strReferer & """>Back To Forum</font></a></p>" & vbNewLine & _
"<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine
WriteFooter
Response.End
case "logout"
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>You logged out successfully!</font></p>" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strHeaderFontSize & """>Thank you for your participation.</font></p>" & vbNewLine & _
"<meta http-equiv=""Refresh"" content=""2; URL=http://www.TheGunnersAcademy.com/forum/default.asp"">" & vbNewLine & _
"<p align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """><a href=""http://www.TheGunnersAcademy.com/forum/default.asp"">Back To Forum</font></a></p>" & vbNewLine & _
"<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine
WriteFooter
Response.End
end select
if (mlev = 0) then
if not(Instr(Request.ServerVariables("Path_Info"), "https://www.TheGunnersAcademy.com/forum/register.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "pop_profile.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "http://www.TheGunnersAcademy.com/forum/search.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "https://www.TheGunnersAcademy.com/forum/login.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "password.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "http://www.TheGunnersAcademy.com/forum/faq.asp") > 0) and _
not(Instr(Request.ServerVariables("Path_Info"), "post.asp") > 0) then
Response.Write " <form action=""" & Request.ServerVariables("URL") & """ method=""post"" id=""form1"" name=""form1"">" & vbNewLine & _
" <input type=""hidden"" name=""Method_Type"" value=""login"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"">" & vbNewLine & _
" <table>" & vbNewLine & _
" <tr>" & vbNewLine
if (strAuthType = "db") then
if strGfxButtons = "1" then
Response.Write " <a href=""https://www.TheGunnersAcademy.com/forum/login.asp"">" & vbNewLine &_
" <img src=""" & strImageUrl & "button_login.gif""></a>" & vbNewLine
else
Response.Write " <a href=""https://www.TheGunnersAcademy.com/forum/login.asp"">" & vbNewLine &_
" <img src=""" & strImageUrl & "button_login.gif""></a>" & vbNewLine
end if
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""3"" align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & vbNewLine & _
" <input type=""checkbox"" name=""RememberMe"" value=""true"" tabindex=""-1"" CHECKED><b> Remember Me</b></font></td>" & vbNewLine
else
if (strAuthType = "nt") then
Response.Write " <td><font face=""" & strDefaultFontFace & """ size=""1"" color=""" & strHiLiteFontColor & """>Please <a href=""https://TheGunnersAcademy.com/forum/register.asp"" tabindex=""-1"">register</a> to post in these Forums</font></td>" & vbNewLine
end if
end if
Response.Write " </tr>" & vbNewLine
if (lcase(strEmail) = "1") then
Response.Write " <tr>" & vbNewLine & _
" <td colspan=""3"" align=""left""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & vbNewLine & _
" <a href=""https://www.TheGunnersAcademy.com/forum/password.asp""" & dWStatus("Choose a new password if you have forgotten your current one...") & " tabindex=""-1"">Forgot your "
if strAuthType = "nt" then Response.Write("Admin ")
Response.Write "Password?</a>" & vbNewLine
if (lcase(strNoCookies) = "1") then
Response.Write " |" & vbNewLine & _
" <a href=""https://www.TheGunnersAcademy.com/forum/admin_home.asp""" & dWStatus("Access the Forum Admin Functions...") & " tabindex=""-1"">Admin Options</a>" & vbNewLine
end if
Response.Write " <br /><br /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </form>" & vbNewLine
end if
else
Response.Write " <form action=""" & Request.ServerVariables("URL") & """ method=""post"" id=""form2"" name=""form2"">" & vbNewLine & _
" <input type=""hidden"" name=""Method_Type"" value=""logout"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center"">" & vbNewLine & _
" <table>" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>You are logged on as "
if strAuthType="nt" then
Response.Write "<b>" & Session(strCookieURL & "username") & " (" & Session(strCookieURL & "userid") & ")</b></font></td>" & vbNewLine & _
" <td> "
else
if strAuthType = "db" then
Response.Write "<b>" & profileLink(ChkString(strDBNTUserName, "display"),MemberID) & "</b></font></td>" & vbNewLine & _
" <td>"
if strGfxButtons = "1" then
Response.Write "<input src=""" & strImageUrl & "button_logout.gif"" type=""image"" border=""0"" value=""Logout"" id=""submit1"" name=""Logout"" tabindex=""-1"">"
else
Response.Write "<input type=""submit"" value=""Logout"" id=""submit1"" name=""submit1"" tabindex=""-1"">"
end if
end if
end if
Response.Write "</td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine
if (mlev = 4) or (lcase(strNoCookies) = "1") then
Response.Write " <tr>" & vbNewLine & _
" <td align=""center""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """><a href=""admin_home.asp""" & dWStatus("Access the Forum Admin Functions...") & " tabindex=""-1"">Admin Options</a>"
if mLev = 4 and (strEmailVal = "1" and strRestrictReg = "1" and strEmail = "1" and User_Count > 0) then Response.Write(" | <a href=""admin_accounts_pending.asp""" & dWStatus("(" & User_Count & ") Member(s) awaiting approval") & " tabindex=""-1"">(" & User_Count & ") Member(s) awaiting approval</a>")
Response.Write "<br /><br /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine
end if
Response.Write " </form>" & vbNewLine
end if
Response.Write " </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<table align=""center"" border=""0"" cellPadding=""0"" cellSpacing=""0"" width=""95%"">" & vbNewLine
'########### GROUP Categories ########### %>
<!--#INCLUDE FILE="inc_groupjump_to.asp" -->
<% '######## GROUP Categories ##############
Response.Write " <tr>" & vbNewLine & _
" <td>" & vbNewLine
sub sForumNavigation()
' DEM --> Added code to show the subscription line
if strSubscription > 0 and strEmail = "1" then
if mlev > 0 then
strSql = "SELECT COUNT(*) AS MySubCount FROM " & strTablePrefix & "SUBSCRIPTIONS"
strSql = strSql & " WHERE MEMBER_ID = " & MemberID
set rsCount = my_Conn.Execute (strSql)
if rsCount.BOF or rsCount.EOF then
' No Subscriptions found, do nothing
MySubCount = 0
rsCount.Close
set rsCount = nothing
else
MySubCount = rsCount("MySubCount")
rsCount.Close
set rsCount = nothing
end if
if mLev = 4 then
strSql = "SELECT COUNT(*) AS SubCount FROM " & strTablePrefix & "SUBSCRIPTIONS"
set rsCount = my_Conn.Execute (strSql)
if rsCount.BOF or rsCount.EOF then
' No Subscriptions found, do nothing
SubCount = 0
rsCount.Close
set rsCount = nothing
else
SubCount = rsCount("SubCount")
rsCount.Close
set rsCount = nothing
end if
end if
else
SubCount = 0
MySubCount = 0
end if
else
SubCount = 0
MySubCount = 0
end if
'# Dgoldman - Start Petition Code
'Get Petition Count SQL
strSql = "SELECT COUNT(P_ID) AS P_COUNT FROM " & strMemberTablePrefix & "PETITION WHERE P_MODERATED = 0"
Set countrs = my_conn.execute(strsql)
if Not countrs.EOF Then
intPCount = countrs("P_COUNT")
else
intPCount = 0
end If
countrs.Close
Set countrs = Nothing
'Get Petition Count Code Above
'# Dgoldman - End
'Response.Write " <a href=""" & strHomeURL & """" & dWStatus("Homepage") & " tabindex=""-1""><acronym title=""Homepage"">Home</acronym></a>" & vbNewline & _
Response.Write " <a href=""" & "http://www.TheGunnersAcademy.com/forum" & """" & dWStatus("Homepage") & " tabindex=""-1""><acronym title=""Homepage"">Home</acronym></a>" & vbNewline & _
" |" & vbNewline
if strUseExtendedProfile then
Response.Write " <a href=""https://www.TheGunnersAcademy.com/forum/pop_profile.asp?mode=Edit""" & dWStatus("Edit your personal profile...") & " tabindex=""-1""><acronym title=""Edit your personal profile..."">Profile</acronym></a>" & vbNewline & _
" |" & vbNewline
else
Response.Write " <a href=""javascript:openWindow3('https://www.TheGunnersAcademy.com/forum/pop_profile.asp?mode=Edit')""" & dWStatus("Edit your personal profile...") & " tabindex=""-1""><acronym title=""Edit your personal profile..."">Profile </acronym></a>" & vbNewline & _
" |" & vbNewline
end if
'# Dgoldman - Start - calendar
Response.Write " <a href=""" & "http://www.TheGunnersAcademy.com/forum/Calendar.asp" & """" & dWStatus("Calendar") & " tabindex=""-1""><acronym title=""Match / Event Calendar"">Calendar</acronym></a>" & vbNewline
'# End - calendar
if strAutoLogon <> "1" then
if strProhibitNewMembers <> "1" then
Response.Write " |" & vbNewline & _
" <a href=""https://www.TheGunnersAcademy.com/forum/register.asp""" & dWStatus("Register to post to our forum...") & " tabindex=""-1""><acronym title=""Register to post to our forum..."">Register</acronym></a>" & vbNewline
end if
end if
Response.Write " |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/active.asp""" & dWStatus("See what topics have been active since your last visit...") & " tabindex=""-1""><acronym title=""See what topics have been active since your last visit..."">Active Topics</acronym></a>" & vbNewline
' DEM --> Start of code added to show subscriptions if they exist
if (strSubscription > 0) then
if mlev = 4 and SubCount > 0 then
Response.Write " |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/subscription_list.asp?MODE=all""" & dWStatus("See all current subscriptions") & " tabindex=""-1""><acronym title=""See all current subscriptions"">All Subscriptions</acronym></a>" & vbNewline
end if
if MySubCount > 0 then
Response.Write " |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/subscription_list.asp""" & dWStatus("See all of your subscriptions") & " tabindex=""-1""><acronym title=""See all of your subscriptions"">My Subscriptions</acronym></a>" & vbNewline
end if
end if
' DEM --> End of Code added to show subscriptions if they exist
Response.Write " |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/members.asp""" & dWStatus("Current members of these forums...") & " tabindex=""-1""><acronym title=""Current members of these forums..."">Members</acronym></a>" & vbNewline & _
" |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/search.asp"
if Request.QueryString("FORUM_ID") <> "" then Response.Write("?FORUM_ID=" & cLng(Request.QueryString("FORUM_ID")))
Response.Write """" & dWStatus("Perform a search by keyword, date, and/or name...") & " tabindex=""-1""><acronym title=""Perform a search by keyword, date, and/or name..."">Search</acronym></a>" & vbNewline & _
" |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/faq.asp""" & dWStatus("Answers to Frequently Asked Questions...") & " tabindex=""-1""><acronym title=""Answers to Frequently Asked Questions..."">FAQ</acronym></a>" & vbNewline
set my_Conn=Server.CreateObject("ADODB.Connection")
my_Conn.Open strConnString
strSql="SELECT P_SWITCH FROM " & strTablePrefix & "P_OPTIONS"
set rsswitch = my_Conn.Execute(strSql)
if (not rsswitch.BOF and not rsswitch.EOF) then
strPSwitch=rsswitch("P_SWITCH")
rsswitch.close
set rsswitch=nothing
end if
if strPSwitch=0 then
'Do nothing
else
'Do nothing
'Response.Write "| <a href=""http://www.TheGunnersAcademy.com/forum/petition.asp""" & dWStatus("Register for a class!") & " tabindex=""-1""><acronym title=""There are currently " & intPCount & " signatures!""><font face=""" & strDefaultFontFace & """ size=""" & strfooterFontSize & """>Signup for a class! (" & intPCount & ")</acronym></a> " & vbNewline
end if
'########### STATs LINK ###########
if mLev = 3 then
Response.Write " |" & vbNewline & _
" <a href=""http://www.TheGunnersAcademy.com/forum/member_stats.asp""" & dWStatus("Site Statistics") & " tabindex=""-1"">Site Statistics</a>" & vbNewLine
end if
'########### STATs LINK ###########
end sub
if strGroupCategories = "1" then
if Session(strCookieURL & "GROUP_NAME") = "" then
GROUPNAME = " Default Groups "
else
GROUPNAME = Session(strCookieURL & "GROUP_NAME")
end if
'Forum_SQL - Get Groups
strSql = "SELECT GROUP_ID, GROUP_CATID "
strSql = strSql & " FROM " & strTablePrefix & "GROUPS "
strSql = strSql & " WHERE GROUP_ID = " & Group
set rsgroups = Server.CreateObject("ADODB.Recordset")
rsgroups.Open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsgroups.EOF then
recGroupCatCount = ""
else
allGroupCatData = rsgroups.GetRows(adGetRowsRest)
recGroupCatCount = UBound(allGroupCatData, 2)
end if
rsgroups.Close
set rsgroups = nothing
end if
Response.Write "<div align=center>"
%>
This is the default.asp
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## Copyright (C) 2000-09 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
'##
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<!--#INCLUDE FILE="inc_func_secure.asp" -->
<!--#INCLUDE FILE="inc_sha256.asp"-->
<!--#INCLUDE FILE="inc_header.asp" -->
<!--#INCLUDE FILE="inc_func_member.asp" -->
<!--#INCLUDE FILE="inc_moderation.asp" -->
<!--#INCLUDE FILE="inc_subscription.asp" -->
<!--#INCLUDE FILE="inc_birthdays.asp" -->
<!--#INCLUDE FILE="inc_news_body.asp" -->
<%
Dim UnapprovedFound, UnModeratedPosts
if Request.QueryString("CAT_ID") <> "" and IsNumeric(Request.QueryString("CAT_ID")) = True then
Cat_ID = cLng(Request.QueryString("CAT_ID"))
end if
scriptname = request.servervariables("script_name")
if strAutoLogon = 1 then
if (ChkAccountReg() <> "1") then
Response.Redirect("https://www.TheGunnersAcademy.com/forum/register.asp?mode=DoIt")
end if
end if
if IsEmpty(Session(strCookieURL & "last_here_date")) then
Session(strCookieURL & "last_here_date") = ReadLastHereDate(strDBNTUserName)
end if
if strModeration = "1" and mLev > 2 then
UnModeratedPosts = CheckForUnmoderatedPosts("BOARD", 0, 0, 0)
end if
' -- Get all the high level(board, category, forum) subscriptions being held by the user
Dim strSubString, strSubArray, strBoardSubs, strCatSubs, strForumSubs
if MySubCount > 0 then
strSubString = PullSubscriptions(0,0,0)
strSubArray = Split(strSubString,";")
if uBound(strSubArray) < 0 then
strBoardSubs = ""
strCatSubs = ""
strForumSubs = ""
else
strBoardSubs = strSubArray(0)
strCatSubs = strSubArray(1)
strForumSubs = strSubArray(2)
end if
end If
' === Begin Get the Visitor Count ===
Dim VisitorCount, VC_Day_Day, VC_Day_Count, VC_Month_Month, VC_Month_Count, VC_Year_Year, VC_Year_Count
strSqlV = "SELECT * FROM " & strMemberTablePrefix & "TOTALS"
set rsV = Server.CreateObject("ADODB.Recordset")
rsV.open strSqlV, my_Conn, adOpenKeyset, adLockPessimistic
if not rsV.EOF then
VisitorCount = rsV("VISITORCOUNT")
VC_Year_Year = rsV("VC_YEAR_YEAR")
VC_Year_Count = rsV("VC_YEAR_COUNT")
VC_Month_Month = rsV("VC_MONTH_MONTH")
VC_Month_Count = rsV("VC_MONTH_COUNT")
VC_Day_Day = rsV("VC_DAY_DAY")
VC_Day_Count = rsV("VC_DAY_COUNT")
else
' SHOULD NEVER GET HERE!!!!
rsV.AddNew
VisitorCount = 0
VC_Year_Year = 0
VC_Year_Count = 0
VC_Month_Month = 0
VC_Month_Count = 0
VC_Day_Day = 0
VC_Day_Count = 0
end if
If Session("Visitor") = "" Then
' ==== If this is first time, increment things.
Session("Visitor") = "1"
VisitorCount = VisitorCount + 1
If Year(date) = VC_Year_Year Then
VC_Year_Count = VC_Year_Count + 1
Else
VC_Year_Year = Year(date)
VC_Year_Count = 1
VC_Month_Month = 0
VC_Day_Day = 0
End If
If Month(date) = VC_Month_Month Then
VC_Month_Count = VC_Month_Count + 1
Else
VC_Month_Month = Month(date)
VC_Month_Count = 1
VC_Day_Day = 0
End If
If Day(date) = VC_Day_Day Then
VC_Day_Count = VC_Day_Count + 1
Else
VC_Day_Day = Day(date)
VC_Day_Count = 1
End If
rsV("VISITORCOUNT") = VisitorCount
rsV("VC_YEAR_YEAR") = VC_Year_Year
rsV("VC_YEAR_COUNT") = VC_Year_Count
rsV("VC_MONTH_MONTH") = VC_Month_Month
rsV("VC_MONTH_COUNT") = VC_Month_Count
rsV("VC_DAY_DAY") = VC_Day_Day
rsV("VC_DAY_COUNT") = VC_Day_Count
rsV.Update
End If
rsV.close
set rsV = nothing
' === End Get the Visitor Count ===
if strShowStatistics <> "1" then
'## Forum_SQL
strSql = "SELECT P_COUNT, T_COUNT, U_COUNT " &_
" FROM " & strTablePrefix & "TOTALS"
Set rs1 = Server.CreateObject("ADODB.Recordset")
rs1.open strSql, my_Conn
'# Here is the information from the database on the user counts
Users = rs1("U_COUNT")
Topics = rs1("T_COUNT")
Posts = rs1("P_COUNT")
rs1.Close
set rs1 = nothing
end if
if (strShowModerators = "1") or (mlev = 4 or mlev = 3) then
'## Forum_SQL
strSql = "SELECT MO.FORUM_ID, ME.MEMBER_ID, ME.M_NAME " & _
" FROM " & strTablePrefix & "MODERATOR MO" & _
" , " & strMemberTablePrefix & "MEMBERS ME" & _
" WHERE (MO.MEMBER_ID = ME.MEMBER_ID )" & _
" ORDER BY MO.FORUM_ID, ME.M_NAME"
Set rsChk = Server.CreateObject("ADODB.Recordset")
rsChk.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsChk.EOF then
recModeratorCount = ""
else
allModeratorData = rsChk.GetRows(adGetRowsRest)
recModeratorCount = UBound(allModeratorData,2)
end if
rsChk.close
set rsChk = nothing
if recModeratorCount = "" then
fMods = " "
else
mFORUM_ID = 0
mMEMBER_ID = 1
mM_NAME = 2
for iModerator = 0 to recModeratorCount
ModForumID = allModeratorData(mFORUM_ID, iModerator)
ModMemID = allModeratorData(mMEMBER_ID, iModerator)
ModMemName = replace(allModeratorData(mM_NAME, iModerator),"|","#124")
if iModerator = 0 then
strForumMods = ModForumID & "," & ModMemID & "," & ModMemName
else
strForumMods = strForumMods & "|" & ModForumID & "," & ModMemID & "," & ModMemName
end if
next
end if
end if
'## Forum_SQL - Get all Categories from the DB
strSql = "SELECT CAT_ID, CAT_STATUS, CAT_NAME, CAT_ORDER, CAT_SUBSCRIPTION, CAT_MODERATION " &_
" FROM " & strTablePrefix & "CATEGORY "
'############################## Group Cat MoD #####################################
if Cat_ID <> "" then
strSql = strSql & " WHERE CAT_ID = " & Cat_ID
else
if Group > 1 and strGroupCategories = "1" then
strSql = strSql & " WHERE CAT_ID = 0"
if recGroupCatCount <> "" then
for iGroupCat = 0 to recGroupCatCount
strSql = strSql & " or CAT_ID = " & allGroupCatData(1, iGroupCat)
next
end if
end if
end if
'############################## Group Cat MoD #####################################
strSql = strSql & " ORDER BY CAT_ORDER ASC, CAT_NAME ASC;"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF then
if Cat_ID <> "" then response.redirect("default.asp")
recCategoryCount = ""
else
allCategoryData = rs.GetRows(adGetRowsRest)
recCategoryCount = UBound(allCategoryData,2)
end if
rs.close
set rs = nothing
if mlev = 3 then
strSql = "SELECT FORUM_ID FROM " & strTablePrefix & "MODERATOR " & _
" WHERE MEMBER_ID = " & MemberID
Set rsMod = Server.CreateObject("ADODB.Recordset")
rsMod.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsMod.EOF then
recModCount = ""
else
allModData = rsMod.GetRows(adGetRowsRest)
recModCount = UBound(allModData,2)
end if
RsMod.close
set RsMod = nothing
if recModCount <> "" then
for x = 0 to recModCount
if x = 0 then
ModOfForums = allModData(0,x)
else
ModOfForums = ModOfForums & "," & allModData(0,x)
end if
next
else
ModOfForums = ""
end if
else
ModOfForums = ""
end if
'## Forum_SQL - Build SQL to get forums via category
strSql = "SELECT F.FORUM_ID, F.F_STATUS, F.CAT_ID, F.F_SUBJECT, F.F_URL, F.F_TOPICS, " &_
"F.F_COUNT, F.F_LAST_POST, F.F_LAST_POST_TOPIC_ID, F.F_LAST_POST_REPLY_ID, F.F_TYPE, " & _
"F.F_ORDER, F.F_A_COUNT, F.F_SUBSCRIPTION, F_PRIVATEFORUMS, F_PASSWORD_NEW, " & _
"M.MEMBER_ID, M.M_NAME, " & _
"T.T_REPLIES, T.T_UREPLIES, " & _
"F.F_DESCRIPTION " & _
"FROM ((" & strTablePrefix & "FORUM F " &_
"LEFT JOIN " & strMemberTablePrefix & "MEMBERS M ON " &_
"F.F_LAST_POST_AUTHOR = M.MEMBER_ID) " & _
"LEFT JOIN " & strTablePrefix & "TOPICS T ON " & _
"F.F_LAST_POST_TOPIC_ID = T.TOPIC_ID) "
'############################## Group Cat MoD #####################################
if Cat_ID <> "" then
strSql = strSql & " WHERE F.CAT_ID = " & Cat_ID
else
if Group > 1 and strGroupCategories = "1" then
strSql = strSql & " WHERE F.CAT_ID = 0"
if recGroupCatCount <> "" then
for iGroupCat = 0 to recGroupCatCount
strSql = strSql & " OR F.CAT_ID = " & allGroupCatData(1, iGroupCat)
next
end if
end if
end if
'############################## Group Cat MoD #####################################
strSql = strSql & " ORDER BY F.F_ORDER ASC, F.F_SUBJECT ASC;"
set rsForum = Server.CreateObject("ADODB.Recordset")
rsForum.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsForum.EOF then
recForumCount = ""
else
allForumData = rsForum.GetRows(adGetRowsRest)
recForumCount = UBound(allForumData,2)
end if
rsForum.close
set rsForum = nothing
if Cat_ID <> "" then
Cat_Name = allCategoryData(2,0)
Response.Write " <script language=""javascript"" type=""text/javascript"">" & vbNewLine & _
" document.title='" & chkString(Cat_Name,"pagetitle") & " - " & chkString(strForumTitle,"pagetitle") & "';" & vbNewLine & _
" </script>" & vbNewLine
end if
Response.Write " <table border=""0"" width=""100%"" cellspacing=""0"" cellpadding=""0"" align=""center"">" & vbNewline & _
" <tr>" & vbNewline & _
" <td>"
' If Whole Board Subscription is allowed, check for a subscription by this user.
if strSubscription = 1 and strEmail = 1 and strDBNTUserName <> "" then
Response.Write vbNewLine
Response.Write " <table width=""100%"" border=""0"">" & vbNewline
Response.Write " <tr>" & vbNewLine
Response.Write " <td align=""right"">"
If strBoardSubs = "Y" then
Response.Write ShowSubLink ("U", 0, 0, 0, "Y")
Else
Response.Write ShowSubLink ("S", 0, 0, 0, "Y")
End If
Response.Write "</td>" & vbNewLine
Response.Write " </tr>" & vbNewline
Response.Write " </table>" & vbNewline
Response.Write " </td>" & vbNewline
Response.Write " </tr>" & vbNewline
Response.Write " <tr>" & vbNewline
Response.Write " <td>"
end if
ShowLastHere = (mLev > 0)
if strShowStatistics <> "1" then
Response.Write vbNewLine & _
" <table width=""100%"" border=""0"">" & vbNewline & _
" <tr>" & vbNewline & _
" <td>"
Response.Write " <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) & """>"
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>"
if ShowLastHere then
Response.Write "You last visited on " & ChkDate(Session(strCookieURL & "last_here_date"), " " ,true) & "<br>" & vbNewline
end if
' === Begin display the Visitor Count ===
Response.Write "The Forum has been visited " & VisitorCount & " time" & IIF(VisitorCount=1,"","s") & "." & _
" (" & VC_Year_Count & " time" & IIF(VC_Year_Count=1," ","s ") & "this year, " & VC_Month_Count & " time" & IIF(VC_Month_Count=1," ","s ") & "this month, " & VC_Day_Count & " time" & IIF(VC_Day_Count=1," ","s ") & "today)" & vbNewline
' === End display the Visitor Count ===
Response.Write "</font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" <tr>" & vbNewLine
Response.Write "</td>" & vbNewline & _
" <td align=""right""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>There are " & Posts & " Posts in " & Topics & " Topics and " & Users & " Users </font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" </table>" & vbNewline & _
" </td>" & vbNewline
else
Response.Write "</td>" & vbNewline
end if
Response.Write "<div align=center>"
'### Dave - Added this here so I can display the banners on on the default page instead of in the inc_header.asp for all pages
'### because of the ssl redirects
%>
<!--#INCLUDE FILE="banner.asp" -->
<%
Response.Write "<Center><font face=""" & strDefaultFontFace & """ size=-1>- <a href=""http://www.TheGunnersAcademy.com/forum/topic.asp?TOPIC_ID=66""" & dWStatus("Want to build web traffic?...") & " tabindex=""-1""><acronym title=""Want to build web traffic?..."">Advertise Your Gun Club, Web Site or Business Here!</a> -</acronym></Center></br>"
Response.Write "</div>"
'### end
Response.Write " </tr>" & vbNewline & _
" <tr>" & vbNewline & _
" <td bgcolor=""" & strTableBorderColor & """>" & vbNewline & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""4"">" & vbNewline & _
" <tr>" & vbNewline & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>"
if Cat_ID <> "" then
Response.Write "<a href=""default.asp"">" & getCurrentIcon(strIconFolder,"Show All Categories","hspace=""0""") & "</a>"
else
Response.Write " "
end if
Response.Write "</font></b></td>" & vbNewline & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>"
if strGroupCategories = "1" then Response.Write(GROUPNAME) else Response.Write("Forum")
Response.Write "</font></b></td>" & vbNewline & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>Topics</font></b></td>" & vbNewline & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>Posts</font></b></td>" & vbNewline & _
" <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>Last Post</font></b></td>" & vbNewline
if (strShowModerators = "1") or (mlev = 4 or mlev = 3) then
Response.Write " <td align=""center"" bgcolor=""" & strHeadCellColor & """ nowrap valign=""top""><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strHeadFontColor & """>Moderator(s)</font></b></td>" & vbNewline
end if
Response.Write " <td align=""center"" bgcolor=""" & strHeadCellColor & """>"
if (mlev = 4 or mlev = 3) or (lcase(strNoCookies) = "1") then
call PostingOptions()
else
Response.write " "
end if
Response.Write "</td>" & vbNewline
Response.Write " </tr>" & vbNewline
If recCategoryCount = "" then
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strCategoryCellColor & """ colspan="""
if (strShowModerators = "1") or (mlev > 0 ) then
Response.Write "6"
else
Response.Write "5"
end if
Response.Write """><font face=""" & strDefaultFontFace & """ color=""" & strCategoryFontColor & """ size=""" & strDefaultFontSize & """><b>No Categories/Forums Found</b></font></td>" & vbNewline & _
" <td bgcolor=""" & strCategoryCellColor & """><font face=""" & strDefaultFontFace & """ color=""" & strCategoryFontColor & """ size=""" & strDefaultFontSize & """> </font></td>" & vbNewline & _
" </tr>" & vbNewline
else
intPostCount = 0
intTopicCount = 0
intForumCount = 0
strLastPostDate = ""
cCAT_ID = 0
cCAT_STATUS = 1
cCAT_NAME = 2
cCAT_ORDER = 3
cCAT_SUBSCRIPTION = 4
cCAT_MODERATION = 5
fFORUM_ID = 0
fF_STATUS = 1
fCAT_ID = 2
fF_SUBJECT = 3
fF_URL = 4
fF_TOPICS = 5
fF_COUNT = 6
fF_LAST_POST = 7
fF_LAST_POST_TOPIC_ID = 8
fF_LAST_POST_REPLY_ID = 9
fF_TYPE = 10
fF_ORDER = 11
fF_A_COUNT = 12
fF_SUBSCRIPTION = 13
fF_PRIVATEFORUMS = 14
fF_PASSWORD_NEW = 15
fMEMBER_ID = 16
fM_NAME = 17
fT_REPLIES = 18
fT_UREPLIES = 19
fF_DESCRIPTION = 20
blnHiddenForums = false
for iCategory = 0 to recCategoryCount
CatID = allCategoryData(cCAT_ID,iCategory)
CatStatus = allCategoryData(cCAT_STATUS,iCategory)
CatName = allCategoryData(cCAT_NAME,iCategory)
CatOrder = allCategoryData(cCAT_NAME,iCategory)
CatSubscription = allCategoryData(cCAT_SUBSCRIPTION,iCategory)
CatModeration = allCategoryData(cCAT_MODERATION,iCategory)
chkDisplayHeader = true
bContainsForum = False
if recForumCount <> "" then
for iForumCheck = 0 to recForumCount
if CatID = allForumData(fCAT_ID, iForumCheck) then bContainsForum = True
next
end if
if (recForumCount = "" or not bContainsForum) and (mLev = 4) then
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(6,5) & """>"
if Cat_ID = "" then
Response.Write "<a href=""default.asp?CAT_ID=" & CatID & """ title=""View only the Forums in this Category""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>" & ChkString(CatName,"display") & "</b></font></a></td>" & vbNewline
else
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>" & ChkString(CatName,"display") & "</b></font></td>" & vbNewline
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
Response.Write " <td bgcolor=""" & strCategoryCellColor & """ align=center valign=""top"" nowrap><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>"
call CategoryAdminOptions()
Response.Write "</font></b></td>" & vbNewline
end if
Response.Write " </tr>" & vbNewline & _
" <tr>" & vbNewline & _
" <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,6) &_
"""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """><b>No Forums Found</b></font></td>" & vbNewline & _
" </tr>" & vbNewline
else
for iForum = 0 to recForumCount
if CatID = allForumData(fCAT_ID, iForum) then '## Forum exists
ForumID = allForumData(fFORUM_ID,iForum)
ForumStatus = allForumData(fF_STATUS,iForum)
ForumCatID = allForumData(fCAT_ID,iForum)
ForumSubject = allForumData(fF_SUBJECT,iForum)
ForumURL = allForumData(fF_URL,iForum)
ForumTopics = allForumData(fF_TOPICS,iForum)
ForumCount = allForumData(fF_COUNT,iForum)
ForumLastPost = allForumData(fF_LAST_POST,iForum)
ForumLastPostTopicID = allForumData(fF_LAST_POST_TOPIC_ID,iForum)
ForumLastPostReplyID = allForumData(fF_LAST_POST_REPLY_ID,iForum)
ForumFType = allForumData(fF_TYPE,iForum)
ForumOrder = allForumData(fF_ORDER,iForum)
ForumACount = allForumData(fF_A_COUNT,iForum)
ForumSubscription = allForumData(fF_SUBSCRIPTION,iForum)
ForumPrivateForums = allForumData(fF_PRIVATEFORUMS,iForum)
ForumFPasswordNew = allForumData(fF_PASSWORD_NEW,iForum)
ForumMemberID = allForumData(fMEMBER_ID,iForum)
ForumMemberName = allForumData(fM_NAME,iForum)
ForumTopicReplies = allForumData(fT_REPLIES,iForum)
ForumTopicUReplies = allForumData(fT_UREPLIES,iForum)
ForumDescription = allForumData(fF_DESCRIPTION,iForum)
Dim AdminAllowed, ModerateAllowed
if mLev = 4 then
AdminAllowed = "Y"
else
AdminAllowed = "N"
end if
if mLev = 4 then
ModerateAllowed = "Y"
elseif mLev = 3 and ModOfForums <> "" then
if (strAuthType = "nt") then
if (chkForumModerator(ForumID, Session(strCookieURL & "username")) = "1") then ModerateAllowed = "Y" else ModerateAllowed = "N"
else
if (instr("," & ModOfForums & "," ,"," & ForumID & ",") <> 0) then ModerateAllowed = "Y" else ModerateAllowed = "N"
end if
else
ModerateAllowed = "N"
end if
if ModerateAllowed = "Y" and ForumTopicUReplies > 0 then
ForumTopicReplies = ForumTopicReplies + ForumTopicUReplies
end if
if ChkDisplayForum(ForumPrivateForums,ForumFPasswordNew,ForumID,MemberID) then
if ForumFType <> "1" then
intPostCount = intPostCount + ForumCount
intTopicCount = intTopicCount + ForumTopics
intForumCount = intForumCount + 1
if ForumLastPost > strLastPostDate then
strLastPostDate = ForumLastPost
intLastPostTopic_ID = ForumLastPostTopicID
intLastPostReply_ID = ForumLastPostReplyID
intTopicReplies = ForumTopicReplies
intLastPostForum_ID = ForumID
intLastPostMember_ID = ForumMemberID
strLastPostMember_Name = ForumMemberName
end if
end if
if chkDisplayHeader then
Call DoHideCategory(CatID)
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(6,5) & """ valign=""top"">"
'##### This code will specify whether or not to show the forums under a category #####
HideForumCat = strUniqueID & "HideCat" & CatID
if Request.Cookies(HideForumCat) = "Y" then
Response.Write "<a href=""" & ScriptName & "?" & HideForumCat & "=N&CAT_ID=" & Cat_ID & """>" & getCurrentIcon(strIconPlus,"Expand This Category","") & "</a>"
else
Response.Write "<a href=""" & ScriptName & "?" & HideForumCat & "=Y&CAT_ID=" & Cat_ID & """>" & getCurrentIcon(strIconMinus,"Collapse This Category","") & "</a>"
end if
if Cat_ID = "" then
Response.Write " <a href=""default.asp?CAT_ID=" & CatID & """ title=""View only the Forums in this Category""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>" & ChkString(CatName,"display") & "</b></font></a> </td>" & vbNewline
else
Response.Write " <font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>" & ChkString(CatName,"display") & "</b></font> </td>" & vbNewline
end if
'##### Above code will specify whether or not to show the forums under a category #####
Response.Write " <td bgcolor=""" & strCategoryCellColor & """ align=""center"" valign=""top"" nowrap><b><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>"
if (mLev = 4 or mLev = 3) or (lcase(strNoCookies) = "1") then
call CategoryAdminOptions()
elseif (mLev > 0) then
call CategoryMemberOptions()
else
Response.Write(" ")
end if
Response.Write "</font></b></td>" & vbNewline
Response.Write " </tr>" & vbNewline
chkDisplayHeader = false
end if
if Request.Cookies(HideForumCat) <> "Y" then '##### added as part of Minimize Category Mod #####
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top"">"
if ForumFType = 0 then
ChkIsNew(ForumLastPost)
else
Response.Write "<a href=""" & ForumURL & """ target=""_blank"">" & getCurrentIcon(strIconUrl,"Visit " & chkString(ForumSubject,"display"),"hspace=""0""") & "</a>"
end if
Response.Write "</td>" & vbNewline & _
" <td"
if ForumFType = 1 then
Response.Write " colspan=""4"""
end if
Response.Write " bgcolor=""" & strForumCellColor & """ valign=""top"">" & _
"<font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """><span class=""spnMessageText""><a href="""
if ForumFType = 0 then
Response.Write "forum.asp?FORUM_ID=" & ForumID
else
Response.Write ForumURL & """ target=""_blank"
end if
Response.Write """>" & chkString(ForumSubject,"display") & "</a><br />" & _
"<font size=""" & strFooterFontSize & """>" & _
formatStr(ForumDescription) & _
"</font></span></font></td>" & vbNewline
if ForumFType = 0 then
if IsNull(ForumTopics) then
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>0</font></td>" & vbNewline
else
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>" & ForumTopics & "</font></td>" & vbNewline
end if
if IsNull(ForumCount) then
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>0</font></td>" & vbNewline
else
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strDefaultFontSize & """>" & ForumCount & "</font></td>" & vbNewline
end if
if IsNull(ForumMemberID) then
strLastUser = " "
else
strLastUser = "<br />by: <span class=""spnMessageText"">" & profileLink(chkString(ForumMemberName,"display"),ForumMemberID) & "</span>"
if strJumpLastPost = "1" then strLastUser = strLastUser & " " & DoLastPostLink(true)
end if
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top"" nowrap><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """>" & _
"<b>" & ChkDate(ForumLastPost, "</b><br />" ,true) & strLastUser & "</font></td>" & vbNewline
else
'## Do Nothing
end if
if (strShowModerators = "1") or (mlev = 4 or mlev = 3) then
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""left"" valign=""top""><font face=""" & strDefaultFontFace & """ color=""" & strForumFontColor & """ size=""" & strFooterFontSize & """><span class=""spnMessageText"">" & listForumModerators(ForumID) & "</span></font></td>" & vbNewline
end if
Response.Write " <td bgcolor=""" & strForumCellColor & """ align=""center"" valign=""top"" nowrap>"
if ModerateAllowed = "Y" or (lcase(strNoCookies) = "1") then
call ForumAdminOptions
else
call ForumMemberOptions
end if
Response.Write "</td>" & vbNewline
Response.Write " </tr>" & vbNewline
end if ' ##### Added as part of Minimize Category Mod #####
else
blnHiddenForums = true
end if ' ChkDisplayForum()
end if
next '## Next Forum
end if
next '## Next Category
end if
'######################################################
' Start - Birtday Mod
Call DisplayBirthdays(30,1)
' End - Birtday Mod
'######################################################
if strShowStatistics = "1" then
WriteStatistics
end if
Response.Write " </table>" & vbNewline & _
" </td>" & vbNewline & _
" </tr>" & vbNewline & _
" <tr>" & vbNewline & _
" <td>" & vbNewline & _
" <table width=""100%"">" & vbNewline & _
" <tr>" & vbNewline & _
" <td><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>" & vbNewline & _
" " & getCurrentIcon(strIconUrl,"Web Link","align=""absmiddle""") & " Web Link<br />" & vbNewLine & _
" " & getCurrentIcon(strIconFolderLocked,"Locked Topic","align=""absmiddle""") & " Locked topic<br />" & vbNewLine & _
" " & getCurrentIcon(strIconFolderNew,"New Posts","align=""absmiddle""") & " Contains new posts since last visit<br />" & vbNewline & _
" " & getCurrentIcon(strIconFolder,"Old Posts","align=""absmiddle""") & " No new posts since the last visit<br /></td></font>" & vbNewline & _
" </tr>" & vbNewline & _
" </table>" & vbNewline & _
" </td>" & vbNewline & _
" </tr>" & vbNewline & _
" </table>" & vbNewline
'# Dgoldman - debug
'Response.write "mlev:" & mlev
WriteFooter
sub PostingOptions()
if (mlev = 4) or (lcase(strNoCookies) = "1") then
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """>"
if Session(strCookieURL & "Approval") = "15916941253" then Response.Write("<a href=""down.asp"">" & getCurrentIcon(strIconLock,"Shut Down the Forum","hspace=""0""") & "</a>")
Response.Write " <a href=""post.asp?method=Category"">" & getCurrentIcon(strIconFolderNewTopic,"Create New Category","hspace=""0""") & "</a>"
if strArchiveState = "1" then Response.Write(" <a href=""admin_forums.asp"">" & getCurrentIcon(strIconFolderArchive,"Archive Forum Topics","hspace=""0""") & "</a>")
Response.Write("</font>")
' DEM --> Start of Code for Full Moderation
if UnModeratedPosts > 0 then
Response.Write " <a href=""moderate.asp"">" & getCurrentIcon(strIconFolderModerate,"View All UnModerated Posts","hspace=""0""") & "</a>"
'Response.Write " <a href=""JavaScript:openWindow('pop_moderate.asp')"">" & getCurrentIcon(strIconFolderModerate,"Approve/Hold/Reject all UnModerated Posts","hspace=""0""") & "</a>"
end if
' DEM --> End of Code for Full Moderation
' DEM - Added to allow for sorting
Response.Write " <a href=""Javascript:openWindow3('admin_config_order.asp')"">" & getCurrentIcon(strIconSort,"Set the order of Forums and Categories","hspace=""0""") & "</a>"
'############################## Group Cat MoD #####################################
if strGroupCategories = "1" then Response.Write(" <a href=""admin_config_groupcats.asp?method=Edit"">" & getCurrentIcon(strIconGroupCategories,"Configure Group Categories","hspace=""0""") & "</a>")
'############################## Group Cat MoD #####################################
elseif (mlev = 3) then
if UnModeratedPosts > 0 then
Response.Write " <a href=""moderate.asp"">" & getCurrentIcon(strIconFolderModerate,"View All UnModerated Posts","hspace=""0""") & "</a>"
else
Response.Write " "
end if
else
Response.Write " "
end if
end sub
sub ChkIsNew(dt)
Response.Write "<a href=""forum.asp?FORUM_ID=" & ForumID & """>"
if CatStatus <> 0 and ForumStatus <> 0 then
if dt > Session(strCookieURL & "last_here_date") and (ForumCount > 0 or ForumTopics > 0) then
Response.Write getCurrentIcon(strIconFolderNew,"New Posts","hspace=""0""") & "</a>"
else
Response.Write getCurrentIcon(strIconFolder,"Old Posts","hspace=""0""") & "</a>"
end if
elseif ForumLastPost > Session(strCookieURL & "last_here_date") then
if CatStatus = 0 then
strAltText = "Category Locked"
else
strAltText = "Forum Locked"
end if
Response.Write getCurrentIcon(strIconFolderNewLocked,strAltText,"hspace=""0""") & "</a>"
else
if CatStatus = 0 then
strAltText = "Category Locked"
else
strAltText = "Forum Locked"
end if
Response.Write getCurrentIcon(strIconFolderLocked,strAltText,"hspace=""0""") & "</a>"
end if
end sub
sub CategoryAdminOptions()
if (mlev = 4 or mlev = 3) or (lcase(strNoCookies) = "1") then
if (mlev = 4) or (lcase(strNoCookies) = "1") then
if (CatStatus <> 0) then
Response.Write " <a href=""JavaScript:openWindow('pop_lock.asp?mode=Category&CAT_ID=" & CatID & "')"">" & getCurrentIcon(strIconLock,"Lock Category","hspace=""0""") & "</a>"
else
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Category&CAT_ID=" & CatID & "')"">" & getCurrentIcon(strIconUnlock,"Un-Lock Category","hspace=""0""") & "</a>"
end if
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
if (CatStatus <> 0) then
Response.Write " <a href=""post.asp?method=EditCategory&CAT_ID=" & CatID & """>" & getCurrentIcon(strIconPencil,"Edit Category Name","hspace=""0""") & "</a>"
end if
end if
if mlev = 4 or (lcase(strNoCookies) = "1") then
Response.Write " <a href=""JavaScript:openWindow('pop_delete.asp?mode=Category&CAT_ID=" & CatID & "')"">" & getCurrentIcon(strIconTrashcan,"Delete Category","hspace=""0""") & "</a>"
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
if (CatStatus <> 0) then
Response.Write " <a href=""post.asp?method=Forum&CAT_ID=" & CatID & """>" & getCurrentIcon(strIconFolderNewTopic,"Create New Forum","hspace=""0""") & "</a>"
end if
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
if (CatStatus <> 0) then
Response.Write " <a href=""post.asp?method=URL&CAT_ID=" & CatID & """>" & getCurrentIcon(strIconUrlSmall,"Create New Web Link","hspace=""0""") & "</a>"
end if
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
if (CatStatus <> 0) and strArchiveState = "1" then
''## Forum_SQL
'strSQL = "SELECT FORUM_ID FROM " & strTablePrefix & "FORUM WHERE CAT_ID=" & CatID & " AND F_TYPE = 0"
'Set rsArchive = Server.CreateObject("ADODB.Recordset")
'rsArchive.open strSql, my_Conn
'archID = ""
'do while not rsArchive.EOF
' if archID <> "" then
' archID = archID & ", "
' end if
' archID = archID & rsArchive("FORUM_ID")
' rsArchive.movenext
'loop
'if archID <> "" then Response.Write " <a href=""admin_forums.asp?action=archive&target=admin_forums.asp&id=" & Server.URLEncode(archID) & """>" & getCurrentIcon(strIconFolderArchive,"Archive All Forums in Category","hspace=""0""") & "</a>"
'rsArchive.close
'set rsArchive = nothing
end if
end if
if (strSubscription = 1 or strSubscription = 2) and CatSubscription = 1 and strEmail = 1 then
if InArray(strCatSubs,CatID) then
Response.Write " " & ShowSubLink ("U", CatID, 0, 0, "N")
elseif strBoardSubs <> "Y" then
Response.Write " " & ShowSubLink ("S", CatID, 0, 0, "N")
end if
elseif mLev = "3" then
Response.Write " "
end if
else
Response.Write " "
end if
end sub
sub CategoryMemberOptions()
if (strSubscription = 1 or strSubscription = 2) and CatSubscription = 1 and CatStatus <> 0 and strEmail = 1 then
if InArray(strCatSubs,CatID) then
Response.Write " " & ShowSubLink ("U", CatID, 0, 0, "N")
elseif strBoardSubs <> "Y" then
Response.Write " " & ShowSubLink ("S", CatID, 0, 0, "N")
end If
else
Response.Write " "
end if
end sub
sub ForumAdminOptions()
if (ModerateAllowed = "Y") or (lcase(strNoCookies) = "1") then
if ForumFType = 0 then
if CatStatus = 0 then
if (mlev = 4) then
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Category&CAT_ID=" & CatID & "')"">" & getCurrentIcon(strIconUnlock,"Un-Lock Category","hspace=""0""") & "</a>"
end if
else
if ForumStatus = 1 then
Response.Write " <a href=""JavaScript:openWindow('pop_lock.asp?mode=Forum&FORUM_ID=" & ForumID & "&CAT_ID=" & ForumCatID & "')"">" & getCurrentIcon(strIconLock,"Lock Forum","hspace=""0""") & "</a>"
else
Response.Write " <a href=""JavaScript:openWindow('pop_open.asp?mode=Forum&FORUM_ID=" & ForumID & "&CAT_ID=" & ForumCatID & "')"">" & getCurrentIcon(strIconUnlock,"Un-Lock Forum","hspace=""0""") & "</a>"
end if
end if
end if
if ForumFType = 0 then
if (CatStatus <> 0 and ForumStatus <> 0) or (ModerateAllowed = "Y") or (lcase(strNoCookies) = "1") then
Response.Write " <a href=""post.asp?method=EditForum&FORUM_ID=" & ForumID & "&CAT_ID=" & ForumCatID & """>" & getCurrentIcon(strIconPencil,"Edit Forum Properties","hspace=""0""") & "</a>"
end if
else
if ForumFType = 1 then
Response.Write " <a href=""post.asp?method=EditURL&FORUM_ID=" & ForumID & "&CAT_ID=" & ForumCatID & """>" & getCurrentIcon(strIconPencil,"Edit URL Properties","hspace=""0""") & "</a>"
end if
end if
if (mlev = 4) or (lcase(strNoCookies) = "1") then
Response.Write " <a href=""JavaScript:openWindow('pop_delete.asp?mode=Forum&FORUM_ID=" & ForumID & "&CAT_ID=" & ForumCatID & "')"">" & getCurrentIcon(strIconTrashcan,"Delete Forum","hspace=""0""") & "</a>"
end if
if ForumFType = 0 then
Response.Write " <a href=""post.asp?method=Topic&FORUM_ID=" & ForumID & """>" & getCurrentIcon(strIconFolderNewTopic,"New Topic","hspace=""0""") & "</a>"
end if
if ((mlev = 4) or (lcase(strNoCookies) = "1")) and (ForumFType = 0) and (strArchiveState = "1") then
Response.Write " <a href=""admin_forums.asp?action=archive&id=" & ForumID & """>" & getCurrentIcon(strIconFolderArchive,"Archive Forum","hspace=""0""") & "</a>"
end if
if (ForumFType = 0 and ForumACount > 0) and strArchiveState = "1" then
Response.Write " <a href=""forum.asp?ARCHIVE=true&FORUM_ID=" & ForumID & """>" & getCurrentIcon(strIconFolderArchived,"View Archived posts","hspace=""0""") & "</a>"
end if
if (strSubscription > 0 and strSubscription < 4) and CatSubscription > 0 and ForumSubscription = 1 and strEmail = 1 then
if InArray(strForumSubs,ForumID) then
Response.Write " " & ShowSubLink ("U", ForumCatID, ForumID, 0, "N")
elseif strBoardSubs <> "Y" and not(InArray(strCatSubs,ForumCatID)) then
Response.Write " " & ShowSubLink ("S", ForumCatID, ForumID, 0, "N")
end if
end if
else
Response.Write " "
end if
end sub
sub ForumMemberOptions()
if (mlev > 0) then
if ForumFType = 0 and ForumStatus > 0 and CatStatus > 0 then
Response.Write "<a href=""post.asp?method=Topic&FORUM_ID=" & ForumID & """>" & getCurrentIcon(strIconFolderNewTopic,"New Topic","hspace=""0""") & "</a>"
else
Response.Write " "
end if
else
Response.Write " "
end if
if (ForumFType = 0 and ForumACount > 0) and strArchiveState = "1" then
Response.Write " <a href=""forum.asp?ARCHIVE=true&FORUM_ID=" & ForumID & """>" & _
getCurrentIcon(strIconFolderArchived,"View Archived posts","hspace=""0""") & "</a>"
end if
' DEM --> Start of code for Subscription
if ForumFType = 0 and (strSubscription > 0 and strSubscription < 4) and CatSubscription > 0 and ForumSubscription = 1 and (mlev > 0) and strEmail = 1 then
if InArray(strForumSubs,ForumID) then
Response.Write " " & ShowSubLink ("U", ForumCatID, ForumID, 0, "N")
elseif strBoardSubs <> "Y" and not(InArray(strCatSubs,ForumCatID)) then
Response.Write " " & ShowSubLink ("S", ForumCatID, ForumID, 0, "N")
end if
end if
' DEM --> End of Code for Subscription
end sub
sub WriteStatistics()
Dim Forum_Count
Dim NewMember_Name, NewMember_Id, Member_Count
Dim LastPostDate, LastPostLink
Forum_Count = intForumCount
'## Forum_SQL - Get newest membername and id from DB
strSql = "SELECT M_NAME, MEMBER_ID FROM " & strMemberTablePrefix & "MEMBERS " &_
" WHERE M_STATUS = 1 AND MEMBER_ID > 1 " &_
" ORDER BY MEMBER_ID desc;"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open TopSQL(strSql,1), my_Conn
if not rs.EOF then
NewMember_Name = chkString(rs("M_NAME"), "display")
NewMember_Id = rs("MEMBER_ID")
else
NewMember_Name = ""
end if
rs.close
set rs = nothing
'## Forum_SQL - Get Active membercount from DB
strSql = "SELECT COUNT(MEMBER_ID) AS U_COUNT FROM " & strMemberTablePrefix & "MEMBERS WHERE M_POSTS > 0 AND M_STATUS=1"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn
if not rs.EOF then
Member_Count = rs("U_COUNT")
else
Member_Count = 0
end if
rs.close
set rs = nothing
'## Forum_SQL - Get membercount from DB
strSql = "SELECT COUNT(MEMBER_ID) AS U_COUNT FROM " & strMemberTablePrefix & "MEMBERS WHERE M_STATUS=1"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn
if not rs.EOF then
User_Count = rs("U_COUNT")
else
User_Count = 0
end if
rs.close
'# Dgoldman - Start Ouijas Logged in users mod
set rs = nothing
'## Forum_SQL to grab active members
strSql = "SELECT M_NAME, M_LASTACTIVE, MEMBER_ID "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " ORDER BY M_LASTACTIVE DESC;"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF then
todaysUsersCount = 0
else
todaysUsers = rs.GetRows(adGetRowsRest)
todaysUsersCount = UBound(todaysUsers,2)
end if
rs.close
set rs = nothing
'## Forum_SQL to grab active member counts
strSql = "SELECT HIGHEST_ACTIVE_USERS_COUNT, HIGHEST_ACTIVE_USERS_DATE"
strSql = strSql & " FROM " & strTablePrefix & "TOTALS "
Set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rs.EOF then
highestActiveUserCount = 1
highestActiveUserDate = strForumTimeAdjust
else
highestActiveUserCount = rs("HIGHEST_ACTIVE_USERS_COUNT")
highestActiveUserDate = rs("HIGHEST_ACTIVE_USERS_DATE")
end if
if not isDate(highestActiveUserDate) then
highestActiveUserCount = 1
highestActiveUserDate = strForumTimeAdjust
end if
rs.close
set rs = nothing
LastPostDate = ""
'# Dgoldman - End Ouijas Logged in users mod
LastPostLink = ""
LastPostAuthorLink = ""
if not (intLastPostForum_ID = "") then
ForumTopicReplies = intTopicReplies
ForumLastPostTopicID = intLastPostTopic_ID
ForumLastPostReplyID = intLastPostReply_ID
LastPostDate = ChkDate(strLastPostDate,"",true)
LastPostLink = DoLastPostLink(false)
LastPostAuthorLink = " by: <span class=""spnMessageText"">" & profileLink(chkString(strLastPostMember_Name,"display"),intLastPostMember_ID) & "</span>"
end if
ActiveTopicCount = -1
if not IsNull(Session(strCookieURL & "last_here_date")) then
if not blnHiddenForums then
'## Forum_SQL - Get ActiveTopicCount from DB
strSql = "SELECT COUNT(" & strTablePrefix & "TOPICS.T_LAST_POST) AS NUM_ACTIVE " &_
" FROM " & strTablePrefix & "TOPICS " &_
" WHERE (((" & strTablePrefix & "TOPICS.T_LAST_POST)>'"& Session(strCookieURL & "last_here_date") & "'))" &_
" AND " & strTablePrefix & "TOPICS.T_STATUS <= 1"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn
if not rs.EOF then
ActiveTopicCount = rs("NUM_ACTIVE")
else
ActiveTopicCount = 0
end if
rs.close
set rs = nothing
end if
end if
ArchivedPostCount = 0
ArchivedTopicCount = 0
if not blnHiddenForums and strArchiveState = "1" then
'## Forum_SQL
strSql = "SELECT P_A_COUNT, T_A_COUNT FROM " & strTablePrefix & "TOTALS"
set rs = Server.CreateObject("ADODB.Recordset")
rs.open strSql, my_Conn
if not rs.EOF then
ArchivedPostCount = rs("P_A_COUNT")
ArchivedTopicCount = rs("T_A_COUNT")
else
ArchivedPostCount = 0
ArchivedTopicCount = 0
end if
rs.Close
set rs = nothing
end if
ShowLastHere = (cLng(chkUser(strDBNTUserName, Request.Cookies(strUniqueID & "User")("Pword"),-1)) > 0)
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strCategoryCellColor & """ colspan=""" & sGetColspan(7,6) &_
"""><font face=""" & strDefaultFontFace & """ size=""" & strDefaultFontSize & """ color=""" & strCategoryFontColor & """><b>Statistics</b></font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" <tr>" & vbNewline & _
" <td rowspan="""
intStatRowSpan = 4
if ShowLastHere then
intStatRowSpan = intStatRowspan + 1
end if
if ArchivedPostCount > 0 and strArchiveState = "1" then
intStatRowSpan = intStatRowspan + 1
end if
if NewMember_Name <> "" then
intStatRowSpan = intStatRowSpan + 1
end if
Response.Write intStatRowSpan
Response.Write """ bgcolor=""" & strForumCellColor & """> </td>" & vbNewLine
Response.Write " <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) & """>"
Response.Write "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>"
if ShowLastHere then
Response.Write "You last visited on " & ChkDate(Session(strCookieURL & "last_here_date"), " " ,true) & "<br>" & vbNewline
end if
' === Begin display the Visitor Count ===
Response.Write "The Forum has been visited " & VisitorCount & " time" & IIF(VisitorCount=1,"","s") & "." & _
" (" & VC_Year_Count & " time" & IIF(VC_Year_Count=1," ","s ") & "this year, " & VC_Month_Count & " time" & IIF(VC_Month_Count=1," ","s ") & "this month, " & VC_Day_Count & " time" & IIF(VC_Day_Count=1," ","s ") & "today)" & vbNewLinevbNewline
' === End display the Visitor Count ===
Response.Write "</font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" <tr>" & vbNewLine
if intPostCount > 0 then
Response.Write " <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) &_
""">" & _
"<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>"
if Member_Count = 1 and User_Count = 1 then
Response.Write "1 Member has "
else
Response.Write Member_Count & " of " & User_Count & " <span class=""spnMessageText""><a href=""members.asp"">Members</a></span> have "
end if
Response.Write " made "
if intPostCount = 1 then
Response.Write "1 post "
else
Response.Write intPostCount & " posts"
end if
Response.Write " in "
if intForumCount = 1 then
Response.Write "1 forum"
else
Response.Write intForumCount & " forums"
end if
if (LastPostDate = "" or LastPostLink = "" or intPostCount = 0) then
Response.Write "."
else
Response.Write ", with the last post on <span class=""spnMessageText"">" & LastPostLink & LastPostDate & "</a></span>"
if LastPostAuthorLink <> "" then
Response.Write LastPostAuthorLink & "."
else
Response.Write "."
end if
end if
Response.Write "</font></td>" & vbNewline & _
" </tr>" & vbNewline & _
" <tr>" & vbNewline
end if
Response.Write " <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) &_
""">" & _
"<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>There "
if intTopicCount = 1 then
Response.Write "is "
else
Response.Write "are "
end if
Response.Write " currently "
if intTopicCount > 0 then
Response.Write intTopicCount
else
Response.Write "no"
end if
if intTopicCount = 1 then
Response.Write " topic"
else
Response.Write " topics"
end if
if ActiveTopicCount > 0 then
Response.Write " and " & ActiveTopicCount & " <span class=""spnMessageText""><a href=""active.asp"">active "
if ActiveTopicCount = 1 then
Response.Write "topic"
else
Response.Write "topics"
end if
Response.Write "</a></span> since you last visited."
elseif blnHiddenForums and (strLastPostDate > Session(strCookieURL & "last_here_date")) and ShowLastHere then
Response.Write " and there are <span class=""spnMessageText""><a href=""active.asp"">active topics</a></span> since you last visited."
elseif not(ShowLastHere) then
Response.Write "."
else
Response.Write " and no active topics since you last visited."
end if
Response.Write "</font></td>" & vbNewline & _
" </tr>" & vbNewline
if ArchivedPostCount > 0 and strArchiveState = "1" then
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) &_
"""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>" & _
"There "
if ArchivedPostCount = 1 then
Response.Write "is "
else
Response.Write "are "
end if
Response.Write ArchivedPostCount & " "
if ArchivedPostCount = 1 then
Response.Write " archived post "
else
Response.Write " archived posts"
end if
if ArchivedTopicCount > 0 then
Response.Write " in " & ArchivedTopicCount
if ArchivedTopicCount = 1 then
Response.Write " archived topic"
else
Response.Write " archived topics"
end if
end if
Response.Write "</font></td>" & vbNewline & _
" </tr>" & vbNewline
end if
'###########################################
' Dgoldman - Start of active users logged on
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) &_
"""><font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>Active Users: "
if todaysUsersCount > 0 then
activeUserCount = 0
for i = 0 to todaysUsersCount
lastActive = todaysUsers(1, i)
if isDate(lastActive) then
if DateDiff ("n", DateAdd("n", -15, strForumTimeAdjust), lastActive) > 0 then
if activeUserCount > 0 then
Response.write ","
end if
if strUseExtendedProfile then
Response.Write " <a href=""pop_profile.asp?mode=display&id=" & todaysUsers(2, i) & """" & dWStatus("View " & ChkString(todaysUsers(0, i),"display") & "'s Profile") & ">"
else
Response.Write " <a href=""JavaScript:openWindow3('pop_profile.asp?mode=display&id=" & todaysUsers(2, i) & "')""" & dWStatus("View " & ChkString(todaysUsers(0, i),"display") & "'s Profile") & ">"
end if
Response.write " " & todaysUsers(0, i) & "</a>"
if i < todaysUsersCount then
activeUserCount = activeUserCount + 1
end if
end if
end if
next
end if
if not activeUserCount < highestActiveUserCount then
'## Update highestActiveUserCount column
strHighestActiveSql = "UPDATE " & strTablePrefix & "TOTALS "
strHighestActiveSql = strHighestActiveSql & " SET HIGHEST_ACTIVE_USERS_COUNT = " & activeUserCount
strHighestActiveSql = strHighestActiveSql & ", HIGHEST_ACTIVE_USERS_DATE = '" & strForumTimeAdjust & "'"
my_Conn.Execute (strHighestActiveSql),,adCmdText + adExecuteNoRecords
highestActiveUserCount = activeUserCount
highestActiveUserDate = strForumTimeAdjust
end if
Response.write "<br>Current number of users logged in is " & activeUserCount & _
"<br>Highest ever was " & highestActiveUserCount & " on " & highestActiveUserDate & "</font></td>" & vbNewLine & _
" </tr>" & vbNewline
if NewMember_Name <> "" then
' Dgoldman - End of active users logged on
'###########################################
Response.Write " <tr>" & vbNewline & _
" <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(6,5) &_
""">" & _
"<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """ color=""" & strForumFontColor & """>Please welcome our newest member: " & _
"<span class=""spnMessageText"">" & profileLink(NewMember_Name,NewMember_Id) & "</span>.</font></td>" & vbNewline & _
" </tr>" & vbNewline
end if
'########################################################################
'# Dgoldman Start - Add active user count to footer on default.asp
'Response.Write " <tr>" & vbNewline & _
' " <td bgcolor=""" & strForumCellColor & """ colspan=""" & sGetColspan(7,7) &_
' """>" & _
' "<font face=""" & strDefaultFontFace & """ size=""" & strFooterFontSize & """>Users currently logged on to the forum: " & Application("ActiveUsers") & "</font><br>" & _
' "</tr>"
'# Dgoldman End
'Response.write "Active Users Count Test:" & activeUserCount
'########################################################################
end sub
Sub DoHideCategory(intCatId)
HideForumCat = strUniqueID & "HideCat" & intCatId
if Request.QueryString(HideForumCat) = "Y" then
Response.Cookies(HideForumCat) = "Y"
Response.Cookies(HideForumCat).Expires = dateAdd("d", 30, strForumTimeAdjust)
else
if Request.QueryString(HideForumCat) = "N" then
Response.Cookies(HideForumCat) = "N"
Response.Cookies(HideForumCat).Expires = dateadd("d", -2, strForumTimeAdjust)
end if
end if
end sub
Function DoLastPostLink(showicon)
if ForumLastPostReplyID <> 0 then
PageLink = "whichpage=-1&"
AnchorLink = "&REPLY_ID="
DoLastPostLink = "<a href=""topic.asp?" & PageLink & "TOPIC_ID=" & ForumLastPostTopicID & AnchorLink & ForumLastPostReplyID & """>"
if (showicon = true) then DoLastPostLink = DoLastPostLink & getCurrentIcon(strIconLastpost,"Jump to Last Post","align=""absmiddle""") & "</a>"
elseif ForumLastPostTopicID <> 0 then
DoLastPostLink = "<a href=""topic.asp?TOPIC_ID=" & ForumLastPostTopicID & """>"
if (showicon = true) then DoLastPostLink = DoLastPostLink & getCurrentIcon(strIconLastpost,"Jump to Last Post","align=""absmiddle""") & "</a>"
else
DoLastPostLink = ""
end if
end function
function listForumModerators(fForum_ID)
fForumMods = split(strForumMods,"|")
for iModerator = 0 to ubound(fForumMods)
fForumMod = split(fForumMods(iModerator),",")
ModForumID = fForumMod(0)
ModMemID = fForumMod(1)
ModMemName = fForumMod(2)
if cLng(ModForumID) = cLng(fForum_ID) then
if fMods = "" then
fMods = "<nobr>" & profileLink(chkString(ModMemName,"display"),ModMemID) & "</nobr>"
else
fMods = fMods & ", <nobr>" & profileLink(chkString(ModMemName,"display"),ModMemID) & "</nobr>"
end if
end if
next
if fMods = "" then fMods = " "
listForumModerators = fMods
end function
Function IIF(condition,value1,value2)
If condition Then IIF = value1 Else IIF = value2
End Function
%>
TIA!!! |
|
|
|
Topic |
|
|
|
Topic Locked
