functions_session_data.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
'**
'****************************************************************************************







'******************************************
'***  Read in session application data	***
'******************************************

'Sub procedure to read in the session data from application variable or create new one if it doesn't exist
Private Sub getSessionData()

	Dim intSessionArrayPass
	Dim intRemovedEntries
	Dim strNewSessionID
	Dim intSessionStringLength
	Dim blnCookiesDetected
	Dim blnFoundSession
	Dim strIP
	Dim strDate


	'Initialise  variables
	intSessionStringLength = 32
	intRemovedEntries = 0
	blnCookiesDetected = false
	blnFoundSession = false
	strNewSessionID = LCase(hexValue(intSessionStringLength))
	strIP = getIP()
	strQsSID = ""
	strQsSID1 = ""
	strQsSID2 = ""
	strQsSID3 = ""


	'Use only the first 2 parts of the IP address to prevent errors when using mutiple proxies (eg. AOL uses)
	strIP = Mid(strIP, 1, (InStr(InStr(1, strIP, ".", 1)+1, strIP, ".", 1)))


	'Read in the session ID, if available
	'Use cookies first
	If getCookie("sID", "SID") <> "" Then
		'Set the cookie detection variable to true
		blnCookiesDetected = true

		'Get the session ID from cookie
		strSessionID = Trim(getCookie("sID", "SID"))

	'Else if no cookies, or cookies not working use querystrings
	ElseIf Request.QueryString("SID") <> "" Then

		'Get the session ID from querystring
		strSessionID = Trim(Request("SID"))
	End If


	'Check the length of the session ID is correct, if not destroy it
	If Len(strSessionID) <> intSessionStringLength Then strSessionID = ""



	'Session array lookup table
	'0 = Session ID
	'1 = IP address
	'2 = Time last accessed
	'3 = Session data
	
	

	'Read in the session array from the application variable
	If blnDatabaseHeldSessions = false Then
		If isArray(Application(strAppPrefix & "sarySessionData")) Then
			sarySessionData = Application(strAppPrefix & "sarySessionData")
	
		'Else create an array
		Else
			ReDim sarySessionData(3,0)
		End If
	End If
	
	
	
	
	'Read in the session data from the database (worse performance, but required for web gardens and load balanced servers)
	If blnDatabaseHeldSessions Then
		
		'Get all sssion data from database
		strSQL = "SELECT " & strDbTable & "Session.Session_ID, " & strDbTable & "Session.IP_address, " & strDbTable & "Session.Last_active, " & strDbTable & "Session.Session_data " & _
		"FROM " & strDbTable & "Session" & strDBNoLock & ";"
		
		'Set error trapping
		On Error Resume Next
	
		'Get recordset
		rsCommon.Open strSQL, adoCon
				
		'If an error has occurred write an error to the page
		If Err.Number <> 0 Then Call errorMsg("An error has occurred while executing SQL query on database.", "getSessionData()_get_session_data", "functions_session_data.asp")
			
		'Disable error trapping
		On Error goto 0'Open database
		
		
		'If records returned place them in the array
		If NOT rsCommon.EOF Then
			sarySessionData = rsCommon.GetRows()
		'Else create an array
		Else
			ReDim sarySessionData(3,0)
		End If
		
		'Close recordset
		rsCommon.Close
	End If





	'Iterate through array
	For intSessionArrayPass = 0 To UBound(sarySessionData, 2)

		'Check that the array position is not over 20 minutes old and remove them
		If CDate(sarySessionData(2, intSessionArrayPass)) < DateAdd("n", -20, Now()) Then
			
			'First remove any unread post arrays that maybe stored in the memory for this session
			Application("sarryUnReadPosts" &  sarySessionData(0, intSessionArrayPass)) = ""

			'Swap this array postion with the last in the array
			sarySessionData(0, intSessionArrayPass) = sarySessionData(0, UBound(sarySessionData, 2) - intRemovedEntries)
			sarySessionData(1, intSessionArrayPass) = sarySessionData(1, UBound(sarySessionData, 2) - intRemovedEntries)
			sarySessionData(2, intSessionArrayPass) = sarySessionData(2, UBound(sarySessionData, 2) - intRemovedEntries)
			sarySessionData(3, intSessionArrayPass) = sarySessionData(3, UBound(sarySessionData, 2) - intRemovedEntries)

			'Increment the number of removed entries
			intRemovedEntries = intRemovedEntries + 1

		'ElseIf user has a session, read in data, and update last access time (for security we also check the IP address)
		ElseIf sarySessionData(0, intSessionArrayPass) = strSessionID AND sarySessionData(1, intSessionArrayPass) = strIP Then

			'If using a database for session data we need to update the last access time in the database
			'Only update if older than 5 minutes to cut down on database hits (this date is also updated when saving session data, so may not be required in some instances)
			If blnDatabaseHeldSessions AND CDate(sarySessionData(2, intSessionArrayPass)) < DateAdd("n", -5, Now()) Then
			
				'Initilse sql statement
			 	strSQL = "UPDATE " & strDbTable & "Session" & strRowLock & " " & _
				"SET " & strDbTable & "Session.Last_active = " & strDatabaseDateFunction & " " & _
				"WHERE " & strDbTable & "Session.Session_ID = '" & sarySessionData(0, intSessionArrayPass) & "';"
				
				'Set error trapping
				On Error Resume Next
	
				'Write to database
				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.", "getSessionData()_update_last_active_date", "functions_session_data.asp")
			
				'Disable error trapping
				On Error goto 0
				
			End If
			
			'Set blnFoundSession to true
			blnFoundSession = true

			'Read in session data
			strSessionData = sarySessionData(3, intSessionArrayPass)
			
			
			'Update last access time
			sarySessionData(2, intSessionArrayPass) = internationalDateTime(Now())
		End If

		'If the session ID already exists create a new one
		If strNewSessionID = sarySessionData(0, intSessionArrayPass) Then
			strNewSessionID = LCase(hexValue(intSessionStringLength))
			intSessionArrayPass = 1
		End If
	Next






	'Remove the last array position as it is no-longer needed
	If intRemovedEntries > 0 Then ReDim Preserve sarySessionData(3, UBound(sarySessionData, 2) - intRemovedEntries)
		
	
	'If using a database to store the data then delete old entries from the database
	If blnDatabaseHeldSessions Then
		
		'SQL to delete old entries from the database