frmpermissions.frm

大量优秀的vb编程

                    chkPermission(PER_MODIFY_DESIGN).Value = vbUnchecked
                    chkPermission(PER_UPDATE_DATA).Value = vbUnchecked
                    chkPermission(PER_DELETE_DATA).Value = vbUnchecked
                    chkPermission(PER_INSERT_DATA).Value = vbUnchecked
                    chkPermission(PER_ADMINISTER).Value = vbUnchecked
                End If

            Case PER_UPDATE_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = vbUnchecked
                    chkPermission(PER_MODIFY_DESIGN).Value = vbUnchecked
                End If

            Case PER_INSERT_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = vbUnchecked
                End If

            Case PER_DELETE_DATA:
                If (.Value = vbChecked) Then
                    chkPermission(PER_READ_DESIGN).Value = vbChecked
                    chkPermission(PER_READ_DATA).Value = vbChecked
                Else
                    chkPermission(PER_ADMINISTER).Value = vbUnchecked
                    chkPermission(PER_MODIFY_DESIGN).Value = vbUnchecked
                End If

        End Select
    
    End With

End Sub

Private Sub cmdSave_Click()

' if there is an error goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:
    
    Dim oDocument As Document
    Dim lPermissionCode As Long
    
    ' set the document object variable to the proper selected table or
    ' query from the list box
    Set oDocument = _
               db.Containers("Tables").Documents(lstTablesAndQueries.Text)
    
    ' create the proper permission code dependant upon the selected check
    ' boxes of frmPermitter
    
    If chkPermission(PER_ADMINISTER) = vbChecked Then
    
        lPermissionCode = DB_ADMINISTER
        
    ElseIf chkPermission(PER_MODIFY_DESIGN) = vbChecked Then
        If chkPermission(PER_INSERT_DATA) = vbChecked Then
        
            lPermissionCode = DB_MODIFYDESIGN_INSERTDATA
            
        Else
        
            lPermissionCode = DB_MODIFYDESIGN
            
        End If
    ElseIf chkPermission(PER_UPDATE_DATA) = vbChecked Then
        If chkPermission(PER_INSERT_DATA) = vbChecked Then
            If chkPermission(PER_DELETE_DATA) = vbChecked Then
            
                lPermissionCode = DB_UPDATEINSERTDELETEDATA
                
            Else
            
                lPermissionCode = DB_UPDATEINSERTDATA
                
            End If
        Else
        
            lPermissionCode = DB_UPDATEDATA
            
        End If
    ElseIf chkPermission(PER_INSERT_DATA) = vbChecked Then
        If chkPermission(PER_DELETE_DATA) = vbChecked Then
        
            lPermissionCode = DB_INSERTDELETEDATA
            
        Else
        
            lPermissionCode = DB_INSERTDATA
            
        End If
    ElseIf chkPermission(PER_DELETE_DATA) = vbChecked Then
    
        lPermissionCode = DB_DELETEDATA
        
    ElseIf chkPermission(PER_READ_DATA) = vbChecked Then
    
        lPermissionCode = DB_READDATA
        
    ElseIf chkPermission(PER_READ_DESIGN) = vbChecked Then
    
        lPermissionCode = DB_READDESIGN
        
    Else
    
        lPermissionCode = DB_NOPERMISSIONS
        
    End If
    
    With oDocument
        
        ' save the permission code to the document object for the proper
        ' user
        .UserName = lstUsers.Text
        
        If (UCase$(.UserName) = "ADMIN") Then _
                lPermissionCode = lPermissionCode + DB_READSEC
        
        .Permissions = lPermissionCode
        lblPermissions.Caption = .Permissions
    
    End With
    
Exit Sub

ERR_cmdSave_Click:

    ' display the error for the user
    With Err
        MsgBox "ERROR #" & .Number & ": " & .Description, vbExclamation, _
               "ERROR"
    End With

End Sub

Private Sub cmdClose_Click()
    
    ' close the application
    Unload Me
  
End Sub

Private Sub UnCheckAll()
    
    Dim nCount As Integer
    
    ' set all the permission check boxes to unchecked
    For nCount = 0 To 6
        chkPermission(nCount).Value = vbUnchecked
    Next nCount

End Sub

Private Sub FillUserList()
    
    Dim oUser As User
    
    ' populate the user list boxes with all users except CREATOR, ENGINE,
    ' and ADMIN (these shouldn't be changed)
    For Each oUser In DBEngine.Workspaces(0).Users
        
        With oUser
            
            If (UCase$(.Name) <> "CREATOR") _
            And (UCase$(.Name) <> "ENGINE") _
            And (UCase$(.Name) <> "ADMIN") Then
            
                lstUsers.AddItem .Name
            
            End If
        
        End With
    
    Next
    
End Sub

Private Sub FillTableAndQueriesList()
    
    Dim oDocument As Document
    
    ' populate the TableAndQueries list boxes with all the available tables
    ' and queries except the system ones
    For Each oDocument In db.Containers("Tables").Documents
    
        With oDocument
            If (Left$(.Name, 4) <> "MSys") Then _
                    lstTablesAndQueries.AddItem .Name
        End With
        
    Next

End Sub

Function ReadPermissions() As Boolean

' if there is an error then goto the code labeled by ERR_ReadPermissions
On Error GoTo ERR_ReadPermissions:
    
    Dim nCount As Integer
    Dim lPermissionCode As Long
    Dim oDocument As Document
    
    ' set the document object to the appropriately selected table or query
    Set oDocument = _
            db.Containers("Tables").Documents(lstTablesAndQueries.Text)
    
    ' set the username and get the current permissions for that user
    With oDocument
        .UserName = lstUsers.Text
     
        lPermissionCode = .Permissions
    End With
    
    ' set all check boxes to unchecked
    UnCheckAll
        
    ' set the appropriate check boxes for the current permission for the
    ' user selected
    Select Case lPermissionCode
        
        Case DB_READDESIGN
            chkPermission(PER_READ_DESIGN).Value = vbChecked
        
        Case DB_READDATA
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
        
        Case DB_INSERTDATA
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        
        Case DB_UPDATEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        
        Case DB_UPDATEINSERTDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        
        Case DB_DELETEDATA
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
        
        Case DB_INSERTDELETEDATA
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
        
        Case DB_UPDATEDELETEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        
        Case DB_UPDATEINSERTDELETEDATA
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
    
        Case DB_MODIFYDESIGN
            chkPermission(PER_MODIFY_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        
        Case DB_MODIFYDESIGN_INSERTDATA
            chkPermission(PER_MODIFY_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DESIGN).Value = vbChecked
            chkPermission(PER_READ_DATA).Value = vbChecked
            chkPermission(PER_UPDATE_DATA).Value = vbChecked
            chkPermission(PER_INSERT_DATA).Value = vbChecked
            chkPermission(PER_DELETE_DATA).Value = vbChecked
        
        Case DB_ADMINISTER
            For nCount = 0 To 6
                chkPermission(nCount).Value = vbChecked
            Next nCount
        
    End Select
    
    ' indicate success
    ReadPermissions = True
    
Exit Function

ERR_ReadPermissions:

    ' display the error for the user
    With Err
        MsgBox "ERROR #" & .Number& & ": " & .Description, vbExclamation, _
               "ERROR"
    End With
    
    ' indicate failure
    ReadPermissions = False
    
End Function