<% '################################################################################# '## Copyright (C) 2000-01 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# Dim ArchiveView Dim HeldFound, UnapprovedFound '################################################################################# if Request("FORUM_ID") = "" and (Request.Form("Method_Type") <> "login") and (Request.Form("Method_Type") <> "logout") then Response.Redirect "default.asp" end if Forum_ID = Request.QueryString("FORUM_ID") MyPage = Request("whichpage") %> <% '############### Posting Restrictions ########################### Dim intTopicAuth Dim intReplyAuth '############### Posting Restrictions ########################### mypage = request("whichpage") if mypage = "" then mypage = 1 end if '############################################ sortorder = request.Form("newsort") SortImg = strImageURL & "icon_sortDOWN.gif" if sortorder <> "" then mypage = 1 else sortorder = request.QueryString("newsort") end if '############################################ nDays = Request.Cookies(strCookieURL & "NumDays") if Request.form("cookie") = 1 then if strSetCookieToForum = "1" then Response.Cookies(strCookieURL & "NumDays").Path = strCookieURL end if Response.Cookies(strCookieURL & "NumDays") = Request.Form("days") Response.Cookies(strCookieURL & "NumDays").expires = strForumTimeAdjust + 365 nDays = Request.Form("Days") mypage = 1 end if if nDays = "" then nDays = 0 end if if request("ARCHIVE") = "true" then strActivePrefix = strTablePrefix & "A_" ArchiveView = "true" nDays = "0" else strActivePrefix = strTablePrefix ArchiveView = "" end if SortOrder = request.Form("newsort") SortImg = request.Form("sortimg") if SortOrder <> "" then mypage = 1 else SortOrder = request.Form("sort") end if defDate = DateToStr(dateadd("d", -(nDays), StrToDate(strForumTimeAdjust))) if (strAuthType = "nt") then set my_Conn = Server.CreateObject("ADODB.Connection") my_Conn.Open strConnString call NTauthenticate() if (ChkAccountReg() = "1") then call NTUser() end if end if %> <% if strPrivateForums = "1" then if Request("Method_Type") = "" and (mLev <> 4) then chkUser4(Forum_ID) end if end if if (mLev = 4) or (chkForumModerator(Forum_ID, STRdbntUserName)= "1") or (lcase(strNoCookies) = "1") then AdminAllowed = 1 else AdminAllowed = 0 end if '## Forum_SQL - Find out the Category/Forum status and if it Exists strSql = "SELECT " & strTablePrefix & "CATEGORY.CAT_STATUS, " & _ strTablePrefix & "CATEGORY.CAT_SUBSCRIPTION, " & _ strTablePrefix & "CATEGORY.CAT_MODERATION, " & _ strTablePrefix & "CATEGORY.CAT_ID, " & _ strTablePrefix & "FORUM.F_STATUS, " & _ strTablePrefix & "FORUM.F_TOPIC_AUTH, " &_ strTablePrefix & "FORUM.F_REPLY_AUTH, " &_ strTablePrefix & "FORUM.F_SUBSCRIPTION, " & _ strTablePrefix & "FORUM.F_MODERATION, " & _ strTablePrefix & "FORUM.F_SUBJECT " & _ " FROM " & strTablePrefix & "CATEGORY, " & _ strTablePrefix & "FORUM " & _ " WHERE " & strTablePrefix & "FORUM.FORUM_ID = " & Forum_ID & _ " AND " & strTablePrefix & "CATEGORY.CAT_ID = " & strTablePrefix & "FORUM.CAT_ID" set rsCFStatus = my_Conn.Execute (StrSql) if rsCFStatus.EOF or rsCFStatus.BOF then rsCFStatus.close set rsCFStatus = nothing Response.Redirect("default.asp") else Cat_ID = rsCFStatus("CAT_ID") Cat_Status = rsCFStatus("CAT_STATUS") Cat_Subscription = rsCFStatus("CAT_SUBSCRIPTION") Cat_Moderation = rsCFStatus("CAT_MODERATION") Forum_Status = rsCFStatus("F_STATUS") Forum_Subject = rsCFStatus("F_SUBJECT") Forum_Subscription = rsCFStatus("F_SUBSCRIPTION") Forum_Moderation = rsCFStatus("F_MODERATION") '############### Posting Restrictions ########################### intTopicAuth = rsCFStatus("F_TOPIC_AUTH") intReplyAuth = rsCFStatus("F_REPLY_AUTH") '############### Posting Restrictions ########################### rsCFStatus.close set rsCFStatus = nothing end if if strModeration = 1 and Cat_Moderation = 1 and (Forum_Moderation = 1 or Forum_Moderation = 2) then Moderation = "Y" end if ' DEM --> End of Code added for Moderation '## Forum_SQL - Get all topics from DB strSql ="SELECT " & strActivePrefix & "TOPICS.T_STATUS, " & strActivePrefix & "TOPICS.CAT_ID, " strSql = strSql & strActivePrefix & "TOPICS.FORUM_ID, " & strActivePrefix & "TOPICS.TOPIC_ID, " strSql = strSql & strActivePrefix & "TOPICS.T_VIEW_COUNT, " & strActivePrefix & "TOPICS.T_SUBJECT, " strSql = strSql & strActivePrefix & "TOPICS.T_AUTHOR, " strSql = strSql & strActivePrefix & "TOPICS.T_INPLACE, " strSql = strSql & strActivePrefix & "TOPICS.T_REPLIES, " & strActivePrefix & "TOPICS.T_LAST_POST, " strSql = strSql & strActivePrefix & "TOPICS.T_LAST_POST_AUTHOR, " '############################################################### strSql = strSql & strActivePrefix & "TOPICS.T_MSGICON, " strSql = strSql & strActivePrefix & "TOPICS.T_INPLACE, " '############################################################### ' #################### Poll Mod ##################### strSQL = strSQL & strTablePrefix & "POLLS.answer1, " ' ################################################### strSql = strSql & strMemberTablePrefix & "MEMBERS.M_NAME, " strSql = strSql & "MEMBERS_1.M_NAME AS LAST_POST_AUTHOR_NAME " strSql = strSql & " FROM ((" & strActivePrefix & "TOPICS LEFT JOIN " & strTablePrefix & "POLLS ON " & strActivePrefix & "TOPICS.TOPIC_ID = " & strTablePrefix & "POLLS.TOPIC_ID)" strSQL = strSQL & " LEFT JOIN " & strMemberTablePrefix & "MEMBERS AS MEMBERS_1 ON " & strActivePrefix & "TOPICS.T_LAST_POST_AUTHOR = MEMBERS_1.MEMBER_ID)" strSQL = strSQL & " LEFT JOIN " & strMemberTablePrefix & "MEMBERS ON " & strActivePrefix & "TOPICS.T_AUTHOR = " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " WHERE " & strActivePrefix & "TOPICS.FORUM_ID = " & Forum_ID & " " if nDays = "-1" then strSql = strSql & " AND " & strActivePrefix & "TOPICS.T_STATUS <> 0 " end if if nDays > "0" then strSql = strSql & " AND (" & strActivePrefix & "TOPICS.T_LAST_POST > '" & defDate & "'" strSql = strSql & " OR " & strActivePrefix & "TOPICS.T_INPLACE = 1 )" end if ' DEM --> if not a Moderator, all unapproved posts should not be viewed. if AdminAllowed = 0 then strSql = strSql & " AND ((" & strActivePrefix & "TOPICS.T_AUTHOR <> " & MemberID strSql = strSql & " AND " & strActivePrefix & "TOPICS.T_STATUS < " ' Ignore unapproved/rejected posts if Moderation = "Y" then strSql = strSql & "2" ' Ignore unapproved posts else strSql = strSql & "3" ' Ignore any hold posts end if strSql = strSql & ") OR " & strActivePrefix & "TOPICS.T_AUTHOR = " & MemberID & ")" end if if Request("sortfield") = "" then strSql = strSql & " ORDER BY " & strActivePrefix & "TOPICS.T_INPLACE DESC, T_LAST_POST DESC " else strSql = strSql & " ORDER BY " & strActivePrefix & "TOPICS." & Request("sortfield") '############################################ If sortorder = "1" Then strSql = strSql & " ASC" SortImg = strImageURL & "icon_sortUP.gif" sortdir = 0 Else strSql = strSql & " DESC" SortImg = strImageURL & "icon_sortDOWN.gif" sortdir = 1 End if '############################################ end if if strDBType = "mysql" then 'MySql specific code if mypage > 1 then intOffset = CInt((mypage-1) * strPageSize) strSql = strSql & " LIMIT " & intOffset & ", " & strPageSize & " " end if '## Forum_SQL - Get the total pagecount strSql2 = "SELECT COUNT(" & strActivePrefix & "TOPICS.TOPIC_ID) AS PAGECOUNT " strSql2 = strSql2 & " FROM " & strActivePrefix & "TOPICS " strSql2 = strSql2 & " WHERE " & strActivePrefix & "TOPICS.TOPIC_ID > 0 " strSql2 = strSql2 & " AND " & strActivePrefix & "TOPICS.FORUM_ID = " & Forum_ID & " " if nDays = "-1" then strSql2 = strSql2 & " AND " & strActivePrefix & "TOPICS.T_STATUS <> 0 " end if if nDays > "0" then strSql2 = strSql2 & " AND " & strActivePrefix & "TOPICS.T_LAST_POST > '" & defDate & "'" end if set rsCount = my_Conn.Execute(strSql2) if not rsCount.eof then maxpages = (rsCount("PAGECOUNT") \ strPageSize ) if rsCount("PAGECOUNT") mod strPageSize <> 0 then maxpages = maxpages + 1 end if else maxpages = 0 end if rsCount.close set rs = Server.CreateObject("ADODB.Recordset") rs.open strSql, my_Conn, 3 if not (rs.EOF or rs.BOF) then rs.movefirst end if else 'end MySql specific code set rs = Server.CreateObject("ADODB.Recordset") rs.open strSql, my_Conn, 3 if not (rs.EOF or rs.BOF) then rs.movefirst rs.pagesize = strPageSize maxpages = cint(rs.pagecount) rs.absolutepage = mypage end if end if %>

All Forums

<% If ArchiveView = "true" then Response.write "" Else Response.write "

" End If %> <% =ChkString(Forum_Subject,"display") %>

<% if (mlev = 4 or mlev = 3 or mlev = 2 or mlev = 1) or (lcase(strNoCookies) = "1") or (Request.Cookies(strUniqueID & "User")("Name") = "" or Request.Cookies(strUniqueID & "User")("Pword") = "") then %> <% call PostNewTopic() %> <% else %> <% end if %>

<% if maxpages > 1 then %>

Pages:

<% Call DropDownPaging() %>

<% else %> <% end if %>

<%'############### Posting Restrictions ###########################%> <% select case intTopicAuth case 1 response.write "All users can post NEW topics in this forum" case 3 response.write "Only Administrators or Moderators can post NEW topics in this forum" case 4 response.write "Only Administrators can post NEW topics in this forum" case else end select select case intReplyAuth case 1 response.write " All users can reply to topics in this forum" case 3 response.write " Only Administrators or Moderators can reply to topics in this forum" case 4 response.write " Only Administrators can reply to topics in this forum" case else end select %>
<%'############### Posting Restrictions ###########################%>

<% If mlev > 0 then response.write "" End If Response.write "" if rs.EOF or rs.BOF then %> <% else rec = 1 do until rs.EOF or (rec = strPageSize + 1) Topic_Status = rs("T_STATUS") Topic_ID = rs("TOPIC_ID") '## Icon Check strSQL = "SELECT * FROM " & strMemberTablePrefix & "USERFILES WHERE F_TOPIC_ID=" & Topic_ID set rsAttach = my_conn.execute (strSQL) if not rsAttach.eof then T_msgImage = "icon_mi_0.gif" T_msgHint = "Topic contains attachments" elseif rs("answer1") <> "" and rs("answer1") <> " " and not IsNull(rs("answer1")) then T_msgImage = "pin.gif" T_msgHint = "Topic contains a Poll" 'elseif rs("T_INPLACE") = "1" then 'T_msgImage = "anchor.gif" 'T_msgHint = "Topic is locked in place. Please read.." else T_msgImage = "icon_mi_" & rs("T_MSGICON") & ".gif" T_msgHint = "" end if %> <% if IsNull(rs("T_LAST_POST_AUTHOR")) then strLastAuthor = "" else strLastAuthor = "
by: " if strUseExtendedProfile then strLastAuthor = strLastAuthor & "" else strLastAuthor = strLastAuthor & "" end if strLastAuthor = strLastAuthor & ChkString(rs("LAST_POST_AUTHOR_NAME"), "display") & "" end if %> <% if mlev > 0 then %> <% end if %> <% rec = rec + 1 rs.MoveNext loop end if %>

	Topic	Author	Replies	Read	Last Post	" if (AdminAllowed = 1) or (lcase(strNoCookies) = "1") then call ForumAdminOptions() else call ForumMemberOptions() end if Response.write "
No Topics Found
<% if Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0 then %><% =ChkIsNew(rs("T_LAST_POST")) %><% else if ArchiveView = "true" then Response.write "" elseif rs("T_LAST_POST") > Session(strCookieURL & "last_here_date") then Response.Write "" else if rs("T_INPLACE") = "1" then Response.Write "" else Response.Write "" end if end if end if %>	<% =ChkString(left(rs("T_SUBJECT"), 50),"display") %> <% if strShowPaging = "1" then TopicPaging() end if %>	<% =ChkString(rs("M_NAME"),"display") %>	<% =rs("T_REPLIES") %>	<% =rs("T_VIEW_COUNT") %>	<% =ChkDate(rs("T_LAST_POST")) %> <% =ChkTime(rs("T_LAST_POST")) %><%=strLastAuthor%>	<% if AdminAllowed = 1 or strNoCookies = "1" then call TopicAdminOptions else call TopicMemberOptions end if%>

<% if maxpages > 1 then %>

There are <% =maxpages %> Pages of Topics:

<% Call Paging() %>

<% else %> <% end if %>

New posts since last logon.
Old Posts. <% if lcase(strHotTopic) = "1" then %>( <% =intHotTopicNum %> replies or more.)<% end if %>
Locked topic.
<% ' DEM --> Start of Code added for moderation if HeldFound = "Y" then Response.Write " Posts which have been held by the administrator/moderator.
" & vbNewline end if if UnapprovedFound = "Y" then Response.Write " Posts which have not been approved by the administrator/moderator.
" & vbNewline end if ' DEM --> End of Code added for moderation %>

<% if (mlev = 4 or mlev = 3 or mlev = 2 or mlev = 1) or (lcase(strNoCookies) = "1") then %>

<% call PostNewTopic() %>

<% else %> <% end if %>

<% WriteFooter ' DEM --> Changed ChkIsNew to add the Full Moderation and to optimize the code Function ChkIsNew(dt) if ((CheckForUnModeratedPosts("TOPIC", Cat_ID, Forum_ID, Topic_ID) > 0) and AdminAllowed = 1) or (CheckForUnModeratedPosts("POSTAUTHOR", Cat_ID, Forum_ID, Topic_ID) > 0) then if Topic_Status <> 3 then UnApprovedFound = "Y" ChkIsNew = "

" elseif Topic_Status = 3 and (AdminAllowed = 1 or rs("T_AUTHOR") = MemberID) then HeldFound = "Y" ChkIsNew = "

" end if elseif rs("T_INPLACE") = 1 then ChkIsNew = "

" elseif dt > Session(strCookieURL & "last_here_date") then if rs("T_REPLIES") >= INTHOTTOPICNUM and lcase(strHotTopic) = "1" Then ChkIsNew = "

" else ChkIsNew = "

" end if elseif rs("T_REPLIES") >= intHotTopicNum and lcase(strHotTopic) = "1" Then ChkIsNew = "

" else ChkIsNew = "

" end if End Function ' DEM --> Changed ChkIsNew to add the Full Moderation and to optimize the code sub PostNewTopic() select case intTopicAuth case 3 if mLev < 3 then exit sub case 4 if mLev < 4 then exit sub case else end select %> <% if Cat_Status = 0 or Forum_Status = 0 then if (AdminAllowed = 1) and (mlev >= intTopicAuth) then %> ">

">New Topic
<% else %>

Category Locked <% end if else if Forum_Status <> 0 then if mlev >= intTopicAuth then%> ">

">New Topic
<% ' #################### Poll Mod ##################### if (intUserPolls = "1") or (mlev = 4 or mlev = 3) then %> ">

">Add Poll <% end if end if ' ################################################### else %>

Forum Locked <% end if end if ' DEM --> Start of Code added to handle subscription processing. if (strSubscription < 4 and strSubscription > 0) and (Cat_Subscription = 1 or Cat_Subscription = 2) and Forum_Subscription = 1 then CheckSubscription "FORUM", MemberID, Cat_ID, Forum_ID, 0, "", "" end if ' DEM --> End of code added to handle subscription processing. %> <% end sub sub ForumAdminOptions() %> <% if (AdminAllowed = 1) or (lcase(strNoCookies) = "1") then if Cat_Status = 0 then if mlev = 4 then %>

<% else %>

<% end if else if Forum_Status <> 0 then %> ')">

<% else %> ')">

<% end if end if if (Cat_Status <> 0 and Forum_Status <> 0) or (AdminAllowed = 1) then %> &type=0"> Edit Forum Properties

<% end if %> ')">

<% ' DEM --> Start of Code for Moderated Posting if (CheckForUnModeratedPosts("FORUM", Cat_ID, Forum_ID, 0) > 0) and (AdminAllowed = 1) then ForumString = "CAT_ID=" & Cat_ID & "&FORUM_ID=" & Forum_ID Response.Write " " & vbNewline end if ' DEM --> End of Code for Moderated Posting ' DEM --> Start of Code added to handle subscription processing. if (strSubscription < 4 and strSubscription > 0) and (Cat_Subscription > 0) and Forum_Subscription = 1 then CheckSubscription "FORUMNOTEXT", MemberID, Cat_ID, Forum_ID, 0, "", "" end if end if %> <% end sub sub ForumMemberOptions() if mLev >= intTopicAuth then%> ">

<% end if ' DEM --> Start of Code added to handle subscription processing. if (strSubscription < 4 and strSubscription > 0) and (Cat_Subscription > 0) and Forum_Subscription > 0 then CheckSubscription "FORUMNOTEXT", MemberID, Cat_ID, Forum_ID, 0, "", "" end if end sub sub Paging() if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if scriptname = request.servervariables("script_name") Response.Write("") for counter = 1 to maxpages if counter <> cint(pge) then ref = "" Response.Write ref else Response.Write("") end if if counter mod strPageNumberSize = 0 then Response.Write("") end if next Response.Write("

" & " " & widenum(counter) & "" & counter & "

" & " " & widenum(counter) & "" & counter & "

") end if end sub sub DropDownPaging() if maxpages > 1 then if mypage = "" then pge = 1 else pge = mypage end if scriptname = request.servervariables("script_name") Response.write "") end if end sub sub TopicPaging() mxpages = (rs("T_REPLIES") / strPageSize) if mxPages <> cint(mxPages) then mxpages = int(mxpages) + 1 end if if mxpages > 1 then Response.Write("") for counter = 1 to mxpages ref = "" Response.Write ref if counter mod strPageNumberSize = 0 then Response.Write("") end if next Response.Write("

	" if ((mxpages > 9) and (mxpages > strPageNumberSize)) or ((counter > 9) and (mxpages < strPageNumberSize)) then ref = ref & " " end if ref = ref & widenum(counter) & "" & counter & "

") end if end sub sub TopicAdminOptions() if Cat_Status = 0 then %> ')"> Un-Lock Category

<% else if Forum_Status = 0 then %> ')"> Un-Lock Forum

<% else if Topic_Status <> 0 then %> &FORUM_ID=<% =rs("FORUM_ID") %>&CAT_ID=<% =Request.QueryString("CAT_ID") %>&Topic_Title=<% =ChkString(rs("T_SUBJECT"),"JSurlpath") %>')"> Lock Topic

<% else %> &FORUM_ID=<% =rs("FORUM_ID") %>&CAT_ID=<% =Request.QueryString("CAT_ID") %>&Topic_Title=<% =ChkString(rs("T_SUBJECT"),"JSurlpath") %>')"> Un-Lock Topic

<% end if end if end if if (AdminAllowed = 1 and mlev >= intTopicAuth ) or (Cat_Status <> 0 and Forum_Status <> 0 and Topic_Status <> 0) then %> &Forum_Title=<% =ChkString(Forum_Subject,"urlpath") %>&Topic_Title=<% =ChkString(rs("T_SUBJECT"),"urlpath") %>"> Edit Message

<% end if %> &FORUM_ID=<% =rs("FORUM_ID") %>&CAT_ID=<% =Request.QueryString("CAT_ID") %>&Topic_Title=<% =ChkString(rs("T_SUBJECT"),"JSurlpath") %>')"> Delete Topic

<% if Topic_Status <= 1 and ArchiveView = "" and mlev >= intReplyAuth then %> &Forum_Title=<% =ChkString(Forum_Subject,"urlpath") %>">

<% end if ' DEM --> Start of Code added to handle subscription processing. if (strSubscription < 4 and strSubscription > 0) and (Cat_Subscription > 0) and Forum_Subscription > 0 then CheckSubscription "TOPICNOTEXT", MemberID, Cat_ID, Forum_ID, Topic_ID, "", "" end if ' DEM --> End of code added to handle subscription processing. ' DEM --> Start of Code for Full Moderation if CheckForUnModeratedPosts("TOPIC", Cat_ID, Forum_ID, Topic_ID) > 0 then TopicString = "TOPIC_ID=" & Topic_ID & "&CAT_ID=" & Cat_ID & "&FORUM_ID=" & Forum_ID Response.Write "

" & vbNewline end if ' DEM --> End of Code for Full Moderation end sub sub TopicMemberOptions() if ((Topic_Status > 0 and rs("T_AUTHOR") = MemberID) or (AdminAllowed = 1 and mlev >= intTopicAuth)) then %> &Forum_Title=<% =ChkString(Forum_Subject,"urlpath") %>&Topic_Title=<% =ChkString(rs("T_SUBJECT"),"urlpath") %>"> Edit Message

<% end if if Topic_Status <= 1 and ArchiveView = "" and mLev > intReplyAuth then %> &Forum_Title=<% =ChkString(Forum_Subject,"urlpath") %>">

<% end if ' DEM --> Start of Code added to handle subscription processing. if (strSubscription < 4 and strSubscription > 0) and (Cat_Subscription > 0) and Forum_Subscription > 0 then CheckSubscription "TOPICNOTEXT", MemberID, Cat_ID, Forum_ID, Topic_ID, "", "" end if ' DEM --> End of code added to handle subscription processing. end sub %>