<% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide ASP Discussion Forum '** '** 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 '** '**************************************************************************************** '****************************************** '*** 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 '****************************************** '*** 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 %>