لطفا منتظر باشید ...
Using Code to Maintain Users
Not only might you want to maintain groups using code, but you might also want to maintain users with code. You can employ ADO to create and manage user accounts at runtime. The frmMaintainUsers form shown in Figure 28.2 illustrates this process.
Figure 28.2. This form enables administrative users to add and remove users.
Adding Users
You add a user with the Append method of the Users collection of the Catalog object. The frmMaintainUsers form, also contained in CHAP28EX.MDB, contains a command button named cmdAddUsers that adds a user. Listing 28.5 shows the code for this.
Listing 28.5 Adding a User
Private Sub cmdAdd_Click()
Dim boolSuccess As Boolean
If IsNull(Me.txtUserName) Then
MsgBox "You Must Fill In User Name Before Proceeding"
Else
boolSuccess = CreateUsers(Me.txtUserName.Value, _
Nz(Me.txtPassword.Value, "))
If boolSuccess Then
MsgBox "User Created Successfully"
Else
MsgBox "User Not Created"
End If
End If
End Sub
This code checks to ensure that the username has been filled in and then calls the CreateUsers function shown in Listing 28.6.NOTE
 | You can find the CreateUsers function, along with all the other functions included in this chapter, in the CHAP28EX.MDB sample database. |
Listing 28.6 Using the CreateUsers Function to Create a User
Function CreateUsers(UserName as String, _
Password as String) As Boolean
On Error GoTo CreateUsers_Err
Dim cat As ADOX.Catalog
CreateUsers = True
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
'Add user to the Users collection
'of the Catalog object
cat.Users.Append UserName, Password
CreateUsers_Exit:
Set cat = Nothing
Exit Function
CreateUsers_Err:
MsgBox "Error # " & Err.Number & ": " & Err.Description
CreateUsers = False
Resume CreateUsers_Exit
End Function
This routine instantiates a Catalog object. It sets the ActiveConnection property of the Catalog object to the connection associated with the current project. It then invokes the Append method of the Users collection of the Catalog object to add the user to the catalog. The code passes the values in the txtUserName and txtPassword controls to the Append method as arguments. The Append method adds the user to the collection of users in the catalog.
Assigning Users to a Group
So far, you have added a user, but you have not given the user group membership. Now we'll take a look at how you can add a user to an existing group. Listing 28.7 shows the code behind the cmdAssign button on the frmMaintainUsers form.
Listing 28.7 Assigning a User to a Group
Private Sub cmdAssign_Click()
Dim boolSuccess As Boolean
If IsNull(Me.txtUserName) Or IsNull(Me.txtGroupName) Then
MsgBox "You Must Fill In User Name and Group Name Before Proceeding"
Else
boolSuccess = AssignToGroup(Me.txtUserName.Value, _
Me.txtGroupName.Value)
If boolSuccess Then
MsgBox "User Successfully Assigned to Group"
Else
MsgBox "User Not Assigned to Group"
End If
End If
End Sub
This code makes sure that both the txtUserName and txtGroupName text boxes are filled in and then calls the AssignToGroup function, which attempts to assign the user to the specified group. Listing 28.8 shows the AssignToGroup function.
Listing 28.8 Using the AssignToGroup Function to Assign a User to a Group
Function AssignToGroup(UserName as String, _
GroupName as String)
On Error GoTo AssignToGroup_Err
Dim cat As ADOX.Catalog
Dim usr As ADOX.User
AssignToGroup = True
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
'Attempt to append group to the Groups
'collection of the Catalog object
cat.Groups.Append GroupName
'Add the user to the specified group
Set usr = cat.Users(UserName)
usr.Groups.Append GroupName
AssignToGroup_Exit:
Set cat = Nothing
Exit Function
AssignToGroup_Err:
Select Case Err.Number
Case -2147467259 'Group already exists
Resume Next
Case 3265
MsgBox "Group Not Found"
Case Else
MsgBox "Error # " & Err.Number & ": " & Err.Description
End Select
AssignToGroup = False
Resume AssignToGroup_Exit
End Function
This code creates a Catalog object variable and a User object variable. It sets the ActiveConnection property of the Catalog object to the Connection property of the current project. The Append method of the Groups collection of the Catalog object is used to add the group to the Groups collection of the catalog. If the group already exists, the code ignores the resulting error. A Set statement points the User object at the user specified as the UserName input parameter to the function. Finally, the Append method of the Groups collection of the User object adds the user to the group supplied by the value specified as the GroupName parameter.
Removing Users from a Group
Just as you will want to add users to groups, you'll also want to remove them from groups. The code in Listing 28.9 is located under the cmdRevoke command button on the frmMaintainUsers form.
Listing 28.9 Removing a User from a Group
Private Sub cmdRevoke_Click()
Dim boolSuccess As Boolean
If IsNull(Me.txtUserName) Or IsNull(Me.txtGroupName) Then
MsgBox "You Must Fill In User Name and Group Name Before Proceeding"
Else
boolSuccess = RevokeFromGroup(Me.txtUserName.Value, _
Me.txtGroupName.Value)
If boolSuccess Then
MsgBox "User Successfully Removed from Group"
Else
MsgBox "User Not Removed from Group"
End If
End If
End Sub
This code ensures that the name of the user and group are filled in on the form and then calls the RevokeFromGroup function, which is shown in Listing 28.10.
Listing 28.10 Using the RevokeFromGroup Function to Remove a User from a Group
Function RevokeFromGroup(UserName as String, _
GroupName as String)
On Error GoTo RevokeFromGroup_Err
Dim cat As ADOX.Catalog
RevokeFromGroup = True
Set cat = New ADOX.Catalog
Dim usr As ADOX.User
cat.ActiveConnection = CurrentProject.Connection
'Delete the user from the specified group
Set usr = cat.Users(UserName)
usr.Groups.Delete GroupName
RevokeFromGroup_Exit:
Set cat = Nothing
Exit Function
RevokeFromGroup_Err:
If Err.Number = 3265 Then
MsgBox "Group Not Found"
Else
MsgBox "Error # " & Err.Number & ": " & Err.Description
End If
RevokeFromGroup = False
Resume RevokeFromGroup_Exit
End Function
This procedure establishes a Catalog object and points its Connection property to the connection associated with the current project. It establishes a User object and points it to the user specified in the UserName input parameter. It then removes the specified user from the group using the Delete method of the Groups collection of the User object. Notice that the Item of the Users collection referenced is specified in the parameter UserName, which is passed from the text box txtUserName. The group that the user is deleted from is specified by the parameter GroupName, which is passed from the txtGroupName text box.
Removing Users Entirely
Sometimes you want to remove a user entirely. The cmdRemove command button on the frmMaintainUsers form accomplishes this task, as shown in Listing 28.11.
Listing 28.11 Deleting a User
Private Sub cmdRemove_Click()
Dim boolSuccess As Boolean
If IsNull(Me.txtUserName) Then
MsgBox "You Must Fill In User Name Before Proceeding"
Else
boolSuccess = RemoveUsers(Me.txtUserName.Value)
If boolSuccess Then
MsgBox "User Removed Successfully"
Else
MsgBox "User Not Removed"
End If
End If
End Sub
This code needs only a username to proceed. If a username has been supplied, the code calls the RemoveUsers function, as shown in Listing 28.12.
Listing 28.12 Using the RemoveUsers Function to Delete a User
Function RemoveUsers(UserName as String)
On Error GoTo RemoveUsers_Err
Dim cat As ADOX.Catalog
RemoveUsers = True
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
'Remove a user from the Users collection
cat.Users.Delete UserName
RemoveUsers_Exit:
Set cat = Nothing
Exit Function
RemoveUsers_Err:
If Err.Number = 3265 Then
MsgBox "User Not Found"
Else
MsgBox "Error # " & Err.Number & ": " & Err.Description
End If
RemoveUsers = False
Resume RemoveUsers_Exit
End Function
The RemoveUsers function issues the Delete method on the Users collection of the catalog. This removes the user from the workgroup.
