Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Groups/Users/Permissions"
'ResMe Converted To A Property: Const Label1 = "Tables/Querys:"
'ResMe Converted To A Property: Const Label2 = "Groups Belonged to:"
'ResMe Converted To A Property: Const LABEL3 = "Members:"
'ResMe Converted To A Property: Const LABEL4 = "Owner:"
'ResMe Converted To A Property: Const BUTTON1 = "&New"
'ResMe Converted To A Property: Const BUTTON2 = "&Delete"
'ResMe Converted To A Property: Const BUTTON3 = "&Set/Clear Password"
'ResMe Converted To A Property: Const BUTTON4 = "&Assign"
'ResMe Converted To A Property: Const BUTTON5 = "&Close"
'ResMe Converted To A Property: Const OPTION1 = "Users"
'ResMe Converted To A Property: Const OPTION2 = "Groups"
'ResMe Converted To A Property: Const FRAME1 = "Permissions"
'ResMe Converted To A Property: Const MSG1 = "You do not have permission to change the Owner!"
'ResMe Converted To A Property: Const MSG2 = "No Group Selected!"
'ResMe Converted To A Property: Const MSG3 = "Delete Group?"
'ResMe Converted To A Property: Const MSG4 = "No User Selected!"
'ResMe Converted To A Property: Const MSG5 = "Delete User?"
'ResMe Converted To A Property: Const MSG6 = "New Group"
'ResMe Converted To A Property: Const MSG7 = "New User"
'ResMe Converted To A Property: Const MSG8 = "Clear the Password?"
'ResMe Converted To A Property: Const MSG9 = "No Object Selected!"
'>>>>>>>>>>>>>>>>>>>>>>>>


Dim mbSettingUser As Integer
Dim mbSettingOwner As Integer
Dim mbSettingPerm As Integer
Dim mbLoading As Integer
Dim mobjCurrObject As Object    'currently selected table or query

Private Sub cboOwners_Click()
  On Error GoTo COErr
  
  'if we are setting thru code, just exit
  If mbSettingOwner Then Exit Sub
  
  If (mobjCurrObject.Permissions And dbSecWriteOwner) = dbSecWriteOwner Then
    'try to set it
    mobjCurrObject.Owner = cboOwners.Text
  Else
    MsgBox MSG1, 48
    Exit Sub
  End If
  
  Exit Sub
  
COErr:
  ShowError
End Sub

Private Sub chkAdminister_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkAdminister.Value = vbChecked Then
    'set all of them
    chkReadDesign.Value = vbChecked
    chkModifyDesign.Value = vbChecked
    chkReadData.Value = vbChecked
    chkUpdateData.Value = vbChecked
    chkInsertData.Value = vbChecked
    chkDeleteData.Value = vbChecked
  End If
End Sub

Private Sub chkDeleteData_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkDeleteData.Value = vbUnchecked Then
    'unset others that need it
    chkAdminister.Value = vbUnchecked
    chkModifyDesign.Value = vbUnchecked
  Else
    chkReadDesign.Value = vbChecked
    chkReadData.Value = vbChecked
  End If
End Sub

Private Sub chkInsertData_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkInsertData.Value = vbUnchecked Then
    'unset others that need it
    chkAdminister.Value = vbUnchecked
  Else
    chkReadDesign.Value = vbChecked
    chkReadData.Value = vbChecked
  End If
End Sub

Private Sub chkModifyDesign_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkModifyDesign.Value = vbUnchecked Then
    'unset administer of them
    chkAdminister.Value = vbUnchecked
  Else
    chkReadDesign.Value = vbChecked
    chkReadData.Value = vbChecked
    chkInsertData.Value = vbChecked
    chkDeleteData.Value = vbChecked
  End If
End Sub

Private Sub chkReadData_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkReadData.Value = vbUnchecked Then
    'unset others that need it
    chkAdminister.Value = vbUnchecked
    chkModifyDesign.Value = vbUnchecked
  Else
    chkReadDesign.Value = vbChecked
  End If
End Sub

Private Sub chkReadDesign_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkReadDesign.Value = vbUnchecked Then
    'unset all of them
    chkAdminister.Value = vbUnchecked
    chkModifyDesign.Value = vbUnchecked
    chkReadData.Value = vbUnchecked
    chkUpdateData.Value = vbUnchecked
    chkInsertData.Value = vbUnchecked
    chkDeleteData.Value = vbUnchecked
  End If
End Sub

Private Sub chkUpdateData_Click()
  If mbSettingPerm Then Exit Sub
  
  If chkUpdateData.Value = vbUnchecked Then
    'unset others that need it
    chkAdminister.Value = vbUnchecked
    chkModifyDesign.Value = vbUnchecked
  Else
    chkReadDesign.Value = vbChecked
    chkReadData.Value = vbChecked
  End If
End Sub

Private Sub cmdAssign_Click()
  SetPermissions True    'this will assign them
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdDeleteGroup_Click()
  On Error GoTo DGErr
  
  Dim i As Integer
    
  If lstGroups.ListIndex < 0 Then
    Beep
    MsgBox MSG2
    Exit Sub
  End If
  If MsgBox(MSG3, vbYesNo + vbQuestion) <> vbYes Then Exit Sub
  
  gwsMainWS.Groups.Delete lstGroups.Text
  i = lstGroups.ListIndex
  lstGroups.RemoveItem i
  lstUsersGroups.RemoveItem i
  If lstGroups.ListCount > 0 Then
    lstGroups.ListIndex = 0
  Else
    'need to unselect all users
    For i = 0 To lstGroupsUsers.ListCount - 1
      lstGroupsUsers.Selected(i) = False
    Next
  End If
  
  Exit Sub
  
DGErr:
  ShowError
End Sub

Private Sub cmdDeleteUser_Click()
  On Error GoTo DUErr
  
  Dim i As Integer
  
  If lstUsers.ListIndex < 0 Then
    Beep
    MsgBox MSG4
    Exit Sub
  End If
  If MsgBox(MSG5, vbYesNo + vbQuestion) <> vbYes Then Exit Sub
  
  gwsMainWS.Users.Delete lstUsers.Text
  lstUsers.RemoveItem lstUsers.ListIndex
  If lstUsers.ListCount > 0 Then
    lstUsers.ListIndex = 0
  Else
    'need to unselect all groups
    For i = 0 To lstUsersGroups.ListCount - 1
      lstUsersGroups.Selected(i) = False
    Next
  End If
  Exit Sub
  
DUErr:
  ShowError
End Sub

Private Sub cmdNewGroup_Click()
  frmNewUserGroup.UserOrGroup = 1
  frmNewUserGroup.Caption = MSG6
  frmNewUserGroup.Show vbModal
End Sub

Private Sub cmdNewUser_Click()
  frmNewUserGroup.UserOrGroup = 0
  frmNewUserGroup.Caption = MSG7
  frmNewUserGroup.Show vbModal
End Sub

Private Sub cmdPassword_Click()
  On Error GoTo CPErr
  
  If lstUsers.Text = gwsMainWS.UserName Then
    frmNewPassword.Show vbModal
  Else
    If MsgBox(MSG8, vbYesNo + vbQuestion) = vbYes Then
      gwsMainWS.Users(lstUsers.Text).NewPassword vbNullString, vbNullString
    End If
  End If
  
  Exit Sub
  
CPErr:
  ShowError
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016088
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmGroupsUsers_Auto_Init
  On Error GoTo FLErr
  
  Dim grp As Group
  Dim usr As User
  Dim i As Integer

  Me.Caption = FORMCAPTION
  optUsers.Caption = OPTION1
  optGroups.Caption = OPTION2
  fraPermissions.Caption = FRAME1
  cmdNewUser.Caption = BUTTON1
  cmdDeleteUser.Caption = BUTTON2
  cmdNewGroup.Caption = BUTTON1
  cmdDeleteGroup.Caption = BUTTON2
  cmdPassword.Caption = BUTTON3
  cmdAssign.Caption = BUTTON4
  cmdClose.Caption = BUTTON5
  lblLabels(0).Caption = Label1
  lblLabels(1).Caption = Label2
  lblLabels(2).Caption = LABEL3
  lblLabels(3).Caption = LABEL4

  mbLoading = True
  'add the groups and users
  For Each usr In gwsMainWS.Users
    lstUsers.AddItem usr.Name
    lstGroupsUsers.AddItem usr.Name
    cboOwners.AddItem usr.Name
  Next
  For Each grp In gwsMainWS.Groups
    lstGroups.AddItem grp.Name
    lstUsersGroups.AddItem grp.Name
    cboOwners.AddItem grp.Name
  Next
  'set the 1st item if possible
  If lstUsers.ListCount > 0 Then
    lstUsers.ListIndex = 0
  End If
  If lstGroups.ListCount > 0 Then
    lstGroups.ListIndex = 0
  End If
  
  'fill in the objects lists from the tables form
  GetTableList lstTablesQuerys, True, False, False
  mbLoading = False
  lstTablesQuerys.Selected(0) = True
  Screen.MousePointer = vbDefault
  Exit Sub
  
FLErr:
  mbLoading = False
  ShowError
End Sub

Private Sub lstGroups_Click()
  On Error GoTo GSErr

  Dim i As Integer
  
  mbSettingUser = True
  For i = 0 To lstGroupsUsers.ListCount - 1
    If IsMemberOf(lstGroups.Text, lstGroupsUsers.List(i)) Then
      lstGroupsUsers.Selected(i) = True
    Else
      lstGroupsUsers.Selected(i) = False
    End If
  Next
  mbSettingUser = False
  
  Exit Sub
  
GSErr:
  ShowError
  mbSettingUser = False
End Sub

Private Sub lstGroupsUsers_Click()
  On Error GoTo GUErr
  
  Dim usr As User
  
  If mbSettingUser Then Exit Sub
  
  If lstGroups.ListIndex < 0 Then
    Beep
    MsgBox MSG2
    Exit Sub
  End If
  
  If lstGroupsUsers.Selected(lstGroupsUsers.ListIndex) Then
    'add the user to the group
    Set usr = gwsMainWS.CreateUser(lstGroupsUsers.Text)
    gwsMainWS.Groups(lstGroups.Text).Users.Append usr
    gwsMainWS.Users(lstGroupsUsers.Text).Groups.Refresh
  Else
    'remove the user from the group
    gwsMainWS.Groups(lstGroups.Text).Users.Delete lstGroupsUsers.Text
    gwsMainWS.Users(lstGroupsUsers.Text).Groups.Refresh
  End If
  
  Exit Sub
  
GUErr:
  ShowError
End Sub

Private Sub lstTablesQuerys_Click()
  SetPermissions False
End Sub

Private Sub lstUsers_Click()
  On Error GoTo USErr

  Dim i As Integer
  
  mbSettingUser = True
  For i = 0 To lstUsersGroups.ListCount - 1
    If IsMemberOf(lstUsersGroups.List(i), lstUsers.Text) Then
      lstUsersGroups.Selected(i) = True
    Else
      lstUsersGroups.Selected(i) = False
    End If
  Next
  mbSettingUser = False
  
  'show permissions
  SetPermissions False
  
  Exit Sub
  
USErr:
  ShowError
  mbSettingUser = False
End Sub

Private Function IsMemberOf(rsGrp As String, rsUsr As String) As Integer
  Dim usr As User
  Dim grp As Group
  Dim i As Integer
  
  Set usr = gwsMainWS.Users(rsUsr)
  
  For Each grp In usr.Groups
    If grp.Name = rsGrp Then
      IsMemberOf = True
      Exit Function
    End If
  Next
  IsMemberOf = False
End Function

Private Sub lstUsersGroups_Click()
  On Error GoTo UGErr
  
  Dim grp As Group
  
  If mbSettingUser Then Exit Sub
  
  If lstUsers.ListIndex < 0 Then
    Beep
    MsgBox MSG4
    Exit Sub
  End If
  
  If lstUsersGroups.Selected(lstUsersGroups.ListIndex) Then
    'add the group to the user
    Set grp = gwsMainWS.CreateGroup(lstUsersGroups.Text)
    gwsMainWS.Users(lstUsers.Text).Groups.Append grp
    gwsMainWS.Groups(lstUsersGroups.Text).Users.Refresh
  Else
    'remove the group from the user
    gwsMainWS.Users(lstUsers.Text).Groups.Delete lstUsersGroups.Text
    gwsMainWS.Groups(lstUsersGroups.Text).Users.Refresh
  End If
  
  Exit Sub
  
UGErr:
  ShowError
End Sub

Private Sub optGroups_Click()
  picUsers.Visible = False
  picGroups.Visible = True
End Sub

Private Sub optUsers_Click()
  picGroups.Visible = False
  picUsers.Visible = True
End Sub

Private Sub SetPermissions(rbAssign As Integer)
  On Error GoTo SPErr
  
  Dim lPermissions As Long
  Dim lPermissions2 As Long
  Dim bUncommon As Integer    'multiselected flag for common permissions
  Dim nCnt As Integer         'count of selected objects
  Dim sUserGroup As String
  Dim sObject As String
  Dim i As Integer
  
  mbSettingPerm = True
  
  If rbAssign Then
    'determine what permissions are set and Or them together
    If chkReadDesign.Value = vbUnchecked Then
      lPermissions = 0
    Else
      If chkAdminister.Value = vbChecked Then
        'set them all
        lPermissions = dbSecFullAccess Or _
                       dbSecReadDef Or _
                       dbSecWriteDef Or _
                       dbSecRetrieveData Or _
                       dbSecReplaceData Or _
                       dbSecInsertData Or _
                       dbSecDeleteData
      Else
        'set them one at a time
        lPermissions = dbSecReadDef
        If chkModifyDesign.Value = vbChecked Then
          lPermissions = lPermissions Or dbSecWriteDef
        End If
        If chkReadData.Value = vbChecked Then
          lPermissions = lPermissions Or dbSecRetrieveData
        End If
        If chkUpdateData.Value = vbChecked Then
          lPermissions = lPermissions Or dbSecReplaceData
        End If
        If chkInsertData.Value = vbChecked Then
          lPermissions = lPermissions Or dbSecInsertData
        End If
        If chkDeleteData.Value = vbChecked Then
          lPermissions = lPermissions Or dbSecDeleteData
        End If
      End If
    End If
  End If
  
  'determine if it's a user or a group
  If optUsers.Value Then
    'users
    sUserGroup = lstUsers.Text
  Else
    'groups
    sUserGroup = lstGroups.Text
  End If
  
  'set or get the permissions
  If lstTablesQuerys.ListIndex = -1 Then
    If mbLoading = False Then   'don't issue error on form load
      Beep
      MsgBox MSG9
    End If
    Exit Sub
  End If
  
  'walk the object list and process the selected objects
  For i = 0 To lstTablesQuerys.ListCount - 1
    If lstTablesQuerys.Selected(i) Then
      nCnt = nCnt + 1
      If lstTablesQuerys.ListIndex = 0 Then
        'must be 
        gdbCurrentDB.Containers("Tables").UserName = sUserGroup
        If rbAssign = False Then
          lPermissions = gdbCurrentDB.Containers("Tables").Permissions
        Else
          gdbCurrentDB.Containers("Tables").Permissions = lPermissions
        End If
        ShowOwner gdbCurrentDB.Containers("Tables")
        Set mobjCurrObject = gdbCurrentDB.Containers("Tables")
      Else
        sObject = StripConnect(lstTablesQuerys.List(i))
        'a table ot query was selected
        gdbCurrentDB.Containers("Tables").Documents(sObject).UserName = sUserGroup
        If rbAssign = False Then
          lPermissions = gdbCurrentDB.Containers("Tables").Documents(sObject).Permissions
        Else
          gdbCurrentDB.Containers("Tables").Documents(sObject).Permissions = lPermissions
        End If
        ShowOwner gdbCurrentDB.Containers("Tables").Documents(sObject)
        Set mobjCurrObject = gdbCurrentDB.Containers("Tables").Documents(sObject)
      End If
      If nCnt > 1 Then
        'if there is more than 1, they need to match or we set the flag
        If lPermissions <> lPermissions2 Then
          bUncommon = True
        End If
      End If
      'store it for the next time through
      lPermissions2 = lPermissions
    End If
  Next
  
  If rbAssign = False Then
    If bUncommon Then
      'there was some mismatch so they need to be greyed
      chkReadDesign.Value = 2
      chkModifyDesign.Value = 2
      chkAdminister.Value = 2
      chkReadData.Value = 2
      chkUpdateData.Value = 2
      chkInsertData.Value = 2
      chkDeleteData.Value = 2
    Else
      'there was either only one or they were all the same
      'so we need to set them appropriately
      If (lPermissions And dbSecReadDef) = dbSecReadDef Then
        chkReadDesign.Value = vbChecked
      Else
        chkReadDesign.Value = vbUnchecked
      End If
      If (lPermissions And dbSecWriteDef) = dbSecWriteDef Then
        chkModifyDesign.Value = vbChecked
      Else
        chkModifyDesign.Value = vbUnchecked
      End If
      If (lPermissions And dbSecFullAccess) = dbSecFullAccess Then
        chkAdminister.Value = vbChecked
      Else
        chkAdminister.Value = vbUnchecked
      End If
      If (lPermissions And dbSecRetrieveData) = dbSecRetrieveData Then
        chkReadData.Value = vbChecked
      Else
        chkReadData.Value = vbUnchecked
      End If
      If (lPermissions And dbSecReplaceData) = dbSecReplaceData Then
        chkUpdateData.Value = vbChecked
      Else
        chkUpdateData.Value = vbUnchecked
      End If
      If (lPermissions And dbSecInsertData) = dbSecInsertData Then
        chkInsertData.Value = vbChecked
      Else
        chkInsertData.Value = vbUnchecked
      End If
      If (lPermissions And dbSecDeleteData) = dbSecDeleteData Then
        chkDeleteData.Value = vbChecked
      Else
        chkDeleteData.Value = vbUnchecked
      End If
    End If
  End If
  
  mbSettingPerm = False
  Exit Sub
  
SPErr:
  mbSettingPerm = False
  ShowError
End Sub

Private Sub ShowOwner(vObj As Object)
  On Error GoTo SOErr
  
  Dim i As Integer
  
  For i = 0 To cboOwners.ListCount - 1
    If cboOwners.List(i) = vObj.Owner Then
      mbSettingOwner = True
      cboOwners.ListIndex = i
      mbSettingOwner = False
      Exit For
    End If
  Next

  Exit Sub
  
SOErr:
  mbSettingOwner = True
  cboOwners.ListIndex = -1
  mbSettingOwner = False
  ShowError
End Sub


'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "Groups/Users/Permissions"
Property Get FORMCAPTION As String
    FORMCAPTION = "Groups/Users/Permissions"
End Property

'This was: Const Label1 = "Tables/Querys:"
Property Get Label1 As String
    Label1 = "Tables/Querys:"
End Property

'This was: Const Label2 = "Groups Belonged to:"
Property Get Label2 As String
    Label2 = "Groups Belonged to:"
End Property

'This was: Const LABEL3 = "Members:"
Property Get LABEL3 As String
    LABEL3 = "Members:"
End Property

'This was: Const LABEL4 = "Owner:"
Property Get LABEL4 As String
    LABEL4 = "Owner:"
End Property

'This was: Const BUTTON1 = "&New"
Property Get BUTTON1 As String
    BUTTON1 = "&New"
End Property

'This was: Const BUTTON2 = "&Delete"
Property Get BUTTON2 As String
    BUTTON2 = "&Delete"
End Property

'This was: Const BUTTON3 = "&Set/Clear Password"
Property Get BUTTON3 As String
    BUTTON3 = "&Set/Clear Password"
End Property

'This was: Const BUTTON4 = "&Assign"
Property Get BUTTON4 As String
    BUTTON4 = "&Assign"
End Property

'This was: Const BUTTON5 = "&Close"
Property Get BUTTON5 As String
    BUTTON5 = "&Close"
End Property

'This was: Const OPTION1 = "Users"
Property Get OPTION1 As String
    OPTION1 = "Users"
End Property

'This was: Const OPTION2 = "Groups"
Property Get OPTION2 As String
    OPTION2 = "Groups"
End Property

'This was: Const FRAME1 = "Permissions"
Property Get FRAME1 As String
    FRAME1 = "Permissions"
End Property

'This was: Const MSG1 = "You do not have permission to change the Owner!"
Property Get MSG1 As String
    MSG1 = "You do not have permission to change the Owner!"
End Property

'This was: Const MSG2 = "No Group Selected!"
Property Get MSG2 As String
    MSG2 = "No Group Selected!"
End Property

'This was: Const MSG3 = "Delete Group?"
Property Get MSG3 As String
    MSG3 = "Delete Group?"
End Property

'This was: Const MSG4 = "No User Selected!"
Property Get MSG4 As String
    MSG4 = "No User Selected!"
End Property

'This was: Const MSG5 = "Delete User?"
Property Get MSG5 As String
    MSG5 = "Delete User?"
End Property

'This was: Const MSG6 = "New Group"
Property Get MSG6 As String
    MSG6 = "New Group"
End Property

'This was: Const MSG7 = "New User"
Property Get MSG7 As String
    MSG7 = "New User"
End Property

'This was: Const MSG8 = "Clear the Password?"
Property Get MSG8 As String
    MSG8 = "Clear the Password?"
End Property

'This was: Const MSG9 = "No Object Selected!"
Property Get MSG9 As String
    MSG9 = "No Object Selected!"
End Property


Private Sub frmGroupsUsers_Auto_Init()
'This routine initializes all User Interface control properties on frmGroupsUsers.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    Me.Caption = "Groups/Users"
    fraPermissions.Caption = "Permissions"
    cmdAssign.Caption = "&Assign"
    chkDeleteData.Caption = "DeleteData"
    chkInsertData.Caption = "InsertData"
    chkUpdateData.Caption = "UpdateData"
    chkReadData.Caption = "ReadData"
    chkAdminister.Caption = "Administer"
    chkModifyDesign.Caption = "ModifyDesign"
    chkReadDesign.Caption = "ReadDesign"
    optGroups.Caption = "Groups"
    optUsers.Caption = "Users"
    cmdClose.Caption = "&Close"
    cmdPassword.Caption = "&Set/Clear Password"
    cmdDeleteUser.Caption = "&Delete"
    cmdNewUser.Caption = "&New"
    lblLabels(1).Caption = "Groups Belonged to:"
    cmdDeleteGroup.Caption = "&Delete"
    cmdNewGroup.Caption = "&New"
    lblLabels(2).Caption = "Members:"
    lblLabels(3).Caption = "Owner:"
    lblLabels(0).Caption = "Tables/Querys:"
End Sub