对数据库中对象的权限可以是显式的(直接分配给用户帐户)或隐式的(从用户所属的组继承),也可以是两者的结合。Access 在权限问题上使用“最少限制”规则,即用户的权限包括其显式和隐式权限的总和。例如,如果用户 A 的帐户具有限制权限,而用户 A 属于一个具有限制权限的组,同时也属于另一个具有管理(所有)权限的组,那么用户 A 将具有管理权限。有鉴于此,通常最好不要为用户帐户分配显式权限。而应创建具有不同权限的组,然后将用户分配给具有适当权限的组,这会减少数据库管理方面的麻烦。
Private Function DeleteUser(ByVal strUser As String) As Boolean Dim catDB As ADOX.Catalog On Error GoTo DeleteUser ' 实例化 Catalog 对象。 Set catDB = New ADOX.Catalog With catDB ' 在当前数据库中打开 Catalog 对象。 .ActiveConnection = CurrentProject.Connection ' 删除 strUser。 .Users.Delete strUser End With ' 关闭 Catalog 对象。 Set catDB = Nothing DeleteUser = True DeleteUser_Err: Msgbox Err.Number & ":" & Err.Description DeleteUser = False End Function
Private Function AddGroup(ByVal strGroup As String, _ ByVal strPID As String) As Boolean Dim catDB As ADOX.Catalog On Error GoTo AddGroup_Err Set catDB = New ADOX.Catalog With catDB ' 在当前数据库中打开 Catalog 对象。 .ActiveConnection = CurrentProject.Connection ' 创建新的组。 .Groups.Append strGroup, strPID End With ' 关闭 Catalog 对象。 Set catDB = Nothing AddGroup = True AddGroup_Err: Msgbox Err.Number & ":" & Err.Description AddGroup = False End Function
此过程首先实例化 Catalog 对象,然后打开一个到当前数据库的连接。接下来,通过使用来自调用过程的参数,将新组追加到 Catalog 对象的 Groups 集合。
要删除现有组,可以使用以下过程:
Private Function DeleteGroup(ByVal strGroup As String) As Boolean Dim catDB As ADOX.Catalog On Error GoTo DeleteGroup_Err Set catDB = New ADOX.Catalog With catDB ' 在当前数据库中打开 Catalog 对象。 .ActiveConnection = CurrentProject.Connection ' 删除 strGroup。 .Groups.Delete strGroup End With ' 关闭 Catalog 对象。 Set catDB = Nothing DeleteGroup = True DeleteGroup_Err: Msgbox Err.Number & ":" & Err.Description DeleteGroup = False End Function
要对数据库中的各种对象设置权限,可以使用 Group 或 User 对象的 SetPermissions 方法。在下面的过程中,我们首先撤消组的所有权限,然后再赋予组特定的权限。这样可以确保该组只具有我们指定的权限:
Private Function SetGroupPermissions(ByVal strGroup As String, _ ByVal strTable As String, ByVal strObjectType As String, _ ByVal strAction As String, _ ByVal strRevokeEnum As String) As Boolean Dim catDB As ADOX.Catalog On Error GoTo SetGroupPermissions_Err Set catDB = New ADOX.Catalog With catDB ' 在当前数据库中打开 Catalog 对象。 .ActiveConnection = CurrentProject.Connection ' 撤消组的所有权限。 .Groups(strGroup).SetPermissions tblTable, _ strObjectType, strAction, strRevokeEnum ' 赋予组特定的权限。 .Groups(strGroup).SetPermissions tblTable, _ strObjectType, strAction, _ adRightRead Or adRightInsert Or adRightUpdate End With ' 关闭 Catalog 对象。 Set catDB = Nothing SetGroupPermissions = True SetGroupPermissions_Err: Msgbox Err.Number & ":" & Err.Description SetGroupPermissions = False End Function