% @ 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"
'If you are having problem showing posts witin the last few hours then it could be that you have changed the LCID from what
'the server is set to, if this is the case then you must forced it back to the servers own locale for the filter to run
'Session.LCID = 1033
'Dimension variables
Dim rsTopic 'Holds the Recordset for the Topic details
Dim rsForum 'Holds the forum 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 dblActiveFrom 'Holds the time to get active topics from
Dim intNumberOfTopicPages 'Holds the number of topic pages
Dim intTopicPagesLoopCounter 'Holds the number of loops
Dim blnNewPost 'Set to true if the post is a new post since the users last visit
Dim intForumReadRights 'Holds the read rights of the forum
Dim strForumPassword 'Holds the password for the forum
Dim strForumPaswordCode 'Holds the code for the password for the forum
Dim blnForumPasswordOK 'Set to true if the password for the forum is OK
Dim lngPollID 'Holds the topic poll id number
Dim dtmFirstEntryDate 'Holds the date of the first message
Dim intForumGroupPermission 'Holds the group permisison level for forums
'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
'Initliase the forum groip permisions
'If guest group
If intGroupID = 2 Then
intForumGroupPermission = 1
'If admin group
ElseIf intGroupID = 1 Then
intForumGroupPermission = 4
'All other groups
Else
intForumGroupPermission = 2
End If
'Get what date to show active topics till from cookie
If Request.Cookies("AT") <> "" Then
intShowTopicsFrom = CInt(Request.Cookies("AT"))
'If this is not the first time the user has visted then use this date to show active topics from
ElseIf Session("dtmLastVisit") < CDate(Request.Cookies(strCookieName)("LTVST")) Then
intShowTopicsFrom = 1 '1 = last visit
Else
intShowTopicsFrom = 7 '7 = yesterday
End If
'Initialse the string to display when active topics are shown since
Select Case intShowTopicsFrom
Case 1
strShowTopicsFrom = strTxtLastVisitOn & " " & DateFormat(Session("dtmLastVisit"), saryDateTimeData) & " " & strTxtAt & " " & TimeFormat(Session("dtmLastVisit"), saryDateTimeData)
dblActiveFrom = DateDiff("d", Session("dtmLastVisit"), Now()) + 1
case 2
strShowTopicsFrom = strTxtLastFifteenMinutes
dblActiveFrom = 1
case 3
strShowTopicsFrom = strTxtLastThirtyMinutes
dblActiveFrom = 1
Case 4
strShowTopicsFrom = strTxtLastFortyFiveMinutes
dblActiveFrom = 1
Case 5
strShowTopicsFrom = strTxtLastHour
dblActiveFrom = 1
Case 6
strShowTopicsFrom = strTxtLastTwoHours
dblActiveFrom = 1
Case 7
strShowTopicsFrom = strTxtLastFourHours
dblActiveFrom = 1
Case 8
strShowTopicsFrom = strTxtLastSixHours
dblActiveFrom = 1
Case 9
strShowTopicsFrom = strTxtLastEightHours
dblActiveFrom = 1
Case 10
strShowTopicsFrom = strTxtLastTwelveHours
dblActiveFrom = 1
Case 11
strShowTopicsFrom = strTxtLastSixteenHours
dblActiveFrom = 1
Case 12
strShowTopicsFrom = strTxtYesterday
dblActiveFrom = 1
Case 13
strShowTopicsFrom = strTxtLastWeek
dblActiveFrom = 7
Case 14
strShowTopicsFrom = strTxtLastMonth
dblActiveFrom = 28
End Select
%>
<% = strMainForumName %>: Active Topics
<% Call FormatTopTable("100%") %>
| |
<% = strTxtTopics %> |
<% = strTxtThreadStarter %> |
<% = strTxtReplies %> |
<% = strTxtViews %> |
<% = strTxtLastPost %> |
<%
'Create a record set object to the Topics held in the database
Set rsForum = Server.CreateObject("ADODB.Recordset")
'Set the cursor type property of the record set to dynamic so we can naviagate through the record set
rsForum.CursorType = 1
'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 & "ActiveTopics @dblActiveFrom = " & dblActiveFrom & ", @AuthorID = " & lngLoggedInUserID & ", @GroupID = " & intGroupID & ", @GroupPerm = " & intForumGroupPermission
Else
strSQL = "SELECT " & strDbTable & "Forum.Forum_name, " & strDbTable & "Forum.Password, " & strDbTable & "Forum.Forum_code, " & strDBTableTopics & ".* "
strSQL = strSQL & "FROM " & strDBTableCategory & ", " & strDbTable & "Forum, " & strDBTableTopics & " "
strSQL = strSQL & "WHERE ((" & strDBTableCategory & ".Cat_ID = " & strDbTable & "Forum.Cat_ID AND " & strDbTable & "Forum.Forum_ID = " & strDBTableTopics & ".Forum_ID) AND (" & strDBTableTopics & ".Last_entry_date > " & strDatabaseDateFunction & " - " & dblActiveFrom & "))"
strSQL = strSQL & " AND (" & strDbTable & "Forum.[Read] <= " & intForumGroupPermission & " OR (" & strDBTableTopics & ".Forum_ID IN ("
strSQL = strSQL & " SELECT " & strDBTablePermissions & ".Forum_ID "
strSQL = strSQL & " FROM " & strDBTablePermissions & " "
strSQL = strSQL & " WHERE " & strDBTablePermissions & ".Author_ID=" & lngLoggedInUserID & " OR " & strDBTablePermissions & ".Group_ID = " & intGroupID & " AND " & strDBTablePermissions & ".[Read]=TRUE))"
strSQL = strSQL & " )"
strSQL = strSQL & "ORDER BY " & strDBTableCategory & ".Cat_order ASC, " & strDbTable & "Forum.Forum_Order ASC, " & strDBTableTopics & ".Last_entry_date DESC;"
End If
'Query the database
rsForum.Open strSQL, adoCon
'Initialse the string to display when active topics are shown since
Select Case intShowTopicsFrom
Case 1
'Filter the recorset to leave only active topics since last vists (Filter used for overcome incompatibilty problems between application and database)
rsForum.Filter = "Last_entry_date > #" & CDate(Session("dtmLastVisit")) & "#"
case 2
rsForum.Filter = "Last_entry_date > #" & DateAdd("n", -15, Now()) & "#"
case 3
rsForum.Filter = "Last_entry_date > #" & DateAdd("n", -30, Now()) & "#"
Case 4
rsForum.Filter = "Last_entry_date > #" & DateAdd("n", -45, Now()) & "#"
Case 5
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -1, Now()) & "#"
Case 6
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -2, Now()) & "#"
Case 7
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -4, Now()) & "#"
Case 8
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -6, Now()) & "#"
Case 9
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -8, Now()) & "#"
Case 10
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -12, Now()) & "#"
Case 11
rsForum.Filter = "Last_entry_date > #" & DateAdd("h", -16, Now()) & "#"
End Select
'If there are no active topics display an error msg
If rsForum.EOF Then
'If there are no Active Topic's to display then display the appropriate error message
Response.Write vbCrLf & "" & strTxtNoActiveTopicsSince & " " & strShowTopicsFrom & " " & strTxtToDisplay & " | "
End If
'Disply any active topics in the forum
If NOT rsForum.EOF Then
'Read in the forum ID
intForumID = CInt(rsForum("Forum_ID"))
'Set the number of records to display on each page
rsForum.PageSize = intTopicPerPage
'Get the record poistion to display from
rsForum.AbsolutePage = intRecordPositionPageNum
'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
intForumID = CInt(rsForum("Forum_ID"))
lngTopicID = CLng(rsForum("Topic_ID"))
lngPollID = CLng(rsForum("Poll_ID"))
lngNumberOfViews = CLng(rsForum("No_of_views"))
strSubject = rsForum("Subject")
blnTopicLocked = CBool(rsForum("Locked"))
intPriority = CInt(rsForum("Priority"))
strForumPassword = rsForum("Password")
strForumPaswordCode = rsForum("Forum_code")
'If the forum name is different to the one from the last forum display the forum name
If rsForum("Forum_name") <> strForumName Then
'Give the forum name the new forum name
strForumName = rsForum("Forum_name")
'Display the new forum name
Response.Write vbCrLf & "" & strForumName & " | "
End If
'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_date, " & strDbTable & "Author.Username "
strSQL = strSQL & "FROM " & strDbTable & "Author INNER JOIN " & strDbTable & "Thread ON " & strDbTable & "Author.Author_ID = " & strDbTable & "Thread.Author_ID "
strSQL = strSQL & "WHERE " & 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")
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"))
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 & " ")
'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 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 & " | ")
Response.Write(vbCrLf & " ")
'If the user is a forum admin then give let them delete the topic
If blnAdmin Then Response.Write(" ")
'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("
")
'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 %>  |
<%
'Close the topic recordset
rsTopic.Close
'Move to the next database record
rsForum.MoveNext
Next
End If
'Clean up
rsForum.Close
Set rsForum = Nothing
Set rsTopic = Nothing
Call FormatBottomTable("100%")
%>
<%
'***** 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 & ""
%>
<%
'Release server objects
Set rsCommon = Nothing
adoCon.Close
Set adoCon = Nothing
%>