
'----------------------------------------------------------------
' Hands-On 22-1
'----------------------------------------------------------------

Function SetDBPassword(strFullFilePath)
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = New ADODB.Connection
    With conn
        .Mode = adModeShareExclusive
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strFullFilePath & ";"
        .Execute "ALTER DATABASE PASSWORD secret null  "
    End With
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Function
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Function


'----------------------------------------------------------------
' Hands-On 22-2
'----------------------------------------------------------------

Function ResetDbPassword(strFullFilePath, _
                        strNewPwd, strOldPwd)
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = New ADODB.Connection
    
    With conn
        .Mode = adModeShareExclusive
        .Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & strFullFilePath & _
              "; Jet OLEDB:Database Password=" & strOldPwd & ";"
        .Execute "ALTER DATABASE PASSWORD " & strNewPwd & "  " & _
            strOldPwd
    End With
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Function
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Function


'----------------------------------------------------------------
' Hands-On 22-3
'----------------------------------------------------------------

Sub CreateUserAccount()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "CREATE USER GeorgeM fisherman 0302"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-4
'----------------------------------------------------------------

Sub ChangeUserPassword()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "ALTER USER GeorgeM PASSWORD primate fisherman"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-5
'----------------------------------------------------------------

Sub CreateGroupAccount()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "CREATE GROUP Mozart 2007Best"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-6
'----------------------------------------------------------------

Sub AddUserToGroup()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "ADD USER GeorgeM TO Mozart"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-7
'----------------------------------------------------------------

Sub RemoveUserFromGroup()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "DROP USER GeorgeM FROM Mozart"
ExitHere:
        If Not conn Is Nothing Then
            If conn.State = adStateOpen Then conn.Close
        End If
        Set conn = Nothing
        Exit Sub
ErrorHandler:
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-8
'----------------------------------------------------------------

Sub DeleteUserAccount()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "DROP USER GeorgeM"
ExitHere:
        If Not conn Is Nothing Then
            If conn.State = adStateOpen Then conn.Close
        End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-9
'----------------------------------------------------------------

Sub SetTblPermissions()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "GRANT SELECT, DELETE, INSERT, " _
        & "UPDATE ON CONTAINER TABLES TO Mozart"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-10
'----------------------------------------------------------------

Sub RevokePermission()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "REVOKE DELETE ON CONTAINER TABLES FROM Mozart"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 22-11
'----------------------------------------------------------------

Sub DeleteGroupAccount()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "DROP GROUP Mozart"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub

