TECH6.0

<object runat="Server" scope="Application"
id="rstActiveUsers" progid="ADODB.Recordset">
</object>

<script language="VBScript" runat="Server">
' The first thing you should notice is the top line.
' It creates an application scoped recordset object
' named rstActiveUsers that I'll use to store all
' our user information.
'
' Note: I've wrapped it for readability

Sub Application_OnStart()
    ' Selected constants from adovbs.inc
    Const adInteger = 3
    Const adVarChar = 200
    Const adDate = 7
    
    ' Here I set up in memory active user recordset
    ' by adding the fields I want to it and defining
    ' their data types.
    rstActiveUsers.Fields.Append "id", adInteger
    rstActiveUsers.Fields.Append "ip", adVarChar, 15
    rstActiveUsers.Fields.Append "browser", adVarChar, 255
    rstActiveUsers.Fields.Append "started", adDate

    ' Next I open our recordset so that we can use it.
    ' That basically gets everything ready for our
    ' first user.
    rstActiveUsers.Open
End Sub

Sub Session_OnStart()
    ' Set session timeout to 20 minutes
    Session.Timeout = 20

    ' Set a session start time.  This is pretty pointless,
    ' but it does ensure that we start a session and
    ' assign the user a session id and it can help
    ' troubleshooting if we ever need it.
    Session("Start") = Now()
    
    ' Move to the end so records are added in order.
    ' Again not of any real importance, but it keeps our
    ' user table nice and orderly.
    If Not rstActiveUsers.EOF Then rstActiveUsers.MoveLast

    ' Add a record and insert users data.  I'm just
    ' storing some basic info, but naturally you're free
    ' to store whatever you want.
    rstActiveUsers.AddNew
    
    rstActiveUsers.Fields("id").Value = _
        Session.SessionID
    
    rstActiveUsers.Fields("ip").Value = _
        Request.ServerVariables("REMOTE_HOST")
    
    rstActiveUsers.Fields("browser").Value = _
        Request.ServerVariables("HTTP_USER_AGENT")
    
    rstActiveUsers.Fields("started").Value = _
        Now()
    
    rstActiveUsers.Update
    
    ' Now that we've got the information, all that's
    ' left is to display it.  See test_page.asp for a
    ' demo.  It includes the pages show_count.asp and
    ' show_users.asp which can also be used
    ' individually if desired.
End Sub

Sub Session_OnEnd()
    ' Selected constants from adovbs.inc
    Const adAffectCurrent = 1

    ' Start at the first record
    rstActiveUsers.MoveFirst
    
    ' Check each record for the SessionID
    Do While Not rstActiveUsers.EOF
        ' Do conversion to Long to be sure we're
        ' comparing the same data type.
        If CLng(rstActiveUsers.Fields("id").Value) = _
            CLng(Session.SessionID) Then
            rstActiveUsers.Delete adAffectCurrent
        End If
        
        rstActiveUsers.MoveNext
    Loop
    
    rstActiveUsers.Update
End Sub


Sub Application_OnEnd()
    ' Not like it really matters, but for the sake of
    ' good coding practice I close the recordset when
    ' our application is shutting down.
    rstActiveUsers.Close
End Sub
</script>

<b><font color="#CC0000"><%= rstActiveUsers.RecordCount %></font> Active Users</b>

<%
If rstActiveUsers.RecordCount > 0 Then
    rstActiveUsers.MoveFirst

    Response.Write "<table border=""1"">" & vbCrLf

    Response.Write " <thead>" & vbCrLf
    Response.Write "  <th>Session Id</td>" & vbCrLf
    Response.Write "  <th>IP Address</th>" & vbCrLf
    Response.Write "  <th>User Agent</th>" & vbCrLf
    Response.Write "  <th>Session Start Time</th>" & vbCrLf
    Response.Write " </thead>" & vbCrLf

    Do While Not rstActiveUsers.EOF

        Response.Write " <tr>" & vbCrLf
        Response.Write "  <td>" & rstActiveUsers.Fields("id").Value & "</td>" & vbCrLf
        Response.Write "  <td>" & rstActiveUsers.Fields("ip").Value & "</td>" & vbCrLf
        Response.Write "  <td>" & rstActiveUsers.Fields("browser").Value & "</td>" & vbCrLf
        Response.Write "  <td>" & rstActiveUsers.Fields("started").Value & "</td>" & vbCrLf
        Response.Write " </tr>" & vbCrLf
        
        rstActiveUsers.MoveNext
    Loop
    Response.Write "</table>" & vbCrLf

End If
%>

<%@ Language=VBScript %>
<% Option Explicit %>
<html>
<head>
<title>Active Users</title>
</head>
<body>

<p>
<!-- #include file="show_count.asp" -->
</p>

<p>
<!-- #include file="show_users.asp" -->
</p>

</body>
</html>