active_topics.asp

简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全

<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<%
'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Forums(TM)
'**  http://www.webwizforums.com
'**                            
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved.
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************



'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 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 strTopicIcon		'Holds the topic icon
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 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 dtmActiveFrom		'Holds the time to get active topics from
Dim intNumberOfTopicPages	'Holds the number of topic pages
Dim intTopicPagesLoopCounter	'Holds the number of loops
Dim blnHideTopic		'Holds if the topic is hidden
Dim strFirstPostMsg		'Holds the first posted message in the topic
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 lngPollID			'Holds the topic poll id number
Dim dtmFirstEntryDate		'Holds the date of the first message
Dim strTableRowColour		'Holds the row colour for the table
Dim sarryTopics			'Holds the topics to display
Dim intTotalRecords		'Holds the number of records in the topics array
Dim intTotalRecordsPages	'Holds the total number of pages
Dim intStartPosition		'Holds the start poition for records to be shown
Dim intEndPosition		'Holds the end poition for records to be shown
Dim intCurrentRecord		'Holds the current record position
Dim strSortDirection		'Holds the sort order
Dim strSortBy			'Holds the way the records are sorted
Dim intPageLinkLoopCounter	'Holds the loop counter for mutiple page links
Dim dtmEventDate		'Holds the date if this is a calendar event
Dim dtmEventDateEnd		'Holds the date if this is a calendar event
Dim intUnReadPostCount		'Holds the count for the number of unread posts in the forum
Dim intUnReadForumPostsLoop	'Loop to count the number of unread posts in a forum
Dim blnUnAnsweredPosts		'Set to true if showing unanwsered posts
Dim strPageName
Dim strPageURL
Dim intMovedForumID


'If this is the first time the page is displayed then the Forum Topic record position is set to page 1
If isNumeric(Request.QueryString("PN")) = false Then
	intRecordPositionPageNum = 1
ElseIf Request.QueryString("PN") < 1 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


'Initilise variables
intShowTopicsFrom = 12 '12 = yesterday
Const intMaxResults = 250




'Read if is this is unaswered posts
If Request.QueryString("UA") = "Y" Then
	blnUnAnsweredPosts = True
Else
	blnUnAnsweredPosts = False
End If


'If we have not yet checked for unread posts since last visit run it now
If Session("dtmUnReadPostCheck") = "" Then 
	Call UnreadPosts()
'Read in array if at application level
ElseIf isArray(Application("sarryUnReadPosts" & strSessionID)) Then  
	sarryUnReadPosts = Application("sarryUnReadPosts" & strSessionID)
'Read in the unread posts array	
ElseIf isArray(Session("sarryUnReadPosts")) Then 
	sarryUnReadPosts = Session("sarryUnReadPosts")
End If




'Get the sort critiria
Select Case Request.QueryString("SO")
	Case "T"
		strSortBy = strDbTable & "Topic.Subject "
	Case "A"
		strSortBy = strDbTable & "Author.Username "
	Case "R"
		strSortBy = strDbTable & "Topic.No_of_replies "
	Case "V"
		strSortBy = strDbTable & "Topic.No_of_views "
	Case Else
		strSortBy = strDbTable & "Topic.Last_Thread_ID "
End Select

'Sort the direction of db results
If Request.QueryString("OB") = "desc" Then
	strSortDirection = "asc"
	strSortBy = strSortBy & "DESC"
Else
	strSortDirection = "desc"
	strSortBy = strSortBy & "ASC"
End If

'If this is the first time it is run the we want dates DESC
If Request.QueryString("OB") = "" AND Request.QueryString("SO") = "" Then 
	strSortDirection = "asc"
	strSortBy = strDbTable & "Topic.Last_Thread_ID DESC"
End If




'If new show period save to app session
If isNumeric(Request.QueryString("AT")) AND Request.QueryString("AT") <> "" Then 
	
	Call saveSessionItem("AT", Request.QueryString("AT"))
	intShowTopicsFrom = CInt(Request.QueryString("AT"))

'Get what date to show active topics
ElseIf getSessionItem("AT") <> "" Then
	
	intShowTopicsFrom = CInt(getSessionItem("AT"))

'If this is not the first time the user has visted then use this date to show active topics from
ElseIf IsDate(getCookie("lVisit", "LV")) Then
	
	If dtmLastVisitDate < CDate(getCookie("lVisit", "LV")) Then intShowTopicsFrom = 1 '1 = last visit
End If


'Initialse the string to display when active topics are shown since
Select Case intShowTopicsFrom
	Case 1
		strShowTopicsFrom = strTxtLastVisitOn & " " & DateFormat(dtmLastVisitDate) & " " & strTxtAt & " " & TimeFormat(dtmLastVisitDate)
		dtmActiveFrom = internationalDateTime(dtmLastVisitDate)
	case 2
		strShowTopicsFrom = strTxtLastFifteenMinutes
		dtmActiveFrom = internationalDateTime(DateAdd("n", -15, now()))
	case 3
		strShowTopicsFrom = strTxtLastThirtyMinutes
		dtmActiveFrom = internationalDateTime(DateAdd("n", -30, now()))
	Case 4
		strShowTopicsFrom = strTxtLastFortyFiveMinutes
		dtmActiveFrom = internationalDateTime(DateAdd("n", -45, now()))
	Case 5
		strShowTopicsFrom = strTxtLastHour
		dtmActiveFrom = internationalDateTime(DateAdd("h", -1, now()))
	Case 6
		strShowTopicsFrom = strTxtLastTwoHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -2, now()))
	Case 7
		strShowTopicsFrom = strTxtLastFourHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -4, now()))
	Case 8
		strShowTopicsFrom = strTxtLastSixHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -6, now()))
	Case 9
		strShowTopicsFrom = strTxtLastEightHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -8, now()))
	Case 10
		strShowTopicsFrom = strTxtLastTwelveHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -12, now()))
	Case 11
		strShowTopicsFrom = strTxtLastSixteenHours
		dtmActiveFrom = internationalDateTime(DateAdd("h", -16, now()))
	Case 12
		strShowTopicsFrom = strTxtYesterday
		dtmActiveFrom = internationalDateTime(DateAdd("d", -1, now()))
	Case 13
		strShowTopicsFrom = strTxtLastTwoDays
		dtmActiveFrom = internationalDateTime(DateAdd("d", -2, now()))
	Case 14
		strShowTopicsFrom = strTxtLastWeek
		dtmActiveFrom = internationalDateTime(DateAdd("ww", -1, now()))
	Case 15
		strShowTopicsFrom = strTxtLastMonth
		dtmActiveFrom = internationalDateTime(DateAdd("m", -1, now()))
	Case 16
		strShowTopicsFrom = strTxtLastTwoMonths
		dtmActiveFrom = internationalDateTime(DateAdd("m", -2, now()))
	Case 17
		strShowTopicsFrom = strTxtLastSixMonths
		dtmActiveFrom = internationalDateTime(DateAdd("m", -6, now()))
	Case 18
		strShowTopicsFrom = strTxtLastYear
		dtmActiveFrom = internationalDateTime(DateAdd("yyyy", -1, now()))
End Select


'If SQL server remove dash (-) from the ISO international date to make SQL Server safe
If strDatabaseType = "SQLServer" Then dtmActiveFrom = Replace(dtmActiveFrom, "-", "", 1, -1, 1)


If strDatabaseType = "Access" Then
	dtmActiveFrom = "#" & dtmActiveFrom & "#"
Else
	dtmActiveFrom = "'" & dtmActiveFrom & "'"
End If



'Initalise SQL query (quite complex but required if we only want 1 db hit to get the lot for the whole page)
strSQL = "" & _
"SELECT "
If strDatabaseType = "SQLServer" OR strDatabaseType = "Access" Then
	strSQL = strSQL & " TOP " & intMaxResults & " "