ACC1x: Sample Functions to Check User, Group Information (1.x)

ID: Q123012

The information in this article applies to:

Microsoft Access versions 1.0, 1.1

SUMMARY

This article contains several sample user-defined functions. You can use these functions to:

Return a list of users in the current system database.

Return a list of groups in the current system database.

Return a list of users in a specified group.

Return a list of groups to which a specified user belongs.

Determine if the current user belongs to a specified group.

MORE INFORMATION

This article assumes that you are familiar with Access Basic and with creating Microsoft Access applications using the programming tools provided with Microsoft Access. For more information about Access Basic, please refer to the "Introduction to Programming" manual.

The techniques described in this article rely on the use of system tables stored with the SYSTEM.MDA file. These tables are undocumented and are subject to change in future versions of Microsoft Access. Use of the system tables is not supported by Microsoft.

You can use the following sample functions to return user and group information in the current system database. By default, only members of the Admins group have permission to read data from the MSysAccounts and MSysGroups tables stored with the SYSTEM.MDA file. If your Microsoft Access account is not a member of the Admins group, use of these functions may cause errors. If this presents a problem, you may want to consider upgrading to Microsoft Access version 2.0, where you can use data access objects (DAO) to view user and group information.

The Sample Functions

NOTE: In the following sample code, an underscore (_) at the end of a line is used as a line-continuation character. Remove the underscore from the end of the line when re-creating this code in Access Basic.


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

   Option Compare Database
   Option Explicit

   Declare Function GetPrivateProfileString% Lib "Kernel" (ByVal _
   lpApplicationName$, ByVal lpKeyName$, ByVal lpDefault$, ByVal _
   lpReturnedString$, ByVal nSize%, ByVal lpFileName$)

   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 MSACCESS.INI file is located in the Windows path.
   '**************************************************************

   On Error GoTo err_ListUsersInSystem

   Dim MyDB As Database, MySnap As Snapshot
   Dim lpReturnedString$, nSize%, GetInfo%, SysDB$

   lpReturnedString$ = Space$(255)
   nSize% = Len(lpReturnedString$)
   GetInfo% = GetPrivateProfileString("Options", "SystemDB", "", _
   lpReturnedString$, nSize%, "MSACCESS.INI")
   SysDB$ = lpReturnedString$

   Set MyDB = OpenDatabase(SysDB$)
   Set MySnap = MyDB.CreateSnapshot("MSysUserList")
   MySnap.MoveFirst

   Do Until MySnap.EOF
        Debug.Print MySnap![Name]
        MySnap.MoveNext
   Loop

   MySnap.Close
   MyDB.Close
   Exit Function

   err_ListUsersInSystem:
     If Err = 3112 Then
       MsgBox UCase(User()) & " is not a member of the Admins Group", 16, _
       "Error"
          Exit Function
     Else
          MsgBox Err & ": " & Error
          Exit Function
     End If

    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 MSACCESS.INI file is located in the Windows path.
    '**************************************************************

    On Error GoTo err_ListGroupsInSystem

    Dim MyDB As Database, MySnap As Snapshot
    Dim lpReturnedString$, nSize%, GetInfo%, SysDB$

    lpReturnedString$ = Space$(255)
    nSize% = Len(lpReturnedString$)
    GetInfo% = GetPrivateProfileString("Options", "SystemDB", "", _
    lpReturnedString$, nSize%, "MSACCESS.INI")
    SysDB$ = lpReturnedString$

    Set MyDB = OpenDatabase(SysDB$)
    Set MySnap = MyDB.CreateSnapshot("MSysGroupList")
    MySnap.MoveFirst

    Do Until MySnap.EOF
         Debug.Print MySnap![Name]
         MySnap.MoveNext
    Loop

    MySnap.Close
    MyDB.Close
    Exit Function

    err_ListGroupsInSystem:
    If Err = 3112 Then
      MsgBox UCase(User()) & " is not a member of the Admins Group", 16, _
      "Error"
         Exit Function
    Else
         MsgBox Err & ": " & Error
         Exit Function
    End If
    End Function

    Function ListUsersOfGroup (GroupName As String)
    '**************************************************************
    'Purpose: Lists the users belonging to a particular group.
    'Accepts: The name of a group.
    'Returns: A list of users for the specified group.
    'Assumes: The MSACCESS.INI file is located in the Windows path.
    '         Also, the current user is a member of the Admins
    '         group.
    '**************************************************************

    Dim SQL_String As String, SysDB$
    Dim lpReturnedString$, nSize%, GetInfo%
    Dim MyDB As Database, MySnap As Snapshot
    On Error GoTo err_ListUsersOfGroup

    lpReturnedString$ = Space$(255)
    nSize% = Len(lpReturnedString$)
    GetInfo% = GetPrivateProfileString("Options", "SystemDB", "", _
    lpReturnedString$, nSize%, "MSACCESS.INI")
    SysDB$ = lpReturnedString$

    Set MyDB = OpenDatabase(SysDB$)

    SQL_String = "SELECT MSysAccounts.Name FROM MSysAccounts AS B, _
    MSysGroups, MSysAccounts, "
    SQL_String = SQL_String & "B INNER JOIN MSysGroups ON B.SID = _
    MSysGroups.GroupSID, "
    SQL_String = SQL_String & "MSysGroups INNER JOIN MSysAccounts ON_
    MSysGroups.UserSID = MSysAccounts.SID "
    SQL_String = SQL_String & "WHERE ((B.Name= '" & GroupName & "'));"

    Set MySnap = MyDB.CreateSnapshot(SQL_String)

    MySnap.MoveFirst
    Do Until MySnap.EOF
         Debug.Print MySnap.[Name]
         MySnap.MoveNext
    Loop

    MySnap.Close
    MyDB.Close
    Exit Function

    err_ListUsersOfGroup:
    If Err = 3021 Then
         MsgBox UCase(GroupName) & " is not a valid group", 16, "Error"
         Resume Next
    ElseIf Err = 3112 Then
      MsgBox UCase(User()) & " is not a member of the Admins Group", 16, _
      "Error"
         Exit Function
    Else
         MsgBox Err & ": " & Error
         Exit Function
    End If

    End Function

    Function ListGroupsOfUser (UserName As String)
    '**************************************************************
    'Purpose: Lists the groups to which a particular user belongs.
    'Accepts: The name of a user.
    'Returns: A list of groups for the specified user.
    'Assumes: The MSACCESS.INI file is located in the Windows path.
    '**************************************************************

    On Error GoTo err_ListGroupsOfUser

    Dim MyDB As Database, MyQueryDef As QueryDef, MySnap As Snapshot
    Dim lpReturnedString$, nSize%, GetInfo%, SysDB$

    lpReturnedString$ = Space$(255)
    nSize% = Len(lpReturnedString$)
    GetInfo% = GetPrivateProfileString("Options", "SystemDB", "", _
    lpReturnedString$, nSize%, "MSACCESS.INI")
    SysDB$ = lpReturnedString$

    Set MyDB = OpenDatabase(SysDB$)
    Set MyQueryDef = MyDB.OpenQueryDef("MSysUserMemberships")
    MyQueryDef![UserName] = UserName
    Set MySnap = MyQueryDef.CreateSnapshot()
    MySnap.MoveFirst

    Do Until MySnap.EOF
         Debug.Print MySnap![Name]
         MySnap.MoveNext
    Loop

    MySnap.Close
    MyQueryDef.Close
    MyDB.Close
    Exit Function

    err_ListGroupsOfUser:
    If Err = 3021 Then
         MsgBox UCase(UserName) & " is not a valid User Name!", 16, "Error"
         Resume Next
    ElseIf Err = 3112 Then
      MsgBox UCase(User()) & " is not a member of the Admins Group", 16, _
      "Error"
         Exit Function
    Else
         MsgBox Err & ": " & Error
         Exit Function
    End If

    End Function

    Function CurrentUserInGroup (GroupName As String)
    '**************************************************************
    'Purpose: Determines if the current user is in a 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 MSACCESS.INI file is located in the Windows path.
    '         Also, the current user is a member of the Admins
    '         group.
    '**************************************************************

    Dim SQL_String As String, SysDB$
    Dim lpReturnedString$, nSize%, GetInfo%
    Dim MyDB As Database, MySnap As Snapshot
    CurrentUserInGroup = False

    On Error GoTo err_CurrentUserInGroup

    lpReturnedString$ = Space$(255)
    nSize% = Len(lpReturnedString$)
    GetInfo% = GetPrivateProfileString("Options", "SystemDB", "", _
    lpReturnedString$, nSize%, "MSACCESS.INI")
    SysDB$ = lpReturnedString$

    Set MyDB = OpenDatabase(SysDB$)

    SQL_String = "SELECT MSysAccounts.Name FROM MSysAccounts AS B, _
    MSysGroups, MSysAccounts, "
    SQL_String = SQL_String & "B INNER JOIN MSysGroups ON B.SID = _
    MSysGroups.GroupSID, "
    SQL_String = SQL_String & "MSysGroups INNER JOIN MSysAccounts ON _
    MSysGroups.UserSID = MSysAccounts.SID "
    SQL_String = SQL_String & "WHERE ((B.Name= '" & GroupName & "'));"

    Set MySnap = MyDB.CreateSnapshot(SQL_String)

    MySnap.MoveFirst
    Do Until MySnap.EOF
         If MySnap![Name] = User() Then
              CurrentUserInGroup = True
              GoSub err_Exit
         Else
              MySnap.MoveNext
         End If
    Loop

    err_Exit:
    MySnap.Close
    MyDB.Close
    Exit Function

    err_CurrentUserInGroup:
    If Err = 3021 Then
         MsgBox UCase(GroupName) & " is not a valid group", 16, "Error"
    ElseIf Err = 3112 Then
      MsgBox UCase(User()) & " is not a member of the Admins Group", 16, _
      "Error"
         Exit Function
    Else
         MsgBox Err & ": " & Error
         Exit Function
    End If
    GoSub err_Exit
    End Function

To test these functions, run them in the Immediate window. For example, to test the ListGroupsOfUser() function, follow these steps:

Open the sample database NWIND.MDB.

Create a new module and enter the sample functions above.

From the View menu, choose Immediate Window.

In the Immediate window, type the following line and then press ENTER:

? ListGroupsOfUser("Admin")

REFERENCES

Microsoft Access "User's Guide," version 1.1, Chapter 25, "Administering a Database System," pages 616-636

Microsoft Access "Introduction to Programming," version 1.1, Chapter 8, "Manipulating Data," pages 124-127

Additional query words: security secure

Keywords : kbusage ScrtUsr
Version : 1.0 1.1
Platform : WINDOWS
Issue type : kbinfo