default.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 and setting a cookie
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 sarryForums			'Holds the recordset array for all the categories and forums
Dim saryMemebrStats		'Holds the member stats
Dim strCategory			'Holds the category name
Dim intCatID			'Holds the id for the category
Dim strForumName		'Holds the forum name
Dim strForumDiscription		'Holds the forum description
Dim strForumPassword		'Holds the forum password if there is one
Dim lngNumberOfTopics		'Holds the number of topics in a forum
Dim lngNumberOfPosts		'Holds the number of Posts in the forum
Dim lngTotalNumberOfTopics	'Holds the total number of topics in a forum
Dim lngTotalNumberOfPosts	'Holds the total number of Posts in the forum
Dim intNumberofForums		'Holds the number of forums
Dim lngLastEntryMeassgeID	'Holds the message ID of the last entry
Dim dtmLastEntryDate		'Holds the date of the last entry to the forum
Dim strLastEntryUser		'Holds the the username of the user who made the last entry
Dim lngLastEntryUserID		'Holds the ID number of the last user to make and entry
Dim dtmLastEntryDateAllForums	'Holds the date of the last entry to all fourms
Dim strLastEntryUserAllForums	'Holds the the username of the user who made the last entry to all forums
Dim lngLastEntryUserIDAllForums	'Holds the ID number of the last user to make and entry to all forums
Dim blnForumLocked		'Set to true if the forum is locked
Dim intForumColourNumber	'Holds the number to calculate the table row colour
Dim blnHideForum		'Set to true if this is a hidden forum
Dim intCatShow			'Holds the ID number of the category to show if only showing one category
Dim intActiveUsers		'Holds the number of active users
Dim intActiveGuests		'Holds the number of active guests
Dim intActiveMembers		'Holds the number of logged in active members
Dim strMembersOnline		'Holds the names of the members online
Dim intSubForumID		'Holds the sub forum ID number
Dim strSubForumName		'Holds the sub forum name
Dim strSubForums		'Holds if there are sub forums
Dim dtmLastSubEntryDate		'Holds the date of the last entry to the forum
Dim strLastSubEntryUser		'Holds the the username of the user who made the last entry
Dim lngLastSubEntryUserID	'Holds the ID number of the last user to make and entry
Dim lngSubForumNumberOfPosts	'Holds the number of posts in the subforum
Dim lngSubForumNumberOfTopics	'Holds the number of topics in the subforum
Dim strSubForumPassword		'Holds sub forum password
Dim intTotalRecords		'Holds the number of records
Dim intCurrentRecord		'Holds the current record position
Dim intTempRecord		'Holds a temporary record position for looping through records for any checks
Dim blnSubRead			'Holds if the user has entry to the sub forum
Dim lngNoOfMembers		'Holds the number of forum members
Dim intArrayPass		'Active users array counter
Dim strBirthdays		'String containing all those with birtdays today
Dim dtmNow			'Now date with off-set
Dim intBirtdayLoopCounter	'Holds the bitrhday loop counter
Dim intLastForumEntryID		'Holds the last forum ID for the last entry for link in forum stats
Dim intTotalViewingForum	'Holds the number of people viewing the forum, including sub forums
Dim intAnonymousMembers		'Holds the number of intAnonymous members online
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 lngTopicID			'Holds the topic ID
Dim strSubject			'Holds the subject
Dim lngSubTopicID		'Holds the topic ID
Dim strSubSubject		'Holds the subject





'Initialise variables
lngTotalNumberOfTopics = 0
lngTotalNumberOfPosts = 0
intNumberofForums = 0
intForumColourNumber = 0
intActiveMembers = 0
intActiveGuests = 0
intActiveUsers = 0
intAnonymousMembers = 0
intTotalRecords = 0
lngNoOfMembers = 0
intBirtdayLoopCounter = 0


'Read in the category to show
If IsNumeric(Request.QueryString("C")) Then
	intCatShow = CInt(Request.QueryString("C"))
Else
	intCatShow = 0
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





'Read the various categories, forums, and permissions from the database in one hit for extra performance
'Initalise the strSQL variable with an SQL statement to query the database
strSQL = "" & _
"SELECT " & strDbTable & "Category.Cat_ID, " & strDbTable & "Category.Cat_name, " & strDbTable & "Forum.Forum_ID, " & strDbTable & "Forum.Sub_ID, " & strDbTable & "Forum.Forum_name, " & strDbTable & "Forum.Forum_description, " & strDbTable & "Forum.No_of_topics, " & strDbTable & "Forum.No_of_posts, " & strDbTable & "Author.Username, " & strDbTable & "Forum.Last_post_author_ID, " & strDbTable & "Forum.Last_post_date, " & strDbTable & "Forum.Password, " & strDbTable & "Forum.Locked, " & strDbTable & "Forum.Hide, " & strDbTable & "Permissions.View_Forum, " & strDbTable & "Forum.Last_topic_ID, " & strDbTable & "Topic.Subject " & _
"FROM (((" & strDbTable & "Category INNER JOIN " & strDbTable & "Forum ON " & strDbTable & "Category.Cat_ID = " & strDbTable & "Forum.Cat_ID) LEFT JOIN " & strDbTable & "Topic ON " & strDbTable & "Forum.Last_topic_ID = " & strDbTable & "Topic.Topic_ID) INNER JOIN " & strDbTable & "Author ON " & strDbTable & "Forum.Last_post_author_ID = " & strDbTable & "Author.Author_ID) INNER JOIN " & strDbTable & "Permissions ON " & strDbTable & "Forum.Forum_ID = " & strDbTable & "Permissions.Forum_ID " & _
"WHERE (" & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & " OR " & strDbTable & "Permissions.Group_ID = " & intGroupID & ") " & _
"ORDER BY " & strDbTable & "Category.Cat_order, " & strDbTable & "Forum.Forum_Order, " & strDbTable & "Permissions.Author_ID DESC;"


'Set error trapping
On Error Resume Next
	
'Query the database
rsCommon.Open strSQL, adoCon

'If an error has occurred write an error to the page
If Err.Number <> 0 Then	Call errorMsg("An error has occurred while executing SQL query on database.", "get_forum_data", "default.asp")
			
'Disable error trapping
On Error goto 0


'Place the recordset into an array
If NOT rsCommon.EOF Then 
	sarryForums = rsCommon.GetRows()
	intTotalRecords = Ubound(sarryForums,2) + 1
End If

'Close the recordset
rsCommon.Close


'SQL Query Array Look Up table
'0 = Cat_ID
'1 = Cat_name
'2 = Forum_ID
'3 = Sub_ID
'4 = Forum_name
'5 = Forum_description
'6 = No_of_topics
'7 = No_of_posts
'8 = Last_post_author
'9 = Last_post_author_ID
'10 = Last_post_date
'11 = Password
'12 = Locked
'13 = Hide
'14 = Read 
'15 = Last_topic_ID
'16 = Topic.Subject



'Get the last signed up user and member stats and birthdays for use at bottom of page
If blnDisplayBirthdays Then
	
	'Get the now date with time off-set
	dtmNow = getNowDate()
	
	'Initalise the strSQL variable with an SQL statement to query the database
	strSQL = "SELECT " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.DOB " & _
	"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
	"WHERE MONTH(" & strDbTable & "Author.DOB) = " & Month(dtmNow) & " " & _
		"AND DAY(" & strDbTable & "Author.DOB) = " & Day(dtmNow) & " " & _
	"ORDER BY " & strDbTable & "Author.Author_ID DESC;"
	
	'Set error trapping
	On Error Resume Next
		
	'Query the database
	rsCommon.Open strSQL, adoCon
	
	'If an error has occurred write an error to the page
	If Err.Number <> 0 AND  strDatabaseType = "mySQL" Then	
		Call errorMsg("An error has occurred while executing SQL query on database.<br />Please check that the MySQL Server version is 4.1 or above.", "get_birthdays", "default.asp")
	ElseIf Err.Number <> 0 Then	
		Call errorMsg("An error has occurred while executing SQL query on database.", "get_birthdays", "default.asp")
	End If
	
				
	'Disable error trapping
	On Error goto 0
	
	'Place the recordset into an array
	If NOT rsCommon.EOF Then 
	
		'Read the recordset into an array
		saryMemebrStats = rsCommon.GetRows()
			
		'Loop through to get all members with birthdays today
		Do While intBirtdayLoopCounter <= Ubound(saryMemebrStats, 2)
			
			'If bitrhday is found for this date then add it to string
			If Month(dtmNow) = Month(saryMemebrStats(2, intBirtdayLoopCounter)) AND Day(dtmNow) = Day(saryMemebrStats(2, intBirtdayLoopCounter)) Then 
					
				'If there is already one birthday then place a comma before the next
				If strBirthdays <> "" Then strBirthdays = strBirthdays & ", "
					
				'Place the birthday into the Birthday array
				strBirthdays = strBirthdays & "<a href=""member_profile.asp?PF=" & saryMemebrStats(1, intBirtdayLoopCounter) & strQsSID2 &  """ rel=""nofollow"">" & saryMemebrStats(0, intBirtdayLoopCounter) & "</a> (" & Fix(DateDiff("m", saryMemebrStats(2, intBirtdayLoopCounter), Year(dtmNow) & "-" & Month(dtmNow) & "-" & Day(dtmNow))/12) & ")"
			End If
			
			'Increment loop counter by 1
			intBirtdayLoopCounter = intBirtdayLoopCounter + 1
		Loop
	End If
	
	'Close recordset
	rsCommon.close
End If






'Read in some stats about the last members
strSQL = "SELECT " & strDBTop1 & " " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_ID " 
If NOT strDatabaseType = "mySQL" Then strSQL = strSQL & ", (SELECT COUNT (*) FROM "  & strDbTable & "Author WHERE 1 = 1) AS memberCount "
strSQL = strSQL & _
"FROM " & strDbTable & "Author" & strDBNoLock & " " & _
"ORDER BY " & strDbTable & "Author.Author_ID DESC " & strDBLimit1 & ";"

'Set error trapping
On Error Resume Next
	
'Query the database
rsCommon.Open strSQL, adoCon

'If an error has occurred write an error to the page
If Err.Number <> 0 Then	Call errorMsg("An error has occurred while executing SQL query on database.", "get_last_USR_+_count", "default.asp")
			
'Disable error trapping
On Error goto 0

'Place the recordset into an array
If NOT rsCommon.EOF Then 
	
	'Read in member count from database (if NOT mySQL)
	If NOT strDatabaseType = "mySQL" Then lngNoOfMembers = CLng(rsCommon("memberCount"))
	
	'Read the recordset into an array
	saryMemebrStats = rsCommon.GetRows()
End If

'Close recordset
rsCommon.close