VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 1  'NoTransaction
END
Attribute VB_Name = "clsUsersRO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'*** Constant declarations
Private Const strMODULE_NAME As String = "clsUsersRO"
Private Const PasswordMinLength As Integer = 8                 ' minimum length of a password
Private Const PasswordMaxLength As Integer = 40                ' maximum length of a password
Private Const MinNbrSpecialCharsRequired As Integer = 0        ' minimum nbr of special characters in a password
Private Const MinNbrNumericCharsRequired As Integer = 1        ' minumum nbr of numeric characters in a password
Private Const MinNbrAlphaUpperCharsRequired As Integer = 1     ' minumum nbr of alpha upper case characters in a password
Private Const MinNbrAlphaLowerCharsRequired As Integer = 1     ' minumum nbr of alpha lower case characters in a password
Private Const DisallowedSpecialCharacters As String = "^"      ' disallowed (invalid) special characters
'***********************
' ANSI Character codes *
'***********************
Private Const SpecialCharBegin1 As Long = 32
Private Const SpecialCharEnd1 As Long = 47
Private Const NumericBegin As Long = 48  '0
Private Const NumericEnd As Long = 57  '9
Private Const SpecialCharBegin2 As Long = 58
Private Const SpecialCharEnd2 As Long = 64
Private Const AlphaUpperBegin As Long = 65   'A
Private Const AlphaUpperEnd As Long = 90  'Z
Private Const SpecialCharBegin3 As Long = 91
Private Const SpecialCharEnd3 As Long = 96
Private Const AlphaLowerBegin As Long = 97   'a
Private Const AlphaLowerEnd As Long = 122   'z
Private Const SpecialCharBegin4 As Long = 123
Private Const SpecialCharEnd4 As Long = 126
'*** This function determines if a user has only one assigned instance
Public Function blnIfUserHasOneInstance(ByVal strUserId As String) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsUserAppInstances As ADODB.Recordset

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
    
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Select the user's AppInstances
    Set rsUserAppInstances = objUsersDA.rsGetUserAppInstances(strUserId)
    
    '*** If only only 1 then return true
    If rsUserAppInstances.EOF <> True Then
        If rsUserAppInstances.RecordCount = 1 Then
            blnIfUserHasOneInstance = True
        '*** Else false
        Else
            blnIfUserHasOneInstance = False
        End If
    '*** Else no instances then raise error
    Else
        Err.Raise vbObjectError + 512, strMODULE_NAME & ".blnIfUserHasOneInstance()", "User " & strUserId & "has no defined instances"
    End If
       
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnIfUserHasOneInstance()]", Err.Description

End Function
'*** This function determines if a user belongs to a specified instance
Public Function blnDoesUserBelongToInstance(ByVal strUserId As String, _
        ByVal intAppInstanceId As Integer) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsUserAppInstance As ADODB.Recordset

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
    
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Select a specified user ApppInstance
    Set rsUserAppInstance = objUsersDA.rsGetUserAppInstance(strUserId, _
        intAppInstanceId)
    
    '*** If record found then return true
    If rsUserAppInstance.EOF <> True Then
        blnDoesUserBelongToInstance = True
    '*** Else return false
    Else
        blnDoesUserBelongToInstance = False
    End If
       
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnDoesUserBelongToInstance()]", Err.Description

End Function
'*** This function returns a recordset containing all expired users
Public Function rsGetExpiredUsers(ByVal intDays As Integer) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim strExpireDate As String
    
     '*** Calculate expire date
    strExpireDate = Format(DateAdd("d", intDays * -1, Date), "mm/dd/yyyy")
    
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns all users
    Set rsGetExpiredUsers = objUsersDA.rsGetExpiredUsers(strExpireDate)
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetExpiredUsers()]", Err.Description

End Function
'*** This function returns a recordset containing all the users belong to the specified role
Public Function rsGetAllUsersBelongingToRole(ByVal strRole As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsAllUserAttr As ADODB.Recordset
    Dim arrUserAttributes As Variant
    Dim rsUsers As ADODB.Recordset
    Dim rsOutUserAttr As ADODB.Recordset
    Dim strUserId As String
    Dim i As Integer
    Dim objEdaadDA As ChvCITCeDaad.clsEdaadDA
    Dim rsAppInstances As ADODB.Recordset
    Dim rsUsersInRole As ADODB.Recordset
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access objects
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    Set objEdaadDA = CreateObject("ChvCITCeDaad.clsEdaadDA")
    
    '*** Get all eQuest user attributes and assign to an array
    Set rsAllUserAttr = objUsersDA.rsGetAllUsers
    If rsAllUserAttr.EOF <> True Then
        arrUserAttributes = rsAllUserAttr.GetRows
    End If
    
    '*** Get all the AppInstances
    Set rsAppInstances = objEdaadDA.rsGetAppInstances
    
    '*** Create and open the output recordset
    Set rsOutUserAttr = New ADODB.Recordset
    With rsOutUserAttr
        .Fields.Append "user_id", adVarChar, 50
        .Fields.Append "first_name", adVarChar, 50
        .Fields.Append "last_name", adVarChar, 50
        .Fields.Append "phone", adVarChar, 50
        .Fields.Append "email", adVarChar, 50
        .Fields.Append "company", adVarChar, 50
        .Fields.Append "country", adVarChar, 50
        .Open
    End With
    
    '*** Iterate through all each AppInstance to and get the desired users for each instance
    If rsAppInstances.EOF <> True Then
        With rsAppInstances
            .MoveFirst
            While .EOF <> True
                '*** Get users belonging to the role in this instance
                Set rsUsersInRole = objUsersDA.rsGetUsersBelongingToRole(rsAppInstances.Fields("abbr").Value, strRole)
                If rsUsersInRole.EOF <> True Then
                    With rsUsersInRole
                        .MoveFirst
                        While .EOF <> True
                            rsOutUserAttr.AddNew
                            '*** Get the user id and add to the row
                            strUserId = .Fields("user_id").Value
                            rsOutUserAttr.Fields("user_id").Value = strUserId
                            '*** Fetch the user name from the LDAP data array
                            For i = 0 To UBound(arrUserAttributes, 2)
                                If UCase(arrUserAttributes(0, i)) = UCase(strUserId) Then
                                    rsOutUserAttr.Fields("first_name").Value = arrUserAttributes(1, i) & ""
                                    rsOutUserAttr.Fields("last_name").Value = arrUserAttributes(2, i) & ""
                                    rsOutUserAttr.Fields("phone").Value = arrUserAttributes(3, i) & ""
                                    rsOutUserAttr.Fields("email").Value = arrUserAttributes(4, i) & ""
                                    rsOutUserAttr.Fields("company").Value = arrUserAttributes(5, i) & ""
                                    rsOutUserAttr.Fields("country").Value = arrUserAttributes(6, i) & ""
                                    Exit For
                                End If
                            Next
                            rsOutUserAttr.Update
                            .MoveNext
                        Wend
                    End With
                End If
                .MoveNext
            Wend
        End With
    End If
    
    '*** Return the recordset
    Set rsGetAllUsersBelongingToRole = rsOutUserAttr

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsAllUserAttr Is Nothing) Then Set rsAllUserAttr = Nothing
    If Not (rsUsers Is Nothing) Then Set rsUsers = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    If Not (objEdaadDA Is Nothing) Then Set objEdaadDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetAllUsersBelongingToRole()]", Err.Description
    
End Function
'*** This function determines if a user possesses the MBP_OWNER role
Public Function blnDoesUserBelongToRole(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String, _
        ByVal strRoleName As String) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsUserRoles As ADODB.Recordset, i As Integer
    Dim strCurrentRole As String, blnRetVal As Boolean

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
            
    '*** Get UserRoles recordset ***
    Set rsUserRoles = rsGetUserRoles(strAppInstanceAbbr, strUserId)
    
    '*** Check roles for Administator and/or MBP Owner role ***
    If Not (rsUserRoles.BOF And rsUserRoles.EOF) Then
        For i = 1 To rsUserRoles.RecordCount
            strCurrentRole = UCase(rsUserRoles("ROLE"))
            If strCurrentRole = UCase(strRoleName) Then
                blnRetVal = True
            End If
            rsUserRoles.MoveNext
        Next
    Else
        blnRetVal = False
    End If
      
    '*** Set return value ***
    blnDoesUserBelongToRole = blnRetVal
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsUserRoles Is Nothing) Then Set rsUserRoles = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnDoesUserBelongToRole()]", Err.Description

End Function

'*** This function determines if a user owns a specified MBP
Public Function blnDoesUserOwnMBP(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String, _
        ByVal strMBP As String) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
    
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Determine if user owns the MBP
    blnDoesUserOwnMBP = objUsersDA.blnUserMBPExists(strAppInstanceAbbr, strUserId, strMBP)
       
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnDoesUserOwnMBP()]", Err.Description

End Function
'*** This function determines if a user record exists in LDAP
Public Function blnUserExistsInLDAP(ByVal strUserId As String) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
    
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Determine if user owns exists
    blnUserExistsInLDAP = objUsersDA.blnUserExistsInLDAP(strUserId)
       
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnUserExistsInLDAP()]", Err.Description

End Function
'*** This function determines if a user record exists
Public Function blnUserExists(ByVal strUserId As String) As Boolean
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
    
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Determine if user owns exists
    blnUserExists = objUsersDA.blnUserExists(strUserId)
       
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".blnUserExists()]", Err.Description

End Function
Public Function htmlGetPasswordRules() As String
       
    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    htmlGetPasswordRules = _
        "<tr><td>Password Complexity Requirements:</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Minimum length: " & PasswordMinLength & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Maximum length: " & PasswordMaxLength & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Minimum # of lowercase characters: " & MinNbrAlphaLowerCharsRequired & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Minimum # of uppercase characters: " & MinNbrAlphaUpperCharsRequired & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Minimum # of numeric values: " & MinNbrNumericCharsRequired & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Minimum # special characters: " & MinNbrSpecialCharsRequired & "</td></tr>" & _
        "<tr><td>&nbsp;&nbsp; - Disallowed special characters: (&nbsp" & DisallowedSpecialCharacters & "&nbsp)</td></tr>"
 
    Exit Function

ErrorHandler:
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".htmlGetPasswordRules()]", Err.Description

End Function
'*************************************************************************
' Password Filter
' Check passwords for a valid form (hard)
'*************************************************************************
Public Function blnIsValidPassword(ByVal strPassword As String) As Boolean

    Dim PasswordLength As Integer
    Dim i As Integer
    Dim j As Integer
    Dim CharCode As Integer
    Dim SpecialCharCount As Integer
    Dim NumericCount As Integer
    Dim AlphaUpperCount As Integer
    Dim AlphaLowerCount As Integer
    
    blnIsValidPassword = False
    
    PasswordLength = Len(strPassword)
    If PasswordLength < PasswordMinLength Or PasswordLength > PasswordMaxLength Then
        Exit Function
    End If
    
    SpecialCharCount = 0
    NumericCount = 0
    AlphaUpperCount = 0
    AlphaLowerCount = 0
    
    For i = 1 To PasswordLength
        CharCode = Asc(Mid(strPassword, i, 1))
        If CharCode >= SpecialCharBegin1 And CharCode <= SpecialCharEnd1 Then
            SpecialCharCount = SpecialCharCount + 1
        End If
        If CharCode >= NumericBegin And CharCode <= NumericEnd Then
            NumericCount = NumericCount + 1
        End If
        If CharCode >= SpecialCharBegin2 And CharCode <= SpecialCharEnd2 Then
            SpecialCharCount = SpecialCharCount + 1
        End If
        If CharCode >= AlphaUpperBegin And CharCode <= AlphaUpperEnd Then
            AlphaUpperCount = AlphaUpperCount + 1
        End If
        If CharCode >= SpecialCharBegin3 And CharCode <= SpecialCharEnd3 Then
            SpecialCharCount = SpecialCharCount + 1
        End If
        If CharCode >= AlphaLowerBegin And CharCode <= AlphaLowerEnd Then
            AlphaLowerCount = AlphaLowerCount + 1
        End If
        If CharCode >= SpecialCharBegin4 And CharCode <= SpecialCharEnd4 Then
            SpecialCharCount = SpecialCharCount + 1
        End If
    Next i
    
    If MinNbrSpecialCharsRequired > 0 And SpecialCharCount < MinNbrSpecialCharsRequired Then
        Exit Function
    End If
    If MinNbrNumericCharsRequired > 0 And NumericCount < MinNbrNumericCharsRequired Then
        Exit Function
    End If
    If MinNbrAlphaUpperCharsRequired > 0 And AlphaUpperCount < MinNbrAlphaUpperCharsRequired Then
        Exit Function
    End If
    If MinNbrAlphaLowerCharsRequired > 0 And AlphaLowerCount < MinNbrAlphaLowerCharsRequired Then
        Exit Function
    End If
       
    '*** Password is valid!
    blnIsValidPassword = True
    
End Function
'*** This function returns all the equest users
Public Function rsGetAllUsers() As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns all users
    Set rsGetAllUsers = objUsersDA.rsGetAllUsers()
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetAllUsers()]", Err.Description
    
End Function
'*** This function returns all Extranet users
Public Function rsGetAllExtranetUsers() As ADODB.Recordset

    Dim objContext As ObjectContext
    Dim objUsersDA As clsUsersDA
    Dim objError As ChvCITCLDAPUM.ErrorCodes

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
        
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    Set rsGetAllExtranetUsers = objUsersDA.rsGetAllExtranetUsers()
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return

ErrorHandler:
    If Err.Number > dsLowerBound And Err.Number < dsUpperBound Then
        Set objError = New ChvCITCLDAPUM.ErrorCodes
        Err.Description = objError.GetErrorMessage(Err.Number)
    End If
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetAllExtranetUsers()]", Err.Description

End Function
'*** This function returns the default user pub view for the specified user
Public Function rsGetDefaultUserPubView(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the user pub views
    Set rsGetDefaultUserPubView = objUsersDA.rsGetDefaultUserPubView(strAppInstanceAbbr, strUserId)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetDefaultUserPubView()]", Err.Description
    
End Function
'*** This function returns a recordset with the all the user ids and associated attributes for
'***    the current instance
Public Function rsGetUsersForInstance(ByVal intAppInstanceId As Integer) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsUsers As ADODB.Recordset
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Get users belonging to the role
    Set rsUsers = objUsersDA.rsGetUsersForInstance(intAppInstanceId)
        
    '*** Return the recordset
    Set rsGetUsersForInstance = rsUsers

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsUsers Is Nothing) Then Set rsUsers = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUsersforInstance()]", Err.Description
    
End Function
'*** This function returns only the installed (enabled) AppInstances assigned to the specified user
Public Function rsGetUserAppInstances(ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user app instances
    Set rsGetUserAppInstances = objUsersDA.rsGetUserAppInstances(strUserId)
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserAppInstances()]", Err.Description
    
End Function
'*** This function returns all the AppInstances assigned to the specified user
Public Function rsGetAllUserAppInstances(ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user app instances
    Set rsGetAllUserAppInstances = objUsersDA.rsGetAllUserAppInstances(strUserId)
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetAllUserAppInstances()]", Err.Description
    
End Function
'*** This function returns the user attributes for the specified user
Public Function rsGetUserInfo(ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the users attributes
    Set rsGetUserInfo = objUsersDA.rsGetUserInfo(strUserId)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserInfo()]", Err.Description
    
End Function
'*** This function returns the user attributes from the LDAP for the specified user
Public Function rsGetUserInfoFromLDAP(ByVal strUserId As String) As ADODB.Recordset
    
    Dim objContext As ObjectContext
    Dim objUsersDA As clsUsersDA

    '*** Enable error handling
    On Error GoTo ErrorHandler
    
    '*** Get the MTS Object Context
    Set objContext = GetObjectContext()
        
    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    Set rsGetUserInfoFromLDAP = objUsersDA.rsSearchLDAP(strUserId, "", "", "", "", "", _
    "", "", "", "", "")
    
    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserInfoFromLDAP()]", Err.Description

End Function
'*** This function returns a recordset with the all the user ids and associated names for
'***    users belonging to the specified role
Public Function rsGetUsersBelongingToRole(ByVal strAppInstanceAbbr As String, _
        ByVal strRole As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsUsers As ADODB.Recordset
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
        
    '*** Get users belonging to the role
    Set rsUsers = objUsersDA.rsGetUsersBelongingToRole(strAppInstanceAbbr, strRole)
    
    '*** Return the recordset
    Set rsGetUsersBelongingToRole = rsUsers

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsUsers Is Nothing) Then Set rsUsers = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUsersBelongingToRole()]", Err.Description
    
End Function
'*** This function returns all the MBPs owned by the specified user
Public Function rsGetUserMBPs(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String, _
        Optional ByVal blnForPubSecurity As Boolean) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsMBPs As ADODB.Recordset
    Dim strUserType As String
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()
    
    '*** Determine User Type ***
    If blnForPubSecurity = True Then
        strUserType = "MBP_Owner_Only"
        
    ElseIf blnDoesUserBelongToRole(strAppInstanceAbbr, strUserId, "EQT_SITE_ADMINISTRATOR") Then
        strUserType = "Site_Administrator"
        
    ElseIf blnDoesUserBelongToRole(strAppInstanceAbbr, strUserId, "EQT_MBP_OWNER") Then
        strUserType = "MBP_Owner"
        
    Else
        strUserType = "User"
    End If

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user roles
    Set rsMBPs = objUsersDA.rsGetUserMBPs(strAppInstanceAbbr, strUserId, strUserType)

    '*** Return the recordset
    Set rsGetUserMBPs = rsMBPs

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsMBPs Is Nothing) Then Set rsMBPs = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserMBPs()]", Err.Description
    
End Function
'*** This function returns all the user pub views for the specified user
Public Function rsGetUserPubViews(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the user pub views
    Set rsGetUserPubViews = objUsersDA.rsGetUserPubViews(strAppInstanceAbbr, strUserId)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserPubViews()]", Err.Description
    
End Function
'*** This function returns all the user pub views for the specified user
'*** adapted from rsGetUserPubViews() jggr 11/06/01
Public Function rsGetUserPubViewsByList(ByVal strAppInstanceAbbr As String, _
        ByVal strViewIdList As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the user pub views
    Set rsGetUserPubViewsByList = objUsersDA.rsGetUserPubViewsByList(strAppInstanceAbbr, strViewIdList)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserPubViewsByList()]", Err.Description
    
End Function
Public Function rsGetUsersByList(ByVal strUsers As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the user pub views
    Set rsGetUsersByList = objUsersDA.rsGetUsersByList(strUsers)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUsersByList()]", Err.Description
    
End Function
'*** This function returns all the user pub views for the specified user
'*** Adapted from rsGetUserPubViews() Jggr 11/05/01
Public Function rsGetUserPubView(ByVal strAppInstanceAbbr As String, _
        ByVal lngViewId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns the user pub views
    Set rsGetUserPubView = objUsersDA.rsGetUserPubView(strAppInstanceAbbr, lngViewId)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserPubView()]", Err.Description
    
End Function
'*** This function returns all the roles assigned to the specified user
Public Function rsGetUserRoles(ByVal strAppInstanceAbbr As String, _
        ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim rsRoles As ADODB.Recordset
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user roles
    Set rsRoles = objUsersDA.rsGetUserRoles(strAppInstanceAbbr, strUserId)

    '*** Return the recordset
    Set rsGetUserRoles = rsRoles

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (rsRoles Is Nothing) Then Set rsRoles = Nothing
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserRoles()]", Err.Description
    
End Function
'*** This function returns a recordset containing the attributes for one or more users
'***    from the LDAP based on the specified search criteria
Public Function rsSearchLDAP(ByVal strUserId As String, _
    ByVal strFirstName As String, _
    ByVal strInitials As String, _
    ByVal strLastName As String, _
    ByVal strPhone As String, _
    ByVal strEmail As String, _
    ByVal strCompany As String, _
    ByVal strEmployeeType As String, _
    ByVal strDescription As String, _
    ByVal strCountry As String, _
    ByVal strUDF As String) As ADODB.Recordset

    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim objError As ChvCITCLDAPUM.ErrorCodes
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Search for entries
    Set rsSearchLDAP = objUsersDA.rsSearchLDAP(strUserId, strFirstName, strInitials, _
        strLastName, strPhone, strEmail, strCompany, strEmployeeType, _
        strDescription, strCountry, strUDF)

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    If Err.Number > dsLowerBound And Err.Number < dsUpperBound Then
        Set objError = New ChvCITCLDAPUM.ErrorCodes
        Err.Description = objError.GetErrorMessage(Err.Number)
    End If
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsSearchLDAP()]", Err.Description

End Function
Public Function rsGetActiveUsersByInstance(ByVal strFromDate As String, _
        ByVal strToDate As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
        
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    Set rsGetActiveUsersByInstance = objUsersDA.rsGetActiveUsersByInstance(strFromDate, _
        strToDate)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetActiveUsersByInstance()]", Err.Description
    
End Function

'*** This function returns all the AppInstances and Grids assigned to the specified user
'*** The function creates a temporary table, all_user_mbp, for use with the Start Page.
Public Function rsGetUserAppInstancesAndGrids(ByVal strUserId As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
           
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user app instances and grids
    Set rsGetUserAppInstancesAndGrids = objUsersDA.rsGetUserAppInstancesAndGrids(strUserId)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetUserAppInstancesAndGrids()]", Err.Description
    
End Function


'*** This function returns all the user's My Views for each instance with a count
'*** The function creates a temporary table, myview_count, for use with the Start Page.
Public Function rsGetMyViewsCount(ByVal strUserId As String, ByVal strDaysValue As String) As ADODB.Recordset
    
    On Error GoTo ErrorHandler
    
    Dim objContext As ObjectContext
    Dim objUsersDA As ChvCITCUserMgr.clsUsersDA
    Dim intDays As Integer
    
    If Len(strDaysValue) > 0 Then
        intDays = CInt(strDaysValue)
    End If
           
    '*** Acquire a reference to the transaction context
    Set objContext = GetObjectContext()

    '*** Create the data access object and execute the data access method
    Set objUsersDA = CreateObject("ChvCITCUserMgr.clsUsersDA")
    
    '*** Returns user app instances and grids
    Set rsGetMyViewsCount = objUsersDA.rsGetMyViewsCount(strUserId, intDays)

    '*** Commit the transaction
    If Not (objContext Is Nothing) Then objContext.SetComplete

CommonExit:
    GoSub ObjectCleanup
    Exit Function

ObjectCleanup:
    If Not (objUsersDA Is Nothing) Then Set objUsersDA = Nothing
    Return
    
ErrorHandler:
    '*** Abort the transaction
    If Not (objContext Is Nothing) Then objContext.SetAbort
    GoSub ObjectCleanup
    '*** Raise an error to the calling procedure
    Err.Raise Err.Number, Err.Source & "[" & strMODULE_NAME & ".rsGetMyViewsWhatsNewCount()]", Err.Description
    
End Function