Figures
Figure 2 prAPP_Get_SessionValues
CREATE PROCEDURE prAPP_Get_SessionValues
    @sSessionKey UNIQUEIDENTIFIER
AS
    SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED

    SELECT 
                s.sSessionKey,
                sd.sVariableName,
                sd.sValue,
                s.dtLastAccessDateTime
    FROM        tblSession s 
    INNER JOIN tblSessionData sd ON s.sSessionKey = sd.sSessionKey
    WHERE       sd.sSessionKey = @sSessionKey
    ORDER BY
                sVariableName

    -- Update the "Last Access Date/Time"
    EXECUTE prAPP_Update_Session @sSessionKey
Figure 3 prAPP_Update_Session
CREATE PROCEDURE prAPP_Update_Session
    @sSessionKey UNIQUEIDENTIFIER,
    @dtLastAccessDateTime DATETIME = NULL
AS
    SET NOCOUNT ON

    SET @dtLastAccessDateTime = ISNULL(@dtLastAccessDateTime, getdate())

    UPDATE tblSession 
    SET dtLastAccessDateTime = @dtLastAccessDateTime
    WHERE sSessionKey = @sSessionKey
GO
Figure 4 CreateSession Excerpt
Public Function CreateSession() As Variant
•••
    '--------------------------------------------------------------------
    '--- Set the parameters and execute the stored proc
    '--------------------------------------------------------------------
    sProcName = "prAPP_Insert_Session"
    
    Set oCn = CreateObject("ADODB.Connection")
    With oCn
        .Provider = gsProvider
        .CursorLocation = adUseClient
        .ConnectionTimeout = 15
        .Open gsConnectionString, gsUserID, gsPassword
    End With
    
    Set oCmd = CreateObject("ADODB.Command")
    With oCmd
        Set .ActiveConnection = oCn
        .CommandTimeout = 30
        .CommandType = adCmdStoredProc
        .CommandText = sProcName
    End With
    
    Set oRs = CreateObject("ADODB.Recordset")
    With oRs
        Set .Source = oCmd
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open
        .ActiveConnection = Nothing
        CloseObject oCn
    End With

    If Not oRs.EOF Then
        '----------------------------------------------------------------
        '--- Get the data from the recordset
        '----------------------------------------------------------------
        vData = oRs.GetRows
    End If

    '--------------------------------------------------------------------
    '--- Encrypt the SessionKey
    '--------------------------------------------------------------------
    sSessionKey = vData(0, 0)
    sSessionKey = EncryptSessionKey(sSessionKey)
    
    '--------------------------------------------------------------------
    '--- Return the SessionKey
    '--------------------------------------------------------------------
    CreateSession = sSessionKey
    
    '--------------------------------------------------------------------
    '--- Complete the MTS Transaction
    '--------------------------------------------------------------------
    m.oObjCtx.SetComplete

•••
Figure 5 The Encryption and Decryption Functions
Function EncryptSessionKey(ByVal sSessionKey As String) As String

    '--------------------------------------------------------------------
    '--- Encrypt the Session Key value
    '--------------------------------------------------------------------
    
    If IsGUID(sSessionKey) Then
        EncryptSessionKey = EncryptString(sSessionKey, giEncryptKey)
    Else
        EncryptSessionKey = sSessionKey
    End If

End Function

Function DecryptSessionKey(ByVal sSessionKey As String) As String

    '--------------------------------------------------------------------
    '--- Decrypt the Session Key value
    '--------------------------------------------------------------------
    
    If IsGUID(sSessionKey) Then
        DecryptSessionKey = sSessionKey
    Else
        DecryptSessionKey = EncryptString(sSessionKey, giEncryptKey)
    End If

End Function

Function EncryptString(ByVal sText As String, _
                       ByVal iEncryptKey As Integer) As String
    Const sPROC_NAME As String = msOBJ_NAME & ".EncryptString"

    On Error GoTo Err
    
    '--------------------------------------------------------------------
    '--- Encrypts the specified text using the specified encryption
    '--- integer key.
    '--------------------------------------------------------------------

    Dim sTemp As String
    Dim i As Integer
    
    If iEncryptKey > 255 Or iEncryptKey <= 0 Then
        iEncryptKey = 255
    End If
    
    '--- Loop on the specified text one character at a time.
    For i = 1 To Len(sText)
        '--- Build the Temp string one encrypted character at a time.
        sTemp = sTemp + Chr$(Asc(Mid(sText, i, 1)) Xor iEncryptKey)
    Next i
    '--- Return the encrypted string
    EncryptString = sTemp
    
Exit Function
Err:
    Err.Raise Err, sPROC_NAME, Error
End Function

Public Function EncryptSessionKeys(ByVal vData As Variant) As Variant

    Dim lRow As Long

    '--------------------------------------------------------------------
    '--- Encrypt the Session Key for each row
    '--------------------------------------------------------------------

    For lRow = 0 To NumRows(vData) - 1
        vData(geSM_SessionKey, lRow) = _
              EncryptSessionKey(vData(geSM_SessionKey, lRow))
    Next

    EncryptSessionKeys = vData
    
End Function
Figure 6 GetRecords
Public Function GetRecords(ByVal vSessionKey As Variant) As Variant
    
    Const sPROC_NAME As String = msOBJ_NAME & ".GetRecords"
    
    On Error GoTo Err
    
    '--------------------------------------------------------------------
    '--- Make sure a Session Key was specified
    '--------------------------------------------------------------------
    If Not HasValue(vSessionKey) Then
        '--- Raise the error
        Err.Raise glERR_VALIDATION, sPROC_NAME, gsERR_VALIDATION & _
                  vbCrLf & vbCrLf & "You must pass a valid Session Key."
    End If
    
    '--------------------------------------------------------------------
    '--- Decrypt the Session Key
    '--------------------------------------------------------------------
    vSessionKey = DecryptSessionKey(vSessionKey)
    
    '--------------------------------------------------------------------
    '--- Get values using SessionKey and return them
    '--------------------------------------------------------------------
    GetRecords = GetSelectedRecords(vSessionKey)
    
    '--------------------------------------------------------------------
    '--- Complete the MTS Transaction
    '--------------------------------------------------------------------
    m.oObjCtx.SetComplete
    
Exit Function
Err:
    Dim lErrNumber As Long
    Dim sErrDescription As String
    lErrNumber = Err.Number
    sErrDescription = Err.Description
    On Error GoTo 0
    
    '--------------------------------------------------------------------
    '--- Abort transaction
    '--------------------------------------------------------------------
    m.oObjCtx.SetAbort
    
    Err.Raise lErrNumber, sPROC_NAME, sErrDescription
End Function
Figure 7 The GetSelectedRecords Private Function
Private Function GetSelectedRecords(ByVal sSessionKey As String) As Variant
•••
    '--------------------------------------------------------------------
    '--- Set the parameters and get a recordset
    '--------------------------------------------------------------------
    sProcName = "prAPP_Get_SessionValues"
    
        Set oCn = CreateObject("ADODB.Connection")
    With oCn
        .Provider = gsProvider
        .CursorLocation = adUseClient
        .ConnectionTimeout = 15
        .IsolationLevel = adXactReadUncommitted
        .Open gsConnectionString, gsUserID, gsPassword
    End With
    
    Set oCmd = CreateObject("ADODB.Command")
    With oCmd
        Set .ActiveConnection = oCn
        .CommandTimeout = 30
        .CommandType = adCmdStoredProc
        .CommandText = sProcName
        .Parameters.Append .CreateParameter("sSessionKey", adVarChar, _
            adParamInput, LenB(sSessionKey & "") + 1, sSessionKey)
    End With
    
    Set oRs = CreateObject("ADODB.Recordset")
    With oRs
        Set .Source = oCmd
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open
        .ActiveConnection = Nothing
        CloseObject oCn
    End With

    If Not oRs.EOF Then
        '----------------------------------------------------------------
        '--- Get the data from the recordset
        '----------------------------------------------------------------
        vData = oRs.GetRows
    End If

    '--------------------------------------------------------------------
    '--- Encrypt the Session Key for each row
    '--------------------------------------------------------------------
    vData = EncryptSessionKeys(vData)
    
    '--------------------------------------------------------------------
    '--- Return the array
    '--------------------------------------------------------------------
    GetSelectedRecords = vData
Figure 10 Connect.asp
<!-- #include file="SessionManager.vbs" -->
<%
function Connect()
    dim bLogon

    if Trim(LCase(gsUserID)) = "haley" then
        Connect = true
        sSessionKey = CreateSession()
        UpdateSession sSessionKey, "sUserID", gsUserID
        UpdateSession sSessionKey, "sPassword", gsPassword
        WriteSessionKey sSessionKey
    else
        Connect = false
    end if
end function
%>
Figure 11 SomePage.asp
<%@LANGUAGE=VBScript%>
<%Option Explicit%>
<!-- #include file="SessionManager.vbs" -->
<%
'-----------------------------------------------------------
'--- Retrieve values from the Session Manager
'-----------------------------------------------------------
'--- If the Session Data is empty, go and get it.
GetAllSessionValues()
'-----------------------------------------------------------
%>
<html>
<head>
<title>Some Page</title>
</head>
<%
Response.Write "<BR>"
Response.Write "UserID=" & gsUserID
Response.Write "<BR>"
Response.Write "Password=" & gsPassword
Response.Write "<BR>"
%>
<body>
</body>
</html>
Page view tracker