<%
'****************************************************************************************
'**  Copyright Notice
'**
'**  Web Wiz Guide - Web Wiz Forums
'**
'**  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(10)

	'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




'********************************************
'***  Rich Text Compatible Browser type *****
'********************************************

Private Function RTEenabled()

	Dim strUserAgent	'Holds info on the users browser

	'Get the users HTTP user agent (web browser)
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")


	'*************************************
	'***** Windows Internet Explorer *****
	'*************************************
	
	'See if the user agent is IE on Winows and not Opera trying to look like IE
	If InStr(1, strUserAgent, "MSIE", 1) > 0 AND InStr(1, strUserAgent, "Win", 1) > 0 AND InStr(1, strUserAgent, "Opera", 1) = 0 Then

		'Now we know this is Windows IE we need to see if the version number is 5
		If Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "MSIE", 1)+5), 1)) = "5" Then

			RTEenabled = "winIE5"
		
		'Now we know this is Windows IE we need to see if the version number is above 5
		ElseIf CInt(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "MSIE", 1)+5), 1))) => 6 Then

			RTEenabled = "winIE"

		'Else the IE version is below 5 so return na
		Else

			RTEenabled = "false"
		End If
		
		
	'****************************
	'***** Mozilla Firebird *****
	'****************************
	
	'See if this is a version of Mozilla Firebird that supports Rich Text Editing under it's Midas API
	ElseIf inStr(1, strUserAgent, "Firebird", 1) Then
		
		'Now we know this is Mozilla Firebird we need to see if the version 0.6.1 or above; relase date is above 2003/07/28
		If CLng(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "Gecko/", 1)+6), 8))) => 20030728 Then

			RTEenabled = "Gecko"

		'Else the Mozilla Firebird version is below 1.5 so return false
		Else

			RTEenabled = "false"
		End If
	
	
	'**************************************
	'***** Mozilla Seamonkey/Netscape *****
	'**************************************
	
	'See if this is a version of Mozilla/Netscape that supports Rich Text Editing under it's Midas API
	ElseIf inStr(1, strUserAgent, "Gecko", 1) > 0 AND inStr(1, strUserAgent, "Firebird", 1) = 0 AND isNumeric(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "Gecko/", 1)+6), 8))) Then
		
		'Now we know this is Mozilla/Netscape we need to see if the version number is above 1.3 or above; relase date is above 2003/03/12
		If CLng(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "Gecko/", 1)+6), 8))) => 20030312 Then

			RTEenabled = "Gecko"

		'Else the Mozilla version is below 1.3 or below 7.1 of Netscape so return false
		Else

			RTEenabled = "false"
		End If
	
	
	
	'***********************************
	'***** Non RTE Enabled Browser *****
	'***********************************
	
	'Else this is a browser that does not support Rich Text Editing
	Else
		'RTEenabled - false
		RTEenabled = "false"
	End If
	
End Function



'******************************************
'***    Get Web Browser Details	      *****
'******************************************

Private Function BrowserType()

	Dim strUserAgent	'Holds info on the users browser and os
	Dim strBrowserUserType	'Holds the users browser type

	'Get the users HTTP user agent (web browser)
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")

	'Get the uesrs web browser
	'Opera
	If InStr(1, strUserAgent, "Opera 1", 1) > 0 Then
		strBrowserUserType = "Opera 1"
	ElseIf InStr(1, strUserAgent, "Opera 2", 1) > 0 Then
		strBrowserUserType = "Opera 2"
	ElseIf InStr(1, strUserAgent, "Opera 3", 1) > 0 Then
		strBrowserUserType = "Opera 3"
	ElseIf InStr(1, strUserAgent, "Opera 4", 1) > 0 Then
		strBrowserUserType = "Opera 4"
	ElseIf InStr(1, strUserAgent, "Opera 5", 1) > 0 Then
		strBrowserUserType = "Opera 5"
	ElseIf InStr(1, strUserAgent, "Opera 6", 1) > 0 Then
		strBrowserUserType = "Opera 6"
	ElseIf InStr(1, strUserAgent, "Opera 7", 1) > 0 Then
		strBrowserUserType = "Opera 7"
	ElseIf InStr(1, strUserAgent, "Opera 8", 1) > 0 Then
		strBrowserUserType = "Opera 8"
	ElseIf InStr(1, strUserAgent, "Opera", 1) > 0 Then
		strBrowserUserType = "Opera"

	'AOL
	ElseIf inStr(1, strUserAgent, "AOL 3", 1) > 0 Then
		strBrowserUserType = "AOL 3"
	ElseIf inStr(1, strUserAgent, "AOL 4", 1) > 0 Then
		strBrowserUserType = "AOL 4"
	ElseIf inStr(1, strUserAgent, "AOL 5", 1) > 0 Then
		strBrowserUserType = "AOL 5"
	ElseIf inStr(1, strUserAgent, "AOL 6", 1) > 0 Then
		strBrowserUserType = "AOL 6"
	ElseIf inStr(1, strUserAgent, "AOL 7", 1) > 0 Then
		strBrowserUserType = "AOL 7"
	ElseIf inStr(1, strUserAgent, "AOL 8", 1) > 0 Then
		strBrowserUserType = "AOL 8"
	ElseIf inStr(1, strUserAgent, "AOL 9", 1) > 0 Then
		strBrowserUserType = "AOL 9"
	ElseIf inStr(1, strUserAgent, "AOL", 1) > 0 Then
		strBrowserUserType = "AOL"

	'Konqueror
	ElseIf inStr(1, strUserAgent, "Konqueror", 1) > 0 Then
		strBrowserUserType = "Konqueror"

	'EudoraWeb
	ElseIf inStr(1, strUserAgent, "EudoraWeb", 1) > 0 Then
		strBrowserUserType = "EudoraWeb"

	'Dreamcast
	ElseIf inStr(1, strUserAgent, "Dreamcast", 1) > 0 Then
		strBrowserUserType = "Dreamcast"
	
	'Safari
	ElseIf inStr(1, strUserAgent, "Safari", 1) > 0 Then
		strBrowserUserType = "Safari"
	
	'Lynx
	ElseIf inStr(1, strUserAgent, "Lynx", 1) > 0 Then
		strBrowserUserType = "Lynx"
	
	'ICE
	ElseIf inStr(1, strUserAgent, "ICE", 1) > 0 Then
		strBrowserUserType = "ICE"
	
	'iCab 
	ElseIf inStr(1, strUserAgent, "iCab", 1) > 0 Then
		strBrowserUserType = "iCab"
		
	'HotJava 
	ElseIf inStr(1, strUserAgent, "Sun", 1) > 0 AND inStr(1, strUserAgent, "Mozilla/3", 1) > 0 Then
		strBrowserUserType = "HotJava"
	
	'Galeon 
	ElseIf inStr(1, strUserAgent, "Galeon", 1) > 0 Then
		strBrowserUserType = "Galeon"
		
	'Epiphany 
	ElseIf inStr(1, strUserAgent, "Epiphany", 1) > 0 Then
		strBrowserUserType = "Epiphany"
	
	'DocZilla 
	ElseIf inStr(1, strUserAgent, "DocZilla", 1) > 0 Then
		strBrowserUserType = "DocZilla"
	
	'Camino 
	ElseIf inStr(1, strUserAgent, "Chimera", 1) > 0 OR inStr(1, strUserAgent, "Camino", 1) > 0 Then
		strBrowserUserType = "Camino"
	
	'Dillo 
	ElseIf inStr(1, strUserAgent, "Dillo", 1) > 0 Then
		strBrowserUserType = "Dillo"
		
	'amaya 
	ElseIf inStr(1, strUserAgent, "amaya", 1) > 0 Then
		strBrowserUserType = "Amaya"
		
	'NetCaptor 
	ElseIf inStr(1, strUserAgent, "NetCaptor", 1) > 0 Then
		strBrowserUserType = "NetCaptor"
		
		
		
		
	'LookSmart search engine robot
	ElseIf inStr(1, strUserAgent, "ZyBorg", 1) > 0 Then
		strBrowserUserType = "LookSmart"		
	
	'Googlebot search engine robot
	ElseIf inStr(1, strUserAgent, "Googlebot", 1) > 0 Then
		strBrowserUserType = "Googlebot"
		
	'MSN  search engine robot
	ElseIf inStr(1, strUserAgent, "msnbot", 1) > 0 Then
		strBrowserUserType = "MSN"
		
	'inktomi search engine robot
	ElseIf inStr(1, strUserAgent, "slurp", 1) > 0 Then
		strBrowserUserType = "Inktomi"
	
	'AltaVista search engine robot
	ElseIf inStr(1, strUserAgent, "Scooter", 1) > 0 Then
		strBrowserUserType = "AltaVista"
	
	'DMOZ search engine robot
	ElseIf inStr(1, strUserAgent, "Robozilla", 1) > 0 Then
		strBrowserUserType = "DMOZ"
		
	'Ask Jeeves search engine robot
	ElseIf inStr(1, strUserAgent, "Ask Jeeves", 1) > 0 OR inStr(1, strUserAgent, "Ask+Jeeves", 1) > 0 Then
		strBrowserUserType = "Ask Jeeves"
		
	'Lycos search engine robot
	ElseIf inStr(1, strUserAgent, "lycos", 1) > 0 Then
		strBrowserUserType = "Lycos"
		
	'Excite search engine robot
	ElseIf inStr(1, strUserAgent, "ArchitextSpider", 1) > 0 Then
		strBrowserUserType = "Excite"
		
	'Northernlight search engine robot
	ElseIf inStr(1, strUserAgent, "Gulliver", 1) > 0 Then
		strBrowserUserType = "Northernlight"
	
	'AllTheWeb search engine robot
	ElseIf inStr(1, strUserAgent, "crawler@fast", 1) > 0 Then
		strBrowserUserType = "AllTheWeb"
		
	'Turnitin search engine robot
	ElseIf inStr(1, strUserAgent, "TurnitinBot", 1) > 0 Then
		strBrowserUserType = "Turnitin"
		
	'InternetSeer search engine robot
	ElseIf inStr(1, strUserAgent, "internetseer", 1) > 0 Then
		strBrowserUserType = "InternetSeer"
		
	'NameProtect Inc. search engine robot
	ElseIf inStr(1, strUserAgent, "nameprotect", 1) > 0 Then
		strBrowserUserType = "NameProtect"
		
	'PhpDig search engine robot
	ElseIf inStr(1, strUserAgent, "PhpDig", 1) > 0 Then
		strBrowserUserType = "PhpDig"
		
	'Rambler search engine robot
	ElseIf inStr(1, strUserAgent, "StackRambler", 1) > 0 Then
		strBrowserUserType = "Rambler"
		
	'UbiCrawler search engine robot
	ElseIf inStr(1, strUserAgent, "UbiCrawler", 1) > 0 Then
		strBrowserUserType = "UbiCrawler"
		
	'entireweb search engine robot
	ElseIf inStr(1, strUserAgent, "Speedy+Spider", 1) > 0 Then
		strBrowserUserType = "entireweb"
		
	'Alexa.com search engine robot
	ElseIf inStr(1, strUserAgent, "ia_archiver", 1) > 0 Then
		strBrowserUserType = "Alexa"
	
	'Arianna/Libero search engine robot
	ElseIf inStr(1, strUserAgent, "arianna.libero.it", 1) > 0 Then
		strBrowserUserType = "Arianna/Libero"
			
	
	
		
		
	'Internet Explorer
	ElseIf inStr(1, strUserAgent, "MSIE 7", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 7"
	ElseIf inStr(1, strUserAgent, "MSIE 6", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 6"
	ElseIf inStr(1, strUserAgent, "MSIE 5", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 5"
	ElseIf inStr(1, strUserAgent, "MSIE 4", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 4"
	ElseIf inStr(1, strUserAgent, "MSIE 3", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 3"
	ElseIf inStr(1, strUserAgent, "MSIE 2", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 2"
	ElseIf inStr(1, strUserAgent, "MSIE 1", 1) > 0 Then
		strBrowserUserType = "Microsoft IE 1"

	'Pocket Internet Explorer
	ElseIf inStr(1, strUserAgent, "MSPIE 1", 1) > 0 Then
		strBrowserUserType = "Pocket IE 1"
	ElseIf inStr(1, strUserAgent, "MSPIE 1", 1) > 0 Then
		strBrowserUserType = "Pocket IE 2"

	
	'Mozilla Firebird
	ElseIf inStr(1, strUserAgent, "Gecko", 1) > 0 AND inStr(1, strUserAgent, "Firebird", 1) > 0 Then
		strBrowserUserType = "Mozilla Firebird"
	
	'Mozilla
	ElseIf inStr(1, strUserAgent, "Gecko", 1) > 0 AND inStr(1, strUserAgent, "rv:2", 1) > 0 AND inStr(1, strUserAgent, "Netscape", 1) = 0 Then
		strBrowserUserType = "Mozilla 2"
	ElseIf inStr(1, strUserAgent, "Gecko", 1) > 0 AND inStr(1, strUserAgent, "rv:1", 1) > 0 AND inStr(1, strUserAgent, "Netscape", 1) = 0 Then
		strBrowserUserType = "Mozilla 1"
	ElseIf inStr(1, strUserAgent, "Gecko", 1) > 0 AND inStr(1, strUserAgent, "rv:0", 1) > 0 AND inStr(1, strUserAgent, "Netscape", 1) = 0 Then
		strBrowserUserType = "Mozilla"

	'Netscape
	ElseIf inStr(1, strUserAgent, "Netscape/8", 1) > 0 Then
		strBrowserUserType = "Netscape 8"
	ElseIf inStr(1, strUserAgent, "Netscape/7", 1) > 0 Then
		strBrowserUserType = "Netscape 7"
	ElseIf inStr(1, strUserAgent, "Netscape6", 1) > 0 Then
		strBrowserUserType = "Netscape 6"
	ElseIf inStr(1, strUserAgent, "Mozilla/4", 1) > 0 Then
		strBrowserUserType = "Netscape 4"
	ElseIf inStr(1, strUserAgent, "Mozilla/3", 1) > 0 Then
		strBrowserUserType = "Netscape 3"
	ElseIf inStr(1, strUserAgent, "Mozilla/2", 1) > 0 Then
		strBrowserUserType = "Netscape 2"
	ElseIf inStr(1, strUserAgent, "Mozilla/1", 1) > 0 Then
		strBrowserUserType = "Netscape 1"
	
		
		
	'Else unknown or robot
	Else
		strBrowserUserType = "Unknown"
	End If

	'Return function
	BrowserType = strBrowserUserType
End Function


'******************************************
'***          Get OS Type   	      *****
'******************************************

Private Function OSType ()

	Dim strUserAgent	'Holds info on the users browser and os
	Dim strOS		'Holds the users OS

	'Get the users HTTP user agent (web browser)
	strUserAgent = Request.ServerVariables("HTTP_USER_AGENT")

	'Get users OS
	'Windows
	If inStr(1, strUserAgent, "Windows 2003", 1) > 0 Or inStr(1, strUserAgent, "NT 5.2", 1) > 0 Then
		strOS = "Windows 2003"
	ElseIf inStr(1, strUserAgent, "Windows XP", 1) > 0 Or inStr(1, strUserAgent, "NT 5.1", 1) > 0 Then
		strOS = "Windows XP"
	ElseIf inStr(1, strUserAgent, "Windows 2000", 1) > 0 Or inStr(1, strUserAgent, "NT 5", 1) > 0 Then
		strOS = "Windows 2000"
	ElseIf inStr(1, strUserAgent, "Windows NT", 1) > 0 Or inStr(1, strUserAgent, "WinNT", 1) > 0 Then
		strOS = "Windows  NT 4"
	ElseIf inStr(1, strUserAgent, "Windows 95", 1) > 0 Or inStr(1, strUserAgent, "Win95", 1) > 0 Then
		strOS = "Windows 95"
	ElseIf inStr(1, strUserAgent, "Windows ME", 1) > 0 Or inStr(1, strUserAgent, "Win 9x 4.90", 1) > 0 Then
		strOS = "Windows ME"
	ElseIf inStr(1, strUserAgent, "Windows 98", 1) > 0 Or inStr(1, strUserAgent, "Win98", 1) > 0 Then
		strOS = "Windows 98"
	ElseIf Instr(1, strUserAgent, "Windows 3.1", 1) > 0 or Instr(1, strUserAgent, "Win16", 1) > 0 Then
		strOS = "Windows 3.x"
	ElseIf Instr(1, strUserAgent, "Windows CE", 1) > 0 Then
		strOS = "Windows CE"

	'PalmOS
	ElseIf inStr(1, strUserAgent, "PalmOS", 1) > 0 Then
		strOS = "Palm OS"
		
	'PalmPilot
	ElseIf inStr(1, strUserAgent, "Elaine", 1) > 0 Then
		strOS = "PalmPilot"

	'Nokia
	ElseIf inStr(1, strUserAgent, "Nokia", 1) > 0 Then
		strOS = "Nokia"

	'Linux
	ElseIf inStr(1, strUserAgent, "Linux", 1) > 0 Then
		strOS = "Linux"

	'Amiga
	ElseIf inStr(1, strUserAgent, "Amiga", 1) > 0 Then
		strOS = "Amiga"

	'Solaris
	ElseIf inStr(1, strUserAgent, "Solaris", 1) > 0 Then
		strOS = "Solaris"

	'SunOS
	ElseIf inStr(1, strUserAgent, "SunOS", 1) > 0 Then
		strOS = "Sun OS"

	'BSD
	ElseIf inStr(1, strUserAgent, "BSD", 1) > 0 or inStr(1, strUserAgent, "FreeBSD", 1) > 0 Then
		strOS = "Free BSD"

	'Unix
	ElseIf inStr(1, strUserAgent, "Unix", 1) > 0 OR inStr(1, strUserAgent, "X11", 1) > 0 Then
		strOS = "Unix"

	'AOL webTV
	ElseIf inStr(1, strUserAgent, "AOLTV", 1) > 0 OR inStr(1, strUserAgent, "AOL_TV", 1) > 0 Then
		strOS = "AOL TV"
	ElseIf inStr(1, strUserAgent, "WebTV", 1) > 0 Then
		strOS = "Web TV"

	'Machintosh
	ElseIf inStr(1, strUserAgent, "Mac OS X", 1) > 0 Then
		strOS = "Mac OS X"
	ElseIf inStr(1, strUserAgent, "Mac_PowerPC", 1) > 0 or Instr(1, strUserAgent, "PPC", 1) > 0 Then
		strOS = "Mac PowerPC"
	ElseIf (inStr(1, strUserAgent, "6800", 1) > 0 OR inStr(1, strUserAgent, "68k", 1) > 0) AND inStr(1, strUserAgent, "Mac", 1) > 0 Then
		strOS = "Mac 68k"
	ElseIf inStr(1, strUserAgent, "Mac", 1) > 0 or inStr(1, strUserAgent, "apple", 1) > 0 Then
		strOS = "Macintosh"

	'OS/2
	ElseIf inStr(1, strUserAgent, "OS/2", 1) > 0 Then
		strOS = "OS/2"


	'Search Robot
	ElseIf inStr(1, strUserAgent, "Googlebot", 1) > 0 OR inStr(1, strUserAgent, "ZyBorg", 1) > 0 OR inStr(1, strUserAgent, "slurp", 1) > 0 OR inStr(1, strUserAgent, "Scooter", 1) > 0 OR inStr(1, strUserAgent, "Robozilla", 1) > 0 OR inStr(1, strUserAgent, "Ask Jeeves", 1) > 0 OR inStr(1, strUserAgent, "Ask+Jeeves", 1) > 0 OR inStr(1, strUserAgent, "lycos", 1) > 0 OR inStr(1, strUserAgent, "ArchitextSpider", 1) > 0 OR inStr(1, strUserAgent, "Gulliver", 1) > 0 OR inStr(1, strUserAgent, "crawler@fast", 1) > 0 Then
		strOS = "Search Robot"
		
	'Search Robot
	ElseIf inStr(1, strUserAgent, "TurnitinBot", 1) > 0 OR inStr(1, strUserAgent, "internetseer", 1) > 0 OR inStr(1, strUserAgent, "nameprotect", 1) > 0 OR inStr(1, strUserAgent, "PhpDig", 1) > 0 OR inStr(1, strUserAgent, "StackRambler", 1) > 0 OR inStr(1, strUserAgent, "UbiCrawler", 1) > 0 OR inStr(1, strUserAgent, "Speedy+Spider", 1) > 0 OR inStr(1, strUserAgent, "ia_archiver", 1) > 0 OR inStr(1, strUserAgent, "msnbot", 1) > 0 OR inStr(1, strUserAgent, "arianna.libero.it", 1) > 0 Then
		strOS = "Search Robot"		
 

	Else
		strOS = "Unknown"
	End If

	'Return function
	OSType = strOS
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




'******************************************
'***  	    Forum Permisisons         *****
'******************************************
Public Function forumPermisisons(ByVal intForumID, ByVal intGroupID, ByVal intRead, ByVal intPost, ByVal intReply, ByVal intEdit, ByVal intDelete, ByVal intPriority, ByVal intPollCreate, ByVal intVote, ByVal intAttachments, ByVal intImageUpload)

	'Declare variables
	Dim rsPermissions	'Holds the permissions recordset

	'Initilise variables
	blnRead = False
	blnPost = False
	blnReply = False
	blnEdit = False
	blnDelete = False
	blnPriority = False
	blnPollCreate = False
	blnVote = False
	blnAttachments = False
	blnImageUpload = False
	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
	If strDatabaseType = "SQLServer" Then
		strSQL = "EXECUTE " & strDbProc & "ForumPermissions @intForumID = " & intForumID & ", @intGroupID = " & intGroupID & ", @intAuthorID = " & lngLoggedInUserID
	Else
		strSQL = "SELECT " & strDbTable & "Permissions.* "
		strSQL = strSQL & "FROM " & strDbTable & "Permissions "
		strSQL = strSQL & "WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & " "
		strSQL = strSQL & "ORDER BY " & strDbTable & "Permissions.Author_ID DESC;"
	End If

	'Query the database
	rsPermissions.Open strSQL, adoCon

	'Read in the permissions for the group the member is part of if there are any
	If NOT rsPermissions.EOF Then

		blnRead = CBool(rsPermissions("Read"))
		blnPost = CBool(rsPermissions("Post"))
		blnReply = CBool(rsPermissions("Reply_posts"))
		blnEdit = CBool(rsPermissions("Edit_posts"))
		blnDelete = CBool(rsPermissions("Delete_posts"))
		blnPriority = CBool(rsPermissions("Priority_posts"))
		blnPollCreate = CBool(rsPermissions("Poll_create"))
		blnVote = CBool(rsPermissions("Vote"))
		blnAttachments = CBool(rsPermissions("Attachments"))
		blnImageUpload = CBool(rsPermissions("Image_upload"))
		blnModerator = CBool(rsPermissions("Moderate"))

	'Else there are no forum permissions for this group so use the generic forum permissions
	Else

		'If ALL(1) OR (REG(2) AND NOT GID2(Guest Group)) OR (Admin(5) AND GID1(Admin Group)) Then set to true
		If intRead = 1 OR (intRead = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnRead = True
		If intPost = 1 OR (intPost = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPost = True
		If intReply = 1 OR (intReply = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnReply = True
		If intEdit = 1 OR (intEdit = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnEdit = True
		If intDelete = 1 OR (intDelete = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnDelete = True
		If intPriority = 1 OR (intPriority = 2 AND intGroupID <> 2) OR (blnAdmin) Then blnPriority = True
		If (intPollCreate = 1 OR (intPollCreate = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intPollCreate <> 0 Then blnPollCreate = True
		If (intVote = 1 OR (intVote = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intVote <> 0 Then blnVote = True
		If (intAttachments = 1 OR (intAttachments = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intAttachments <> 0 Then blnAttachments = True
		If (intImageUpload = 1 OR (intImageUpload = 2 AND intGroupID <> 2) OR (blnAdmin)) AND intImageUpload <> 0 Then blnImageUpload = True
	End If


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



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

'Although the above 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
	If strDatabaseType = "SQLServer" Then
		strSQL = "EXECUTE " & strDbProc & "ForumPermissions @intForumID = " & intForumID & ", @intGroupID = " & intGroupID & ", @intAuthorID = " & lngLoggedInUserID
	Else
		strSQL = "SELECT " & strDbTable & "Permissions.* "
		strSQL = strSQL & "FROM " & strDbTable & "Permissions "
		strSQL = strSQL & "WHERE (" & strDbTable & "Permissions.Group_ID = " & intGroupID & " OR " & strDbTable & "Permissions.Author_ID = " & lngLoggedInUserID & ") AND " & strDbTable & "Permissions.Forum_ID = " & intForumID & " "
		strSQL = strSQL & "ORDER BY " & strDbTable & "Permissions.Author_ID DESC;"
	End If

	'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




'******************************************
'***      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, "N0act", "", 1, -1, 1)

	'Return Function
	disallowedMemberNames = strUsername
End Function



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

	'Declare variables
	Dim rsIPAddr
	Dim strCheckIPAddress
	Dim strUserIPAddress
	Dim blnIPMatched

	'Intilise variable
	blnIPMatched = False

	'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
	If strDatabaseType = "SQLServer" Then
		strSQL = "EXECUTE " & strDbProc & "BannedIPs"
	Else
		strSQL = "SELECT " & strDbTable & "BanList.IP FROM " & strDbTable & "BanList WHERE " & strDbTable & "BanList.IP Is Not Null;"
	End If

	'Query the database
	rsIPAddr.Open strSQL, adoCon

	'Loop through the IP address and check 'em out
	Do while NOT rsIPAddr.EOF

		'Get the IP address to check from the recordset
		strCheckIPAddress = rsIPAddr("IP")

		'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
			strUserIPAddress = Mid(strUserIPAddress, 1, Len(strCheckIPAddress))

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

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

		End If

		'Move to the next record
		rsIPAddr.MoveNext
	Loop

	'Clean up
	rsIPAddr.Close
	Set rsIPAddr = Nothing

	'Return the function
	bannedIP = blnIPMatched
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?FID=" & intForumID & "&M=sID")
	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



'******************************************
'***	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
%>