Microsoft Office 2000/Visual Basic Programmer's Guide   

Permissions Programming Examples

The following examples show how to set and read permissions. You can view these examples and additional code samples that work with user and group permissions in the modSecurity module in AccessSecurity.mdb in the ODETools\V9\Samples\ODETools\V9\Samples\OPG\Samples\CH18 subfolder on the Office 2000 Developer CD-ROM.

The first code fragment shows one method of setting a group's permissions from within the current Access database.

Note   This procedure assumes that the value you pass to it as the lngRights argument is either a single permissions constant, such as adRightRead, or a value created by combining all the constants for the permissions you want to set by using the Or operator, such as:

adRightRead Or adRightInsert Or adRightUpdate

Also, you can use this procedure to set permissions on all new objects of the type specified by the lngObjectType argument by passing in Null for the varObjName argument.

The procedure first revokes all permissions on the specified object, and then grants the specified permissions. This ensures that the group has exactly the permissions specified on the object. The following code fragment is from the SetGroupPermsInAccess procedure, which is available in the modSecurity module in AccessSecurity.mdb in the ODETools\V9\Samples\ODETools\V9\Samples\OPG\Samples\CH18 subfolder on the Office 2000 Developer CD-ROM.

Set catDB = New ADOX.Catalog

With catDB
   ' Open Catalog object by using connection to current database.
   .ActiveConnection = CurrentProject.Connection
   
   ' Revoke all permissions.
   .Groups(strGroup).SetPermissions varObjName, lngObjectType, adAccessSet, _
      adRightNone, lngInherit, varObjectID

   ' Grant specified permissions.
   .Groups(strGroup).SetPermissions varObjName, lngObjectType, adAccessSet, _
      lngRights, lngInherit, varObjectID
   
   ' Retrieve current permissions and display them in the Immediate window.
   lngRightsNow = .Groups(strGroup).GetPermissions(varObjName, lngObjectType, _
      varObjectID)
   Debug.Print DecodePerms(lngRightsNow)
End With

Set catDB = Nothing

If you only want to add permissions to the existing set, first use the GetPermissions method to retrieve the bitmask for the existing permissions, add the new permissions to the bitmask by using the Or operator, and then use the new bitmask as the Rights argument of the SetPermissions method. The following code fragment shows how to do this for the current Access database. The value you pass as the lngAddRights argument can be a single permissions constant or several constants combined by using the Or operator. Also, you can use this procedure to add permissions for all new objects of the type specified by the lngObjectType argument by passing in Null for the varObjName argument. The following code fragment is from the AddGroupPermsInAccess procedure, which is available in the modSecurity module in AccessSecurity.mdb in the ODETools\V9\Samples\ODETools\V9\Samples\OPG\Samples\CH18 subfolder on the Office 2000 Developer CD-ROM.

Set catDB = New ADOX.Catalog

With catDB
   ' Open Catalog object by using connection to current database.
   .ActiveConnection = CurrentProject.Connection
   
   ' Retrieve the current set of permissions for the group.
   lngOldRights = .Groups(strGroup).GetPermissions(varObjName, _
      lngObjectType, varObjectID)
   
   ' Add new permissions to existing permissions bitmask.
   lngNewRights = lngOldRights Or lngAddRights
    ' Grant specified permissions.
   .Groups(strGroup).SetPermissions varObjName, lngObjectType, adAccessSet, _
      lngNewRights, lngInherit, varObjectID
   
   ' Retrieve current permissions and display them in the Immediate window.
   lngRightsNow = .Groups(strGroup).GetPermissions(varObjName, lngObjectType)
   Debug.Print DecodePerms(lngRightsNow)
End With

Set catDB = Nothing

You can remove rights from the existing set of permissions for a group by changing a single line of code in the previous procedure. Instead of using the Or operator to add permissions to the bitmask for the new set of permissions, use the And Not operator to remove permissions from the bitmask:

' Remove permissions from existing permissions bitmask.
 lngNewRights = lngOldRights And Not lngRemoveRights

If a user or group has less than full permissions (adRightFull) and more than no permissions (adRightNone), you can check to see if a user or group has a specific permission on a object. To do this, perform a bitwise And comparison between the value of the permission you want to check and the bitmask value returned by the GetPermissions method. If the resulting value is greater than 0, you know that the user or group has the specified permission. The following example shows how to do this for a user account. The value you pass in for the lngCheckRights argument can be a single permissions constant, or several constants combined by using the Or operator. Also, you can use this procedure to check permissions for all new objects of the type specified by the lngObjectType argument by passing in Null for the varObjName argument. The following code fragment is from the CheckUserPermsInAccess procedure, which is available in the modSecurity module in AccessSecurity.mdb in the ODETools\V9\Samples\ODETools\V9\Samples\OPG\Samples\CH18 subfolder on the Office 2000 Developer CD-ROM.

Set catDB = New ADOX.Catalog

With catDB
   ' Open Catalog object by using connection to current database.
   .ActiveConnection = CurrentProject.Connection
   
   ' Retrieve the current set of permissions for the group.
   lngCurrentRights = .Users(strUser).GetPermissions(varObjName, _
      lngObjectType, varObjectID)
End With
   
 
' If varObjName is not Null, then caller is checking 
' permissions for a specific object.
If Not IsNull(varObjName) Then
   ' Check to see if lngCurrentRights is exactly adRightNone or adRightFull.
   If lngCurrentRights = adRightNone Then
      Debug.Print strUser & " has no permissions for " & varObjName
      
   ElseIf lngCurrentRights = adRightFull Then
      Debug.Print strUser & " has full permissions for " & varObjName
      
   ' Otherwise, use the And operator to check if lngCheckRights
   ' is part of the current permissions bitmask.
   ElseIf (lngCurrentRights And lngCheckRights) > 0 Then
      Debug.Print strUser & " has the specified permissions for " & varObjName
   
   ' User doesn't have the specified permissions.
   Else
      Debug.Print strUser & " doesn't have the specified permissions for " _
            & varObjName
   End If
   
' Otherwise, the varObjName object variable is Null,
' so the caller is checking permissions for new objects
' of the specified object type (in DAO, a Container object).
Else
   If lngCurrentRights = adRightNone Then
      Debug.Print strUser & " has no permissions for all new objects of " _
            & "the specified type."
      
   ElseIf lngCurrentRights = adRightFull Then
      Debug.Print strUser & " has full permissions for all new objects of " _
            & "the specified type."
   ElseIf (lngCurrentRights And lngCheckRights) > 0 Then
      Debug.Print strUser & " has the specified permissions for all new " _
            & "objects of the specified type."
   Else
      Debug.Print strUser & " doesn't have the specified permissions for " _
            & " all new objects of the specified type."
   End If
End If
   
' Display current permissions in the Immediate window.
Debug.Print DecodePerms(lngCurrentRights)

Set catDB = Nothing