Código toda da pagina:
<%
'****************************************************************************************
'** 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: -
'** [URL=http://www.webwizguide.info/forum]http://www.webwizguide.info/forum[/URL]
'**
'** 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
'**
'****************************************************************************************
'Array dimension lookup table
' 0 = IP
' 1 = Autor ID
' 2 = Usuário
' 3 = Hora do Login
' 4 = Last Active Time
' 5 = OS
' 6 = Browser
' 7 = Detalhes do usuário
'Dimension variables
Dim strIPAddress 'Holds the uesrs IP address to keep track of em with
Dim strOS 'Holds the users OS
Dim strBrowserUserType 'Holds the users browser type
Dim blnHideActiveUser 'Holds if the user wants to be shown in the active users list
Dim saryActiveUsers 'Holds the active users array
Dim intArrayPass 'Holds array iteration possition
Dim blnIPFound 'Set to true if the users IP is found
Dim intActiveUserArrayPos 'Holds the possition in the array the user is found
Dim intActiveUsersDblArrayPos 'Holds the array position if the user is found more than once in the array
'******************************************
'*** Initialise variables ***
'******************************************
'Initialise variables
blnIPFound = False
'Get the users IP address
strIPAddress = getIP()
'Get the uesrs web browser
strBrowserUserType = BrowserType()
'Get the OS type
strOS = OSType()
'Get if the user wants to be shown in the active users list
If Request.Cookies(strCookieName)("NS") = "1" Then
blnHideActiveUser = 1
Else
blnHideActiveUser = 0
End If
'******************************************
'*** Initialise array ***
'******************************************
'Initialise the array from the application veriable
If IsArray(Application("saryAppActiveUsers")) Then
'Place the application level active users array into a temporary dynaimic array
saryActiveUsers = Application("saryAppActiveUsers")
'Else Initialise the an empty array
Else
ReDim saryActiveUsers(7,1)
End If
'******************************************
'*** Get users array position ***
'******************************************
'Iterate through the array to see if the user is already in the array
For intArrayPass = 1 To UBound(saryActiveUsers, 2)
'Check the IP address
If saryActiveUsers(0, intArrayPass) = strIPAddress Then
intActiveUserArrayPos = intArrayPass
blnIPFound = True
'Else check a logged in member is not a double entry
ElseIf saryActiveUsers(1, intArrayPass) = lngLoggedInUserID AND saryActiveUsers(1, intArrayPass) <> 2 Then
intActiveUsersDblArrayPos = intArrayPass
End If
Next
'******************************************
'*** Update users array position ***
'******************************************
'If the user is found in the array update the array position
If blnIPFound Then
saryActiveUsers(1, intActiveUserArrayPos) = lngLoggedInUserID
saryActiveUsers(2, intActiveUserArrayPos) = strLoggedInUsername
saryActiveUsers(4, intActiveUserArrayPos) = CDbl(Now())
saryActiveUsers(7, intActiveUserArrayPos) = blnHideActiveUser
'******************************************
'*** Add new user to array ***
'******************************************
'Else the user is not in the array so create a new array psition
Else
'Get the uesrs web browser
strBrowserUserType = BrowserType()
'Get the OS type
strOS = OSType()
'ReDimesion the array
ReDim Preserve saryActiveUsers(7, UBound(saryActiveUsers, 2) + 1)
'Update the new array position which will be the last one
saryActiveUsers(0, UBound(saryActiveUsers, 2)) = strIPAddress
saryActiveUsers(1, UBound(saryActiveUsers, 2)) = lngLoggedInUserID
saryActiveUsers(2, UBound(saryActiveUsers, 2)) = strLoggedInUsername
saryActiveUsers(3, UBound(saryActiveUsers, 2)) = CDbl(Now())
saryActiveUsers(4, UBound(saryActiveUsers, 2)) = CDbl(Now())
saryActiveUsers(5, UBound(saryActiveUsers, 2)) = strOS
saryActiveUsers(6, UBound(saryActiveUsers, 2)) = strBrowserUserType
saryActiveUsers(7, UBound(saryActiveUsers, 2)) = blnHideActiveUser
End If
'******************************************
'*** Remove unactive users ***
'******************************************
'Iterate through the array to remove old entires and double entries
For intArrayPass = 1 To UBound(saryActiveUsers, 2)
'Check the IP address
If saryActiveUsers(4, intArrayPass) < (CDbl(Now()- 6.95000000167871E-03)) OR intActiveUsersDblArrayPos = intArrayPass Then
'Swap this array postion with the last in the array
saryActiveUsers(0, intArrayPass) = saryActiveUsers(0, UBound(saryActiveUsers, 2))
saryActiveUsers(1, intArrayPass) = saryActiveUsers(1, UBound(saryActiveUsers, 2))
saryActiveUsers(2, intArrayPass) = saryActiveUsers(2, UBound(saryActiveUsers, 2))
saryActiveUsers(3, intArrayPass) = saryActiveUsers(3, UBound(saryActiveUsers, 2))
saryActiveUsers(4, intArrayPass) = saryActiveUsers(4, UBound(saryActiveUsers, 2))
saryActiveUsers(5, intArrayPass) = saryActiveUsers(5, UBound(saryActiveUsers, 2))
saryActiveUsers(6, intArrayPass) = saryActiveUsers(6, UBound(saryActiveUsers, 2))
saryActiveUsers(7, intArrayPass) = saryActiveUsers(7, UBound(saryActiveUsers, 2))
'Remove the last array position as it is no-longer needed
ReDim Preserve saryActiveUsers(7, UBound(saryActiveUsers, 2) - 1)
'Exit for loop to prevent errors
Exit For
End If
Next
'******************************************
'*** Update application level array ***
'******************************************
'Update the application level variable holding the active users array
'Lock the application so that no other user can try and update the application level variable at the same time
Application.Lock
'Update the application level variable
Application("saryAppActiveUsers") = saryActiveUsers
'Unlock the application
Application.UnLock
%>