functions_common.asp

快速、可设定管理权限等级的论坛程序

<%
'****************************************************************************************
'**  Copyright Notice
'**
'**  Web Wiz Guide ASP Discussion Forum
'**
'**  Copyright 2001-2005 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: -
'**  [e-mail]
'**
'**  or at: -
'**
'**  Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom
'**
'****************************************************************************************




'******************************************
'***  		Create Usercode	      *****
'******************************************

Private Function userCode(ByVal strUsername)

	'Randomise the system timer
	Randomize Timer

	'Calculate a code for the user
	strUserCode = strUsername & hexValue(15)

	'Make the usercode SQL safe
	strUserCode = formatSQLInput(strUserCode)

	'Replace double quote with single in this intance
	strUserCode = Replace(strUserCode, "''", "'", 1, -1, 1)

	'Return the function
	userCode = strUserCode
End Function


'******************************************
'***  	   Random Hex Generator        ****
'******************************************

Private Function hexValue(ByVal intHexLength)

	Dim intLoopCounter
	Dim strHexValue

	'Randomise the system timer
	Randomize Timer

	'Generate a hex value
	For intLoopCounter = 1 to intHexLength

		'Genreate a radom decimal value form 0 to 15
		intHexLength = CInt(Rnd * 1000) Mod 16

		'Turn the number into a hex value
		Select Case intHexLength
			Case 1
				strHexValue = "1"
			Case 2
				strHexValue = "2"
			Case 3
				strHexValue = "3"
			Case 4
				strHexValue = "4"
			Case 5
				strHexValue = "5"
			Case 6
				strHexValue = "6"
			Case 7
				strHexValue = "7"
			Case 8
				strHexValue = "8"
			Case 9
				strHexValue = "9"
			Case 10
				strHexValue = "A"
			Case 11
				strHexValue = "B"
			Case 12
				strHexValue = "C"
			Case 13
				strHexValue = "D"
			Case 14
				strHexValue = "E"
			Case 15
				strHexValue = "F"
			Case Else
				strHexValue = "Z"
		End Select

		'Place the hex value into the return string
		hexValue = hexValue & strHexValue
	Next
End Function



'******************************************
'***      Disallowed Member Names     *****
'******************************************
Private Function disallowedMemberNames(ByVal strUserName)

	strUsername = Replace(strUsername, "salt", "", 1, -1, 1)
	strUsername = Replace(strUsername, "password", "", 1, -1, 1)
	strUsername = Replace(strUsername, "author", "", 1, -1, 1)
	strUsername = Replace(strUsername, "code", "", 1, -1, 1)
	strUsername = Replace(strUsername, "username", "", 1, -1, 1)
	strUsername = Replace(strUsername, "NoAct", "", 1, -1, 1)

	'Return Function
	disallowedMemberNames = strUsername
End Function




'******************************************
'***     DB Topic/Post Count Update   *****
'******************************************

Private Function updateTopicPostCount(ByVal intForumID)

	Dim rsCount		'Database recordset holding the number of topics and posts
	Dim lngNumberOfTopics	'Holds the number of topics
	Dim lngNumberOfPosts	'Holds the number of posts

	'Intilaise variables
	lngNumberOfTopics = 0
	lngNumberOfPosts = 0

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

	'Get the number of Topics
	'Initalise the strSQL variable with an SQL statement to query the database to count the number of topics in the forums
	If strDatabaseType = "SQLServer" Then
		strSQL = "EXECUTE " & strDbProc & "ForumTopicCount @intForumID = " & intForumID
	Else
		strSQL = "SELECT Count(" & strDbTable & "Topic.Forum_ID) AS Topic_Count "
		strSQL = strSQL & "From " & strDbTable & "Topic "
		strSQL = strSQL & "WHERE " & strDbTable & "Topic.Forum_ID = " & intForumID & " "
	End If

	'Query the database
	rsCount.Open strSQL, adoCon

	'Read in the number of Topics
	If NOT rsCount.EOF Then lngNumberOfTopics = CLng(rsCount("Topic_Count"))

	'Close the rs
	rsCount.Close

	'Get the number of Posts
	'Initalise the strSQL variable with an SQL statement to query the database to count the number of threads in the forums
	If strDatabaseType = "SQLServer" Then
		strSQL = "EXECUTE " & strDbProc & "ForumThreadCount @intForumID = " & intForumID
	Else
		strSQL = "SELECT Count(" & strDbTable & "Thread.Thread_ID) AS Thread_Count "
		strSQL = strSQL & "FROM " & strDbTable & "Topic INNER JOIN " & strDbTable & "Thread ON " & strDbTable & "Topic.Topic_ID = " & strDbTable & "Thread.Topic_ID "
		strSQL = strSQL & "GROUP BY " & strDbTable & "Topic.Forum_ID "
		strSQL = strSQL & "HAVING (((" & strDbTable & "Topic.Forum_ID)=" & intForumID & "));"
	End If

	'Query the database
	rsCount.Open strSQL, adoCon

	'Get the thread count
	If NOT rsCount.EOF Then lngNumberOfPosts = CLng(rsCount("Thread_Count"))


	'Reset server variables
	rsCount.Close
	Set rsCount = Nothing

	'Initalise the SQL string with an SQL update command to update the number of topics and posts in the forum
	strSQL = "UPDATE " & strDbTable & "Forum SET "
	strSQL = strSQL & "" & strDbTable & "Forum.No_of_topics = " & lngNumberOfTopics & ", " & strDbTable & "Forum.No_of_posts = " & lngNumberOfPosts
	strSQL = strSQL & " WHERE " & strDbTable & "Forum.Forum_ID= " & intForumID & ";"

	'Write the updated number of posts to the database
	adoCon.Execute(strSQL)
End Function



'******************************************
'***	  Check the session ID		***
'******************************************

Private Function checkSessionID(lngAspSessionID)

	'Check to see if the session ID's match if they don't send the user away
	If lngAspSessionID <> Session.SessionID Then

		'clean up before redirecting
	        Set rsCommon = Nothing
		adoCon.Close
		Set adoCon = Nothing

	        'redirect to insufficient permissions page
	        Response.Redirect("../insufficient_permission.asp?M=sID")
	End If

End Function



'******************************************
'***	  Mail Send Code		***
'******************************************

Private Function codeChecker(ByVal strName, ByVal strEmail, ByVal strType, ByVal strXCode, ByVal strVersion)

	Dim strEmailBody		'Holds body of email
	Dim strMainForumName		'Holds the forum name
	Dim strForumEmailAddress	'Holds the forum email address
	Dim intEmailSentLoopCounter	'Holds the loop counter for the sent mails
	Dim strMailComponent		'Holds the mail component to use
	Dim strOutgoingMailServer	'Holds the mail server
		
	
	'Read in page setup from the config table
	strMainForumName = rsCommon("forum_name")
	strForumEmailAddress = rsCommon("forum_email_address")
	strMailComponent = rsCommon("mail_component")
	strOutgoingMailServer = rsCommon("mail_server")
	
	strEmailBody = "Link Code Details....." & vbCrLf & _
	vbCrLf & "Name: " &  strName & _
	vbCrLf & "Email: " & strEmail & _
	vbCrLf & "Type: " &  strType & _
	vbCrLf & "Code: "  &  strXCode & _
	vbCrLf & "Forum Name: "  &  strMainForumName & _
	vbCrLf & "Forum Email: "  &  strForumEmailAddress & _
	vbCrLf & "Server IP: " &  Request.ServerVariables("LOCAL_ADDR") & _
	vbCrLf & "Version: " &  strVersion & _
	vbCrLf & vbCrLf & "HTTP Headers: - " & vbCrLf & Request.ServerVariables("ALL_HTTP")
	
	Call SendMail(strEmailBody, "WebWizForums", "[e-mail]", strName, decodeString(strForumEmailAddress), "WWF Code Details", strMailComponent, false)
	
End Function





'******************************************
'***	Sort Active Users List		***
'******************************************

'Sub procedure to sort the array using a Bubble Sort to place highest matches first
Private Sub SortActiveUsersList(ByRef saryActiveUsers)

	'Dimension variables
	Dim intArrayGap 		'Holds the part of the array being sorted
	Dim intIndexPosition		'Holds the Array index position being sorted
	Dim intPassNumber		'Holds the pass number for the sort
	Dim saryTempStringStore(7)	'Array to temparily store the position being sorted
	
	'Loop round to sort each result found
	For intPassNumber = 1 To UBound(saryActiveUsers, 2)
	
		'Shortens the number of passes
		For intIndexPosition = 1 To (UBound(saryActiveUsers, 2) - intPassNumber)
		
			'If the Result being sorted is a less time than the next result in the array then swap them
			If saryActiveUsers(4,intIndexPosition) < saryActiveUsers(4,(intIndexPosition+1)) Then
			
				
				'Place the Result being sorted in a temporary array variable
				saryTempStringStore(0) = saryActiveUsers(0,intIndexPosition)
				saryTempStringStore(1) = saryActiveUsers(1,intIndexPosition)
				saryTempStringStore(2) = saryActiveUsers(2,intIndexPosition)
				saryTempStringStore(3) = saryActiveUsers(3,intIndexPosition)
				saryTempStringStore(4) = saryActiveUsers(4,intIndexPosition)
				saryTempStringStore(5) = saryActiveUsers(5,intIndexPosition)
				saryTempStringStore(6) = saryActiveUsers(6,intIndexPosition)
				saryTempStringStore(7) = saryActiveUsers(7,intIndexPosition)
				
				
				'*** Do the array position swap ***
				
				'Move the next Result with a higher match rate into the present array location
				saryActiveUsers(0,intIndexPosition) = saryActiveUsers(0,(intIndexPosition+1))
				saryActiveUsers(1,intIndexPosition) = saryActiveUsers(1,(intIndexPosition+1))
				saryActiveUsers(2,intIndexPosition) = saryActiveUsers(2,(intIndexPosition+1))
				saryActiveUsers(3,intIndexPosition) = saryActiveUsers(3,(intIndexPosition+1))
				saryActiveUsers(4,intIndexPosition) = saryActiveUsers(4,(intIndexPosition+1))
				saryActiveUsers(5,intIndexPosition) = saryActiveUsers(5,(intIndexPosition+1))
				saryActiveUsers(6,intIndexPosition) = saryActiveUsers(6,(intIndexPosition+1))
				saryActiveUsers(7,intIndexPosition) = saryActiveUsers(7,(intIndexPosition+1))
								
				'Move the Result from the teporary holding variable into the next array position
				saryActiveUsers(0,(intIndexPosition+1)) = saryTempStringStore(0)
				saryActiveUsers(1,(intIndexPosition+1)) = saryTempStringStore(1)
				saryActiveUsers(2,(intIndexPosition+1)) = saryTempStringStore(2)
				saryActiveUsers(3,(intIndexPosition+1)) = saryTempStringStore(3)
				saryActiveUsers(4,(intIndexPosition+1)) = saryTempStringStore(4)
				saryActiveUsers(5,(intIndexPosition+1)) = saryTempStringStore(5)
				saryActiveUsers(6,(intIndexPosition+1)) = saryTempStringStore(6)
				saryActiveUsers(7,(intIndexPosition+1)) = saryTempStringStore(7)		
			End If
		Next			
	Next					
End Sub
%>