<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2004 Bruce Corkhill All Rights Reserved. '** '** This program is free software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may use parts of this program in your own private work, but you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the response buffer to true as we maybe redirecting Response.Buffer = True 'Make sure this page is not cached Response.Expires = -1 Response.ExpiresAbsolute = Now() - 2 Response.AddHeader "pragma","no-cache" Response.AddHeader "cache-control","private" Response.CacheControl = "No-Store" 'Dimension variables Dim rsForum 'Holds the Recordset for the forum details Dim rsTopic 'Holds the Recordset for the Topic details Dim intForumID 'Holds the forum ID number Dim strForumName 'Holds the forum name Dim lngNumberOfReplies 'Holds the number of replies for a topic Dim lngTopicID 'Holds the topic ID Dim strSubject 'Holds the topic subject Dim strTopicStartUsername 'Holds the username of the user who started the topic Dim lngTopicStartUserID 'Holds the users Id number for the user who started the topic Dim lngNumberOfViews 'Holds the number of views a topic has had Dim lngLastEntryMessageID 'Holds the message ID of the last entry Dim strLastEntryUsername 'Holds the username of the last person to post a message in a topic Dim lngLastEntryUserID 'Holds the user's ID number of the last person to post a meassge in a topic Dim dtmLastEntryDate 'Holds the date the last person made a post in the topic Dim intRecordPositionPageNum 'Holds the recorset page number to show the topics for Dim intTotalNumOfPages 'Holds the total number of pages in the recordset Dim intRecordLoopCounter 'Holds the loop counter numeber Dim intTopicPageLoopCounter 'Holds the number of pages there are in the forum Dim intLinkPageNum 'Holss the page number to link to Dim intShowTopicsFrom 'Holds when to show the topics from Dim strShowTopicsFrom 'Holds the display text from when the topics are shown from Dim blnForumLocked 'Set to true if the forum is locked Dim blnTopicLocked 'set to true if the topic is locked Dim intPriority 'Holds the priority level of the topic Dim intNumberOfTopicPages 'Holds the number of topic pages Dim intTopicPagesLoopCounter 'Holds the number of loops Dim lngPollID 'Holds the Poll ID Dim blnNewPost 'Set to true if the post is a new post since the users last visit Dim intShowTopicsWithin 'Holds the amount of time to show topics within Dim intMovedForumID 'If the post is moved this holds the moved ID Dim intNonPriorityTopicNum 'Holds the record count for non priority topics Dim strFirstPostMsg 'Holds the first message in the topic Dim dtmFirstEntryDate 'Holds the date of the first message 'Initlaise variables intNonPriorityTopicNum = 0 'Read in the Forum ID to display the Topics for intForumID = CInt(Request.QueryString("FID")) 'If there is no Forum ID to display the Topics for then redirect the user to the main forum page If intForumID = 0 Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect "default.asp" End If 'If this is the first time the page is displayed then the Forum Topic record position is set to page 1 If Request.QueryString("PN") = "" OR Request.QueryString("PN") = 0 Then intRecordPositionPageNum = 1 'Else the page has been displayed before so the Forum Topic record postion is set to the Record Position number Else intRecordPositionPageNum = CInt(Request.QueryString("PN")) End If 'Create a recordset to get the forum details Set rsForum = Server.CreateObject("ADODB.Recordset") 'Read in the forum name from the database 'Initalise the strSQL variable with an SQL statement to query the database If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumsAllWhereForumIs @intForumID = " & intForumID Else strSQL = "SELECT " & strDbTable & "Forum.* FROM " & strDbTable & "Forum WHERE Forum_ID = " & intForumID & ";" End If 'Query the database rsForum.Open strSQL, adoCon 'If there is a record returned by the recordset then check to see if you need a password to enter it If NOT rsForum.EOF Then 'Read in forum details from the database strForumName = rsForum("Forum_name") 'Read in whether the forum is locked or not blnForumLocked = CBool(rsForum("Locked")) 'Read in the time period to show topics within intShowTopicsWithin = CInt(rsForum("Show_topics")) 'Check the user is welcome in this forum Call forumPermisisons(intForumID, intGroupID, CInt(rsForum("Read")), CInt(rsForum("Post")), CInt(rsForum("Reply_posts")), CInt(rsForum("Edit_posts")), CInt(rsForum("Delete_posts")), 0, CInt(rsForum("Poll_create")), CInt(rsForum("Vote")), 0, 0) 'If the user has no read writes then kick them If blnRead = False Then 'Reset Server Objects rsForum.Close Set rsForum = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "insufficient_permission.asp" End If 'If the forum requires a password and a logged in forum code is not found on the users machine then send them to a login page If rsForum("Password") <> "" and Request.Cookies(strCookieName)("Forum" & intForumID) <> rsForum("Forum_code") Then 'Reset Server Objects rsForum.Close Set rsForum = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect to a page asking for the user to enter the forum password Response.Redirect "forum_password_form.asp?FID=" & intForumID End If End If 'Get what date to show topics till from cookie If Request.Cookies("TS") <> "" Then intShowTopicsFrom = CInt(Request.Cookies("TS")) 'Else if there is no cookie use the default set by the forum Else intShowTopicsFrom = intShowTopicsWithin End If 'Initialse the string to display when the topics are show up till Select Case intShowTopicsFrom Case 0 strShowTopicsFrom = strTxtFewYears case 7 strShowTopicsFrom = strTxtWeek case 14 strShowTopicsFrom = strTxtTwoWeeks Case 31 strShowTopicsFrom = strTxtMonth Case 62 strShowTopicsFrom = strTxtTwoMonths Case 182 strShowTopicsFrom = strTxtSixMonths Case 365 strShowTopicsFrom = strTxtYear End Select %> <% = strMainForumName %>: <% = strForumName %>
<% 'Display the forum name Response.Write(strForumName) 'If the forum is locked show a locked pad lock icon If blnForumLocked = True Then Response.Write (" ( " & strTxtForumLocked & ")") End If %>
 <% = strMainForumName %><% Response.Write(strNavSpacer) 'Check there are forum's to display If rsForum.EOF Then 'If there are no forum's to display then display the appropriate error message Response.Write "" & strTxtNoForums & "" 'Else there the are forum's to write the HTML to display it the forum names and a discription Else 'Write the HTML of the forum descriptions as hyperlinks to the forums Response.Write ("" & strForumName & "") End If 'Clean up rsForum.Close %>
") %>
<% = strTxtShowTopics %> <% = strTxtNewTopic %><% 'If the user can create a poll disply a create poll link If blnPollCreate = True Then Response.Write ("") End If Response.Write("
<% 'Get the Topics for the forum from the database 'Initalise the strSQL variable with an SQL statement to query the database to count the number of Topics for each Forum 'Run Stored procedures for SQL Server If strDatabaseType = "SQLServer" Then If intShowTopicsFrom = 0 Then strSQL = "EXECUTE " & strDbProc & "TopicDetialsAll @intForumID = " & intForumID Else strSQL = "EXECUTE " & strDbProc & "TopicDetialsInTheLastXX @intForumID = " & intForumID & ", @intShowTopicsFrom = " & intShowTopicsFrom End If 'Run SQL for Access Else strSQL = "SELECT " & strDbTable & "Topic.Topic_ID, " & strDbTable & "Topic.Moved_ID, " & strDbTable & "Topic.No_of_views, " & strDbTable & "Topic.Subject, " & strDbTable & "Topic.Poll_ID, " & strDbTable & "Topic.Locked, " & strDbTable & "Topic.Priority " strSQL = strSQL & "FROM " & strDbTable & "Topic " 'Choose a where string for the query If intShowTopicsFrom = 0 Then strSQL = strSQL & "WHERE (" & strDbTable & "Topic.Forum_ID = " & intForumID & ") OR (" & strDbTable & "Topic.Priority = 3) OR (" & strDbTable & "Topic.Moved_ID = " & intForumID & ") " Else strSQL = strSQL & "WHERE (((" & strDbTable & "Topic.Forum_ID = " & intForumID & ") OR (" & strDbTable & "Topic.Moved_ID = " & intForumID & ")) AND ((" & strDbTable & "Topic.Last_entry_date > Now() - " & intShowTopicsFrom & ") OR (" & strDbTable & "Topic.Priority > 0))) OR (" & strDbTable & "Topic.Priority = 3) " End If strSQL = strSQL & "ORDER BY " & strDbTable & "Topic.Priority DESC, " & strDbTable & "Topic.Last_entry_date DESC;" End If 'Set the cursor type property of the record set to dynamic so we can naviagate through the record set rsForum.CursorType = 1 'Query the database rsForum.Open strSQL, adoCon 'Set the number of records to display on each page rsForum.PageSize = intTopicPerPage 'Check there are Topic's to display If rsForum.EOF Then 'If there are no Topic's to display then display the appropriate error message Response.Write vbCrLf & "" 'Else there the are topic's so write the HTML to display the topic names and a discription Else 'Get the record poistion to display from rsForum.AbsolutePage = intRecordPositionPageNum 'If there are no records on this page and it's above the frist page then set the page position to 1 If rsForum.EOF AND intRecordPositionPageNum > 1 Then rsForum.AbsolutePage = 1 'Count the number of pages there are in the recordset calculated by the PageSize attribute set above intTotalNumOfPages = rsForum.PageCount 'Craete a Recodset object for the topic details Set rsTopic = Server.CreateObject("ADODB.Recordset") 'Loop round to read in all the Topics in the database For intRecordLoopCounter = 1 to intTopicPerPage 'If there are no records left in the recordset to display then exit the for loop If rsForum.EOF Then Exit For 'Read in Topic details from the database lngTopicID = CLng(rsForum("Topic_ID")) lngPollID = CLng(rsForum("Poll_ID")) intMovedForumID = CInt(rsForum("Moved_ID")) lngNumberOfViews = CLng(rsForum("No_of_views")) strSubject = rsForum("Subject") blnTopicLocked = CBool(rsForum("Locked")) intPriority = CInt(rsForum("Priority")) 'Get a record number for the number of non priority posts If intPriority <= 1 Then intNonPriorityTopicNum = intNonPriorityTopicNum + 1 'If this is the first topic that is not importent then display the forum topics bar If intNonPriorityTopicNum = 1 Then Response.Write vbCrLf & "" 'If this is the first topic and it is an important one then display a bar saying so If intRecordLoopCounter = 1 AND intPriority => 2 Then Response.Write vbCrLf & "" 'Initalise the strSQL variable with an SQL statement to query the database to get the Author and subject from the database for the topic If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "LastAndFirstThreadAuthor @lngTopicID = " & lngTopicID Else strSQL = "SELECT " & strDbTable & "Thread.Thread_ID, " & strDbTable & "Thread.Author_ID, " & strDbTable & "Thread.Message, " & strDbTable & "Thread.Message_date, " & strDbTable & "Author.Username " strSQL = strSQL & "FROM " & strDbTable & "Author, " & strDbTable & "Thread " strSQL = strSQL & "WHERE " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID AND " & strDbTable & "Thread.Topic_ID = " & lngTopicID & " " strSQL = strSQL & "ORDER BY " & strDbTable & "Thread.Message_date ASC;" End If 'Set the cursor type property of the record set to forward only so we can navigate through the record set rsTopic.CursorType = 1 'Query the database rsTopic.Open strSQL, adoCon 'If there is info in the database relating to the topic then get them from the record set If NOT rsTopic.EOF Then 'Read in the subject and author and number of replies from the record set strTopicStartUsername = rsTopic("Username") strFirstPostMsg = Mid(rsTopic("Message"), 1, 275) lngTopicStartUserID = CLng(rsTopic("Author_ID")) lngNumberOfReplies = CLng((rsTopic.RecordCount) - 1) dtmFirstEntryDate = CDate(rsTopic("Message_date")) 'Move to the last record in the record set to get the date and username of the last entry rsTopic.MoveLast 'Read in the username and date of the last entry from the record set lngLastEntryMessageID = CLng(rsTopic("Thread_ID")) strLastEntryUsername = rsTopic("Username") lngLastEntryUserID = CLng(rsTopic("Author_ID")) dtmLastEntryDate = CDate(rsTopic("Message_date")) 'Remove HTML from message for subject link title strFirstPostMsg = removeHTML(strFirstPostMsg) 'Trim the number of characters down to 150 for the subject link title strFirstPostMsg = Mid(Trim(strFirstPostMsg), 1, 150) 'If the length of the message is over 150 then append ... to it If CLng(Len(strFirstPostMsg)) = 150 Then strFirstPostMsg = Trim(strFirstPostMsg) & "..." End If 'Set the booleon varible if this is a new post since the users last visit and has not been read If (CDate(Session("dtmLastVisit")) < dtmLastEntryDate) AND (Request.Cookies("RT")("TID" & lngTopicID) = "") Then blnNewPost = True 'Else this is not a new post so don't set the booleon to true Else blnNewPost = False End If 'Write the HTML of the Topic descriptions as hyperlinks to the Topic details and message Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " ") Response.Write(vbCrLf & " <% 'Close the topic recordset rsTopic.Close 'Move to the next database record rsForum.MoveNext Next End If 'Release server objects Set rsTopic = Nothing rsForum.Close %>
  <% = strTxtTopics %> <% = strTxtThreadStarter %> <% = strTxtReplies %> <% = strTxtViews %> <% = strTxtLastPost %>
" & strTxtNoTopicsToDisplay & " " & strShowTopicsFrom & "
" & strTxtForum & " " & strTxtTopics & "
" & strTxtImportantTopics & "
") 'If the topic is pinned then display the pinned icon If intPriority = 1 Then Response.Write("") 'If the topic is top priorty and locked then display top priporty locked icon ElseIf blnTopicLocked = True AND intPriority > 0 Then Response.Write("") 'If the topic is top priorty then display top priporty icon ElseIf intPriority > 0 Then Response.Write("") 'If the topic is closed display a closed topic icon ElseIf blnTopicLocked = True Then Response.Write("") 'If the topic is moved to another forum display moved post icon ElseIf intMovedForumID = intForumID AND intMovedForumID <> 0 Then Response.Write("") 'If the topic is a hot topic and with new replies then display hot to new replies icon ElseIf (lngNumberOfReplies >= intNumHotReplies OR lngNumberOfViews >= intNumHotViews) AND (blnNewPost = True) Then Response.Write("") 'If this is a hot topic that contains a poll then display the hot topic poll icon ElseIf (lngPollID > 0) AND (lngNumberOfReplies >= intNumHotReplies OR lngNumberOfViews >= intNumHotViews) Then Response.Write("") 'If the topic is a hot topic display hot topic icon ElseIf lngNumberOfReplies >= intNumHotReplies OR lngNumberOfViews >= intNumHotViews Then Response.Write("") 'If the topic is has new replies display new replies icon ElseIf blnNewPost = True Then Response.Write("") 'If there is a poll in the post display the poll post icon ElseIf lngPollID > 0 Then Response.Write("") 'Display topic icon Else Response.Write("") End If Response.Write(vbCrLf & " ") 'If the user is a forum admin or a moderator then give let them delete the topic If blnAdmin OR blnModerator Then Response.Write(vbCrLf & " ") 'If the topic is moved to another forum display moved next to it If intMovedForumID = intForumID AND intMovedForumID <> 0 Then Response.Write(strTxtMoved) 'If there is a poll display a poll text If lngPollID > 0 Then Response.Write(strTxtPoll) 'Display the subject of the topic Response.Write(vbCrLf & " " & strSubject & "") 'Calculate the number of pages for the topic and display links if there are more than 1 page intNumberOfTopicPages = ((lngNumberOfReplies + 1)\intThreadsPerPage) 'If there is a remainder from calculating the num of pages add 1 to the number of pages If ((lngNumberOfReplies + 1) Mod intThreadsPerPage) > 0 Then intNumberOfTopicPages = intNumberOfTopicPages + 1 'If there is more than 1 page for the topic display links to the other pages If intNumberOfTopicPages > 1 Then Response.Write(vbCrLf & "
") 'Loop round to display the links to the other pages For intTopicPagesLoopCounter = 1 To intNumberOfTopicPages 'If there is more than 7 pages display ... last page and exit the loop If intTopicPagesLoopCounter > 7 Then 'If this is position 8 then display just the 8th page If intNumberOfTopicPages = 8 Then Response.Write(vbCrLf & " 8") 'Else display the last 2 pages Else Response.Write(" ...") Response.Write(vbCrLf & " " & intNumberOfTopicPages - 1 & "") Response.Write(vbCrLf & " " & intNumberOfTopicPages & "") End If Exit For End If 'Display the links to the other pages Response.Write(vbCrLf & " " & intTopicPagesLoopCounter & "") Next End If %>		 "><% = strTopicStartUsername %> <% = lngNumberOfReplies %> <% = lngNumberOfViews %> <% Response.Write(DateFormat(dtmLastEntryDate, saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(dtmLastEntryDate, saryDateTimeData)) %>
<% = strTxtBy %> <% = strLastEntryUsername %> &get=last#<% = lngLastEntryMessageID %>" target="_self"><% = strTxtViewLastPost %>
<% 'If there is more than 1 page of topics then dispaly drop down list to the other topics If intTotalNumOfPages > 1 Then 'Display an image link to the last topic Response.Write (vbCrLf & " ") End If %><% 'Reset Server Objects Set rsForum = Nothing Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing %> ") %>
<% 'Display a link to watch or un-watch this topic if email notification is enabled If blnEmail = True AND intGroupID <> 2 Then 'Initalise the SQL string with a query to get the poll details If strDatabaseType = "SQLServer" Then strSQL = "EXECUTE " & strDbProc & "ForumEmailNotify @lngAuthorID = " & lngLoggedInUserID & ", @intForumID= " & intForumID Else strSQL = "SELECT " & strDbTable & "EmailNotify.* " strSQL = strSQL & "FROM " & strDbTable & "EmailNotify " strSQL = strSQL & "WHERE " & strDbTable & "EmailNotify.Author_ID=" & lngLoggedInUserID & " AND " & strDbTable & "EmailNotify.Forum_ID=" & intForumID & ";" End If 'Query the database rsForum.Open strSQL, adoCon 'Create link Response.Write("") 'If a record is return the user is watching this topic If NOT rsForum.EOF Then Response.Write(strTxtUn) 'Display link to watch the topic Response.Write(strTxtWatchThisForum & "") 'Clean up rsForum.Close 'Disply a non breaking space for Netscrape 4 bug Else Response.Write(" ") End If %>") 'Display a prev link if previous pages are available If intRecordPositionPageNum > 1 Then Response.Write("<< " & strTxtPrevious & " ") Response.Write (strTxtPage & " " & _ vbCrLf & " " & strTxtOf & " " & intTotalNumOfPages) 'Display a next link if needed If intRecordPositionPageNum <> intTotalNumOfPages Then Response.Write(" " & strTxtNext & " >>") Response.Write("
<% = strTxtNewTopic %><% 'If the user can create a poll disply a create poll link If blnPollCreate = True Then Response.Write ("") End If Response.Write("
<% = strTxtOpenTopic %> <% = strTxtOpenTopic %> <% = strTxtHotTopic %> <% = strTxtHotTopic %>
<% = strTxtOpenTopicNewReplies %> <% = strTxtOpenTopicNewReplies %> <% = strTxtHotTopicNewReplies %> <% = strTxtHotTopicNewReplies %>
<% = strTxtLockedTopic %> <% = strTxtLockedTopic %> <% = strTxtHighPriorityPost %> <% = strTxtHighPriorityPost %>
<% = strTxtPinnedTopic %> <% = strTxtPinnedTopic %> <% = strTxtHighPriorityPostLocked %> <% = strTxtHighPriorityPostLocked %>

<% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode = True Then If blnTextLinks = True Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("") End If Response.Write("
Copyright ©2001-2004 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Display the process time If blnShowProcessTime Then Response.Write "

" & strTxtThisPageWasGeneratedIn & " " & FormatNumber(Timer() - dblStartTime, 4) & " " & strTxtSeconds & "" %>
<% 'Display an alert message letting the user know the topic has been deleted If Request.QueryString("DL") = "1" Then Response.Write("") End If 'Display an alert message if the user is watching this forum for email notification If Request.QueryString("EN") = "FS" Then Response.Write("") End If 'Display an alert message if the user is not watching this forum for email notification If Request.QueryString("EN") = "FU" Then Response.Write("") End If %>