CISA FotoGallery

Statistiche

Tot. visite contenuti : 928193
Home Articoli tecnici Moduli Funzioni per il controllo USER e GROUP usando il file MDW

Funzioni per il controllo USER e GROUP usando il file MDW


Questo articolo contiene le funzioni diverse di esempio definite dall'utente che è possibile utilizzare attenendo alla seguente procedura:

• Restituire un elenco di utenti nel database corrente di sistema.
• Restituire un elenco di gruppi nel database corrente di sistema.
• Restituire un elenco di utenti in un gruppo specificato.
• Restituire un elenco di gruppi a cui appartiene un utente specificato.
• Stabilire se l'utente corrente appartiene a un gruppo specificato.


'********************************************************
' Declarations section of the module
'********************************************************

Option Compare Database
Option Explicit

Function ListUsersInSystem()
'****************************************************************
' Purpose: Lists users in the current system database.
' Accepts: No arguments.
' Returns: A list of users in the current system database.
' Assumes: The existence of a user called Developer in the Admins
' group, with no password.
'****************************************************************

   
On Error GoTo err_ListUsersInSystem

   Dim MyWorkSpace As WorkSpace, i As Integer

   
' Create a new workspace as a member of the Admins group.
   
Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   For i = 0 To MyWorkSpace.Users.count - 1
      Debug.Print MyWorkSpace.Users(i).Name
   Next
i

   MyWorkSpace.Close
   Exit Function

err_ListUsersInSystem:
   If Err = 3029 Then
      
MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   
MyWorkSpace.Close
   Exit Function

End Function

Function ListGroupsInSystem()
'****************************************************************
' Purpose: Lists groups in the current system database.
' Accepts: No arguments.
' Returns: A list of groups in the current system database.
' Assumes: The existence of a user called Developer in the Admins
' group, with no password.
'****************************************************************

   
On Error GoTo err_ListGroupsInSystem

   Dim MyWorkSpace As WorkSpace, i As Integer

   
' Create a new workspace as a member of the Admins group.
   
Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")
   For i = 0 To MyWorkSpace.Groups.count - 1
        Debug.Print MyWorkSpace.Groups(i).Name
   Next
i

   MyWorkSpace.Close

   Exit Function

err_ListGroupsInSystem:
   If Err = 3029 Then
        
MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   
MyWorkSpace.Close
   Exit Function

End Function

Function ListUsersOfGroup(GroupName As String)
'****************************************************************
' Purpose: Lists users who are members of the specified group in
' the current system database.
' Accepts: The name of a group.
' Returns: A list of users in the specified group.
' Assumes: The existence of a user called Developer in the Admins
' group, with no password.
'****************************************************************

   
On Error GoTo err_ListUsersOfGroup

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim
MyGroup As Group

   ' Create a new workspace as a member of the Admins group.
   
Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyGroup = MyWorkSpace.Groups(GroupName)

   For i = 0 To MyGroup.Users.count - 1
      Debug.Print MyGroup.Users(i).Name
   Next
i

   MyWorkSpace.Close
   Exit Function

err_ListUsersOfGroup:
   If Err = 3265 Then
      
MsgBox UCase(GroupName) & " isn't a valid group name", 16, "Error"
   ElseIf Err = 3029 Then
      
MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   
MyWorkSpace.Close
   Exit Function

End Function

Function ListGroupsOfUser(UserName As String)
'****************************************************************
' Purpose: Lists the groups to which a specified user belongs.
' Accepts: The name of a user.
' Returns: A list of groups for the specified user.
' Assumes: The existence of a user called Developer in the Admins
' group, with no password.
'****************************************************************

   
On Error GoTo err_ListGroupsOfUser

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim
MyUser As User

   ' Create a new workspace as a member of the Admins group.
   
Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyUser = MyWorkSpace.Users(UserName)

   For i = 0 To MyUser.Groups.count - 1
      Debug.Print MyUser.Groups(i).Name
   Next
i

   MyWorkSpace.Close
   Exit Function

err_ListGroupsOfUser:
   If Err = 3265 Then
      
MsgBox UCase(UserName) & " isn't a valid user name", 16, "Error"
   ElseIf Err = 3029 Then
      
MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   
MyWorkSpace.Close
   Exit Function

End Function

Function CurrentUserInGroup(GroupName As String)
'****************************************************************
' Purpose: Determines if the current user belongs to the specified
' group.
' Accepts: The name of a group.
' Returns: True if the current user is a member of the specified
' group, False if the current user is not a member of
' the group.
' Assumes: The existence of a user called Developer in the Admins
' group, with no password.
'****************************************************************

   
On Error GoTo err_CurrentUserInGroup

   Dim MyWorkSpace As WorkSpace, i As Integer
   Dim
MyGroup As Group, MyUser As User

   ' Create a new workspace as a member of the Admins group.
   
Set MyWorkSpace = DBEngine.CreateWorkspace("SPECIAL", "Developer", "")

   Set MyGroup = MyWorkSpace.Groups(GroupName)
   Set MyUser = MyWorkSpace.Users(CurrentUser())
   For i = 0 To MyGroup.Users.count - 1
      If MyGroup.Users(i).Name = MyUser.Name Then
         
CurrentUserInGroup = True
         Exit Function
      End If
   Next
i

   CurrentUserInGroup = False
   MyWorkSpace.Close
   Exit Function

err_CurrentUserInGroup:
   If Err = 3265 Then
      
MsgBox UCase(GroupName) & " isn't a valid group name", 16, "Error"
      CurrentUserInGroup = False
   ElseIf Err = 3029 Then
      
MsgBox "The account used to create the workspace does not exist"
   Else MsgBox Error(Err)
   End If

   
MyWorkSpace.Close
   Exit Function

End Function



http://support.microsoft.com/kb/210331