functions_common.asp

简单的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
'**
'****************************************************************************************





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

Private Function userCode(ByVal strUsername)

	Dim strUserCode

	'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)
	
	'Remove ; from the usercode as this can course issues with the session tracking system (; is used as a seporator in teh session tracking system)
	strUserCode = Replace(strUserCode, ";", "", 1, -1, 1)

	'Return the function
	userCode = strUserCode
End Function






'*********************************************
'***  Browser Detection for Degradablity  ****
'*********************************************

'Ths function allows us to quickly detect the browser version so that some items can be disabled in browsers which have buggy support
Private Function browserDetect()

	Dim strUserAgent	'Holds info on the users browser

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

	'MSIE
	If InStr(1, strUserAgent, "MSIE", 1) AND InStr(1, strUserAgent, "Opera", 1) = 0 Then
		
		'MSIE 6 or below
		If  CInt(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "MSIE", 1)+5), 1))) <= 6 Then
			browserDetect = "MSIE6-"
		Else
			browserDetect = "MSIE"
		End If

	'Gekco
	ElseIf inStr(1, strUserAgent, "Gecko", 1) Then
		browserDetect = "Gecko"

	'Opera
	ElseIf inStr(1, strUserAgent, "Opera", 1) Then
		browserDetect = "opera"
		
	'Others
	Else
		browserDetect = "na"
	End If

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.5
		If Trim(Mid(strUserAgent, inStr(1, strUserAgent, "MSIE", 1)+5, 3)) = "5.5" OR Trim(Mid(strUserAgent, inStr(1, strUserAgent, "MSIE", 1)+5, 3)) = "5,5" Then

			RTEenabled = "winIE"
		
		'Now we know this is Windows IE we need to see if the version number is 6+
		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 Firefox/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
		
		
	'**********************************************
	'***** 		Opera 9 		  *****
	'**********************************************
	
	'See if this is Opera that supports Rich Text Opera 9)
	ElseIf inStr(1, strUserAgent, "Opera", 1) Then
		
		'now we need to see what version of Opera we are using
		If CLng(Trim(Mid(strUserAgent, CInt(inStr(1, strUserAgent, "Opera/", 1)+6), 1))) => 9 Then
			
			RTEenabled = "opera"
		
		'Else the Opera version is below 9 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 5", 1) Then
		strBrowserUserType = "Opera 5"
	ElseIf InStr(1, strUserAgent, "Opera 6", 1) Then
		strBrowserUserType = "Opera 6"
	ElseIf InStr(1, strUserAgent, "Opera 7", 1) Then
		strBrowserUserType = "Opera 7"
	ElseIf InStr(1, strUserAgent, "Opera 8", 1) Then
		strBrowserUserType = "Opera 8"
	ElseIf InStr(1, strUserAgent, "Opera 9", 1) Then
		strBrowserUserType = "Opera 9"
	ElseIf InStr(1, strUserAgent, "Opera", 1) Then
		strBrowserUserType = "Opera"

	'AOL
	ElseIf inStr(1, strUserAgent, "AOL", 1) Then
		strBrowserUserType = "AOL"

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

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

	'Dreamcast
	ElseIf inStr(1, strUserAgent, "Dreamcast", 1) Then
		strBrowserUserType = "Dreamcast"

	'Safari
	ElseIf inStr(1, strUserAgent, "Safari", 1) AND inStr(1, strUserAgent, "Version/1", 1) Then
		strBrowserUserType = "Safari 1"
	ElseIf inStr(1, strUserAgent, "Safari", 1) AND inStr(1, strUserAgent, "Version/2", 1) Then
		strBrowserUserType = "Safari 2"
	ElseIf inStr(1, strUserAgent, "Safari", 1) AND inStr(1, strUserAgent, "Version/3", 1) Then
		strBrowserUserType = "Safari 3"
	ElseIf inStr(1, strUserAgent, "Safari", 1) Then
		strBrowserUserType = "Safari"

	'Lynx
	ElseIf inStr(1, strUserAgent, "Lynx", 1) Then
		strBrowserUserType = "Lynx"

	'ICE
	ElseIf inStr(1, strUserAgent, "ICE", 1) Then
		strBrowserUserType = "ICE"

	'iCab
	ElseIf inStr(1, strUserAgent, "iCab", 1) Then
		strBrowserUserType = "iCab"

	'HotJava
	ElseIf inStr(1, strUserAgent, "Sun", 1) AND inStr(1, strUserAgent, "Mozilla/3", 1) Then
		strBrowserUserType = "HotJava"

	'Galeon
	ElseIf inStr(1, strUserAgent, "Galeon", 1) Then
		strBrowserUserType = "Galeon"

	'Epiphany
	ElseIf inStr(1, strUserAgent, "Epiphany", 1) Then
		strBrowserUserType = "Epiphany"

	'DocZilla
	ElseIf inStr(1, strUserAgent, "DocZilla", 1) Then
		strBrowserUserType = "DocZilla"

	'Camino
	ElseIf inStr(1, strUserAgent, "Chimera", 1) OR inStr(1, strUserAgent, "Camino", 1) Then
		strBrowserUserType = "Camino"

	'Dillo
	ElseIf inStr(1, strUserAgent, "Dillo", 1) Then
		strBrowserUserType = "Dillo"

	'amaya
	ElseIf inStr(1, strUserAgent, "amaya", 1) Then
		strBrowserUserType = "Amaya"

	'NetCaptor
	ElseIf inStr(1, strUserAgent, "NetCaptor", 1) Then
		strBrowserUserType = "NetCaptor"




	'LookSmart search engine robot
	ElseIf inStr(1, strUserAgent, "ZyBorg", 1) Then
		strBrowserUserType = "LookSmart"

	'Googlebot search engine robot
	ElseIf inStr(1, strUserAgent, "Googlebot", 1) Then
		strBrowserUserType = "Google"

	 'Google/AdSense search engine robot
    	ElseIf inStr(1, strUserAgent, "Mediapartners-Google", 1) Then
        	strBrowserUserType = "Google/AdSense"