Microsoft KB Archive/123012

{|
 * width="100%"|

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

 * }

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:


 * 1) Open the sample database NWIND.MDB.
 * 2) Create a new module and enter the sample functions above.
 * 3) From the View menu, choose Immediate Window.
 * 4) In the Immediate window, type the following line and then press ENTER:

? ListGroupsOfUser("Admin")