<Object Runat="Server" Scope="application" ID="dOnlineUsers" ProgID="Scripting.Dictionary"></Object>

<SCRIPT LANGUAGE=VBScript RUNAT=Server>

sub Application_OnStart
    application("ServerStart") = now
end sub

function Decrypt(sText)
    'Replace with your own decrypt ;)
    Decrypt = sText
end function    

function adZero(sText)
    'Adds zeros to the beginning
    if isNull(sText) then exit function
    adZero = string(5 - len(sText), "0") & sText
end function

Sub Session_OnStart

    'Session_OnStart is automatically called by the ASP Interpreter
    'when a new session starts. (Probably a new visitor)

    'TimeOut value determines the period in minutes when
    'the session is assumed to be abandoned

    Session.TimeOut = 10

    'Get the current active users list
    sActiveUsersList = application("ActiveUsersList")
    
    'Get the new user name from the cookie
    sNewUserName = Decrypt(request.cookies("devUserName"))
    
    'If the visitor doesn't have a registered username, assign Guest(n) label
    if sNewUserName = "" then sNewUserName = "Guest-" & AdZero(CInt(application("Visitors")))
    
    'Initial action time
    sLastActionTime = Time
    
    'User info consists of user name, last action time, and the page viewed
    sUserInfo = sNewUserName & "<|>" & sLastActionTime & "<|>" & sLastPageViewed

    'Add this user to our collection with SessionID being the key
    '(See the top of this file to see how dOnlineUsers object is initiated)
    dOnlineUsers.Add Session.SessionID, sUserInfo
    
    'Lock the application variable and update the contents
    application.lock
    'The number of active users
    application("ActiveUsers") = application("ActiveUsers") + 1
    'The number of visitors since last application reset
    application("Visitors") = application("Visitors") + 1
    
    'If the date is different than the previously stored date,
    'it means we passed midnight, so reset our "today" counters
    if application("TodaysDate") <> Date() then
        application("PageViewsToday") = 0
        application("VisitorsToday") = 0
    end if
    application("VisitorsToday") = application("VisitorsToday") + 1
    'Store the date
    application("TodaysDate") = Date()
    'Unlock and go
    application.unlock
    
End Sub

Sub Session_OnEnd
    'Session_OnEnd is automatically called by the ASP Interpreter
    'when the specified TimeOut period has passed after user's last action

    on error resume next

    'Remove this session from our collection
    dOnlineUsers.Remove Session.SessionID
    
    'And update the application variables
    application.lock
    application("ActiveUsers") = application("ActiveUsers") - 1
    application.unlock

End Sub
</SCRIPT>

Processing time: 2.17 seconds.

Visit 2eNetWorX for more OpenSource VB and ASP Projects.