functions_common.asp

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

		'If there are posts left in the database for this topic get some details for them
		If NOT rsCommon.EOF Then
			
			'Get the post ID of the first post
			lngStartPostID = CLng(rsCommon("Thread_ID"))
			
			'Move to the last message in the topic to get the details of the last post
			rsCommon.MoveLast
			
			'Get the post ID of the last post
			lngLastPostID = CLng(rsCommon("Thread_ID"))
		End If
		
		'Close the recordset
		rsCommon.Close
		

		'Count the number of replies
		strSQL = "SELECT Count(" & strDbTable & "Thread.Topic_ID) AS ReplyCount " & _
		"From " & strDbTable & "Thread" & strDBNoLock & " " & _
		"WHERE " & strDbTable & "Thread.Hide = " & strDBFalse & " " & _
			"AND " & strDbTable & "Thread.Topic_ID = " & lngTopicID & ";"
		
		'Set the cursor type to static	
		rsCommon.CursorType = 3
		
		'Set set the lock type of the recordset to adLockReadOnly 
		rsCommon.LockType = 1

		'Query the database
		rsCommon.Open strSQL, adoCon

		'Read in the thread count
		If NOT rsCommon.EOF Then
			If CLng(rsCommon("ReplyCount")) > 0 Then intReplyCount = CLng(rsCommon("ReplyCount")) - 1 Else intReplyCount = 0
		End If

		'Close rs
		rsCommon.Close


		'Initalise the SQL string with an SQL update command to	update the no. of replies and last author
		strSQL = "UPDATE " & strDbTable & "Topic " & strRowLock & " " & _
		"SET " & strDbTable & "Topic.Start_Thread_ID = " & lngStartPostID & ", " & _
			strDbTable & "Topic.Last_Thread_ID = " & lngLastPostID & ", " & _
			strDbTable & "Topic.No_of_replies = " & intReplyCount & " " & _
		"WHERE " & strDbTable & "Topic.Topic_ID = " & lngTopicID & ";"

		'Set error trapping
		On Error Resume Next

		'Write the updated date	of last	post to	the database
		If lngStartPostID <> "" Then adoCon.Execute(strSQL)

		'If an error has occurred write an error to the page
		If Err.Number <> 0 Then Call errorMsg("An error has occurred while writing to the database.", "updateTopicStats()_update_reply_count", "functions_common.asp")

		'Disable error trapping
		On Error goto 0
End Function







'******************************************
'***  	    Forum Permissions         *****
'******************************************
Public Function forumPermissions(ByVal intForumID, ByVal intGroupID)

	'Declare variables
	Dim rsPermissions	'Holds the permissions recordset
	Dim intCurrentPerRecord	'Holds the current record position
	Dim intPermssionRec	'Holds the permission record to check

	'Initilise variables
	blnRead = False
	blnPost = False
	blnReply = False
	blnEdit = False
	blnDelete = False
	blnPriority = False
	blnPollCreate = False
	blnVote = False
	blnModerator = False
	blnCheckFirst = False
	blnEvents = False


	'If the permissions array is not yet filled run the following (should only run once per page to increase performance) All forums read into the array
	If IsArray(saryPermissions) = false Then

		'Intialise the ADO recordset object
		Set rsPermissions = Server.CreateObject("ADODB.Recordset")

		'Get the users group permissions from the db if there are any
		'Initalise the strSQL variable with an SQL statement to query the database
		strSQL = "SELECT " & strDbTable & "Permissions.Group_ID, " & strDbTable & "Permissions.Author_ID, " & strDbTable & "Permissions.Forum_ID, " & strDbTable & "Permissions.View_Forum, " & strDbTable & "Permissions.Post, " & strDbTable & "Permissions.Reply_posts, " & strDbTable & "Permissions.Edit_posts, " & strDbTable & "Permissions.Delete_posts, " & strDbTable & "Permissions.Priority_posts, " & strDbTable & "Permissions.Poll_create, " & strDbTable & "Permissions.Vote, " & strDbTable & "Permissions.Moderate, " & strDbTable & "Permissions.Display_post, " & strDbTable & "Permissions.Calendar_event " & _
		"FROM " & strDbTable & "Permissions" & strDBNoLock & " " & _
		"WHERE " & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & " " & _
		"ORDER BY " & strDbTable & "Permissions.Author_ID DESC;"

		'Query the database
		rsPermissions.Open strSQL, adoCon

		'Raed the recordset into an array for better performance
		If NOT rsPermissions.EOF Then saryPermissions = rsPermissions.GetRows()

		'Clean up
		rsPermissions.Close
		Set rsPermissions = Nothing
	End If

	'Read in the permissions for the group the member is part of if there are any
	If IsArray(saryPermissions) Then

		'Intilise variable
		intPermssionRec = -1

		'Loop through the records to see if there is one for this forum
		For intCurrentPerRecord = 0 to UBound(saryPermissions,2)
			'See if this record is for this forum
			If CInt(saryPermissions(2,intCurrentPerRecord)) = intForumID Then
				'Get the record number and exit loop
				intPermssionRec = intCurrentPerRecord
				Exit For
			End If
		Next

		'If a record is found read in the details
		If intPermssionRec => 0 Then


			blnRead = CBool(saryPermissions(3,intPermssionRec))
			blnPost = CBool(saryPermissions(4,intPermssionRec))
			blnReply = CBool(saryPermissions(5,intPermssionRec))
			blnEdit = CBool(saryPermissions(6,intPermssionRec))
			blnDelete = CBool(saryPermissions(7,intPermssionRec))
			blnPriority = CBool(saryPermissions(8,intPermssionRec))
			blnPollCreate = CBool(saryPermissions(9,intPermssionRec))
			blnVote = CBool(saryPermissions(10,intPermssionRec))
			blnModerator = CBool(saryPermissions(11,intPermssionRec))
			blnCheckFirst = CBool(saryPermissions(12,intPermssionRec))
			blnEvents = CBool(saryPermissions(13,intPermssionRec))
		End If
	End If
End Function






'******************************************
'***  	        Is Moderator	      *****
'******************************************

'Although the above permissions function can work out if the user is a moderator sometimes we only need to know if the user is a moderator or not

Private Function isModerator(ByVal intForumID, ByVal intGroupID)

	'Declare variables
	Dim rsPermissions	'Holds the permissions recordset
	Dim blnModerator	'Set to true if the user is a moderator

	'Initilise vairiables
	blnModerator = False

	'Intialise the ADO recordset object
	Set rsPermissions = Server.CreateObject("ADODB.Recordset")

	'Get the users group permissions from the db if there are any
	'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums
	strSQL = "SELECT " & strDbTable & "Permissions.Moderate " & _
	"FROM " & strDbTable & "Permissions" & strDBNoLock & " " & _
	"WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & " " & _
	"ORDER BY " & strDbTable & "Permissions.Author_ID DESC;"

	'Query the database
	rsPermissions.Open strSQL, adoCon

	'If there is a result returned by the db set it to the blnModerator variable
	If NOT rsPermissions.EOF Then blnModerator = CBool(rsPermissions("Moderate"))

	'Clean up
	rsPermissions.Close
	Set rsPermissions = Nothing

	'Return the function
	isModerator = blnModerator
End Function








'******************************************
'****     	 Banned IP's  	      *****
'******************************************
Private Function bannedIP()

	

	'Declare variables
	Dim rsIPAddr
	Dim strCheckIPAddress
	Dim strUserIPAddress
	Dim blnIPMatched
	Dim strTmpUserIPAddress
	Dim saryDbIPRange
	Dim intIPLoop

	'Intilise variable
	blnIPMatched = False
	intIPLoop = 0

	'Exit if in demo mode
	If blnDemoMode Then Exit Function

	'Get the users IP
	strUserIPAddress = getIP()


	'Intialise the ADO recordset object
	Set rsIPAddr = Server.CreateObject("ADODB.Recordset")

	'Get any banned IP address from the database
	'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums
	strSQL = "SELECT " & strDbTable & "BanList.IP " & _
	"FROM " & strDbTable & "BanList" & strDBNoLock & " "  & _
	"WHERE " & strDbTable & "BanList.IP Is Not Null;"

	'Query the database
	rsIPAddr.Open strSQL, adoCon

	'If results are returned check 'em out
	If NOT rsIPAddr.EOF Then

		'Place the recordset into array
		saryDbIPRange = rsIPAddr.GetRows()

		'Loop round to show all the categories and forums
		Do While intIPLoop =< Ubound(saryDbIPRange, 2)

			'Get the IP address to check from the recordset
			strCheckIPAddress = saryDbIPRange(0, intIPLoop)

			'See if we need to check the IP range or just one IP address
			'If the last character is a * then this is a wildcard range to be checked
			If Right(strCheckIPAddress, 1) = "*" Then

				'Remove the wildcard charcter form the IP
				strCheckIPAddress = Replace(strCheckIPAddress, "*", "", 1, -1, 1)

				'Trim the users IP to the same length as the IP range to check
				strTmpUserIPAddress = Mid(strUserIPAddress, 1, Len(strCheckIPAddress))

				'See if whats left of the IP matches
				If strCheckIPAddress = strTmpUserIPAddress Then blnIPMatched = True

			'Else check the IP address matches
			Else
				'Else check to see if the IP address match
				If strCheckIPAddress = strUserIPAddress Then blnIPMatched = True

			End If

			'Move to the next record
			intIPLoop = intIPLoop + 1
		Loop
	End If

	'Clean up
	rsIPAddr.Close
	Set rsIPAddr = Nothing

	'Return the function
	bannedIP = blnIPMatched
End Function







'******************************************
'***	  Check submission ID		***
'******************************************

Private Function checkFormID(strFormID)

	'Check to see if the form ID's match if they don't send the user away
	If strFormID <> getSessionItem("formID") Then

		'Clean up before redirecting
		Call saveSessionItem("formID", "")
	        Call closeDatabase()

	       'Redirect to insufficient permissions page
	       Response.Redirect("insufficient_permission.asp?M=sID" & strQsSID3)
	End If
End Function






'******************************************
'***	 Get users IP address		***
'******************************************

Private Function getIP()

	Dim strIPAddr

	'If they are not going through a proxy get the IP address
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then

		strIPAddr = Request.ServerVariables("REMOTE_ADDR")

	'If they are going through multiple proxy servers only get the fisrt IP address in the list (,)
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then

		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)

	'If they are going through multiple proxy servers only get the fisrt IP address in the list (;)
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then

		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)

	'Get the browsers IP address not the proxy servers IP
	Else
		strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	End If

	'Remove all tags in IP string
	strIPAddr =  removeAllTags(strIPAddr)

	'Place the IP address back into the returning function
	getIP = Trim(Mid(strIPAddr, 1, 30))
End Function






'**************************************************
'***	Web Wiz Forums About for debugging	***
'**************************************************

Private Sub about()

	'Reset server objects
	Call closeDatabase()

	Response.Write("" & _
	vbCrLf & "<pre>" & _
	vbCrLf & "*********************************************************" & _
	vbCrLf & "Software: Web Wiz Forums(TM)" & _
	vbCrLf & "Version: " & strVersion & _
	vbCrLf & "Database: " & strDatabaseType & _
	vbCrLf & "Adware: " & blnACode & _
	vbCrLf & "Web Wiz Branding: " & blnLCode & _
	vbCrLf & "Installation ID: " & strInstallID & _
	vbCrLf & "Author: Web Wiz(TM)." & _
	vbCrLf & "Address: Unit 10E, Dawkins Raod Ind Est, Poole, Dorset, UK" & _
	vbCrLf & "Info: http://www.webwizforums.com" & _
	vbCrLf & "Copyright: (C)2001-2008 Web Wiz(TM). All rights reserved" & _
	vbCrLf & "*********************************************************" & _
	vbCrLf & "</pre>")
	
	Response.Flush
	Response.End
End Sub






'******************************************
'***	 Count Unread Private Msg's    ****
'******************************************

'Function to count and update the number of private messages
Private Function updateUnreadPM(ByVal lngMemID)

	Dim intRecievedPMs

	'Initlise the sql statement
	strSQL = "SELECT Count(" & strDbTable & "PMMessage.PM_ID) AS CountOfPM FROM " & strDbTable & "PMMessage " & _
	"WHERE " & strDbTable & "PMMessage.Read_Post = " & strDBFalse & " " & _
		"AND " & strDbTable & "PMMessage.Author_ID = " & lngMemID & ";"

	'Query the database
	rsCommon.Open strSQL, adoCon