'------------------------------------------------------------------------------- ' Author: Graham R Seach ' Pacific Database Pty Limited ' Phone: +62 2 9871 3495 Fax: +61 2 9872 9593 ' Email: sales@pacificdb.com.au '------------------------------------------------------------------------------- ' Date: 06-06-2003 ' ' Class to retrieve information about the current user. '------------------------------------------------------------------------------- 'Workstation information type Private Type WKSTA_USER_INFO_1 wkui1_username As Long 'Specifies the name of the user currently logged on to the workstation. wkui1_logon_domain As Long 'Specifies the name of the domain in which the user is currently logged on. wkui1_oth_domains As Long 'Specifies the list of operating system domains browsed by the workstation. 'The domain names are separated by blanks. wkui1_logon_server As Long 'Specifies the name of the server that authenticated the user. End Type 'User information type Private Type USER_INFO_3 usri3_name As Long 'Pointer to a Unicode string that specifies the name of the user account. usri3_password As Long 'Pointer to a Unicode string that specifies the password for the user identified by the usri3_name member. usri3_password_age As Long 'Specifies a DWORD value that indicates the number of seconds that have elapsed since the usri3_password member was last changed. usri3_priv As Long 'Specifies a DWORD value that indicates the level of privilege assigned to the usri3_name member. usri3_home_dir As Long 'Pointer to a Unicode string specifying the path of the home directory of the user specified by the usri3_name member. usri3_comment As Long 'Pointer to a Unicode string that contains a comment to associate with the user account. usri3_flags As Long 'Specifies a DWORD value that determines several features. usri3_script_path As Long 'Pointer to a Unicode string specifying the path for the user's logon script file. usri3_auth_flags As Long 'Specifies a DWORD value that contains a set of bit flags defining the user's operator privileges. usri3_full_name As Long 'Pointer to a Unicode string that contains the full name of the user. usri3_usr_comment As Long 'Pointer to a Unicode string that contains a user comment. usri3_parms As Long 'DO NOT MODIFY! Microsoft products use this member to store user configuration information. 'Pointer to a Unicode string that is reserved for use by applications. usri3_workstations As Long 'Pointer to a Unicode string that contains the names of workstations from which the user can log on. usri3_last_logon As Long 'Specifies a DWORD value that indicates when the last logon occurred. 'This value is stored as the number of seconds that have elapsed since 00:00:00, January 1, 1970, GMT. usri3_last_logoff As Long 'Not used. Specifies a DWORD value that indicates when the last logoff occurred. 'This value is stored as the number of seconds that have elapsed since 00:00:00, January 1, 1970, GMT. usri3_acct_expires As Long 'Specifies a DWORD value that indicates when the account expires. 'This value is stored as the number of seconds elapsed since 00:00:00, January 1, 1970, GMT. 'A value of TIMEQ_FOREVER indicates that the account never expires. usri3_max_storage As Long 'Specifies a DWORD value that indicates the maximum amount of disk space the user can use. usri3_units_per_week As Long 'Specifies a DWORD value that indicates the number of equal-length time units into which the week is divided. 'This value is required to compute the length of the bit string in the usri3_logon_hours member. usri3_logon_hours As Byte 'Pointer to a 21-byte (168 bits) bit string that specifies the times during which the user can log on. 'Each bit represents a unique hour in the week, in Greenwich Mean Time (GMT). usri3_bad_pw_count As Long 'Specifies a DWORD value that indicates the number of times the user tried to log on to the account using an incorrect password. usri3_num_logons As Long 'Specifies a DWORD value that indicates the number of times the user logged on successfully to this account. usri3_logon_server As Long 'Pointer to a Unicode string that contains the name of the server to which logon requests are sent. usri3_country_code As Long 'Specifies a DWORD value that contains the country/region code for the user's language of choice. usri3_code_page As Long 'Specifies a DWORD value that contains the code page for the user's language of choice. usri3_user_id As Long 'Specifies a DWORD value that contains the relative ID (RID) of the user. usri3_primary_group_id As Long 'Specifies a DWORD value that contains the RID of the Primary Global Group for the user. usri3_profile As Long 'Pointer to a Unicode string that specifies a path to the user's profile. usri3_home_dir_drive As Long 'Pointer to a Unicode string that specifies the drive letter assigned to the user's home directory for logon purposes. usri3_password_expired As Long 'Specifies a DWORD value that contains password expiration information. End Type 'General Private Const MAXCOMMENTSZ = 256 Private Const NERR_SUCCESS = 0 Private Const ERROR_MORE_DATA = 234& Private Const MAX_CHUNK = 25 Private Const ERROR_SUCCESS = 0& 'usri3_units_per_week Private Const SAM_DAYS_PER_WEEK As Long = 7 Private Const SAM_HOURS_PER_WEEK As Long = 168 Private Const SAM_MINUTES_PER_WEEK As Long = 10080 'usri3_auth_flags Private Const AF_OP_ACCOUNTS As Long = &H8 Private Const AF_OP_COMM As Long = &H2 Private Const AF_OP_PRINT As Long = &H1 Private Const AF_OP_SERVER As Long = &H4 'usri3_priv Private Const USER_MAX_STORAGE_PARMNUM As Long = 18 Private Const USER_PRIV_PARMNUM As Long = 5 Private Const PARMNUM_BASE_INFOLEVEL As Long = 1000 Private Const USER_PRIV_ADMIN As Long = 2 Private Const USER_PRIV_GUEST As Long = 0 Private Const USER_PRIV_INFOLEVEL As Long = (PARMNUM_BASE_INFOLEVEL + USER_PRIV_PARMNUM) Private Const USER_PRIV_MASK As Long = &H3 Private Const USER_PRIV_USER As Long = 1 Private Const USER_MAXSTORAGE_UNLIMITED As Long = -1 Private Const USER_MAX_STORAGE_INFOLEVEL As Long = (PARMNUM_BASE_INFOLEVEL + USER_MAX_STORAGE_PARMNUM) 'usri3_flags Private Const UF_ACCOUNTDISABLE As Long = &H2 Private Const UF_DONT_EXPIRE_PASSWD As Long = &H10000 Private Const UF_DONT_REQUIRE_PREAUTH As Long = &H400000 Private Const UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED As Long = &H80 Private Const UF_HOMEDIR_REQUIRED As Long = &H8 Private Const UF_INTERDOMAIN_TRUST_ACCOUNT As Long = &H800 Private Const UF_LOCKOUT As Long = &H10 Private Const UF_WORKSTATION_TRUST_ACCOUNT As Long = &H1000 Private Const UF_SERVER_TRUST_ACCOUNT As Long = &H2000 Private Const UF_TEMP_DUPLICATE_ACCOUNT As Long = &H100 Private Const UF_SMARTCARD_REQUIRED As Long = &H40000 Private Const UF_TRUSTED_FOR_DELEGATION As Long = &H80000 Private Const UF_USE_DES_KEY_ONLY As Long = &H200000 Private Const UF_MNS_LOGON_ACCOUNT As Long = &H20000 Private Const UF_NORMAL_ACCOUNT As Long = &H200 Private Const UF_NOT_DELEGATED As Long = &H100000 Private Const UF_PASSWD_CANT_CHANGE As Long = &H40 Private Const UF_PASSWD_NOTREQD As Long = &H20 Private Const UF_SCRIPT As Long = &H1 Private Const UF_ACCOUNT_TYPE_MASK As Long = _ (UF_TEMP_DUPLICATE_ACCOUNT Or _ UF_NORMAL_ACCOUNT Or _ UF_INTERDOMAIN_TRUST_ACCOUNT Or _ UF_WORKSTATION_TRUST_ACCOUNT Or _ UF_SERVER_TRUST_ACCOUNT) Private Const UF_MACHINE_ACCOUNT_MASK As Long = _ (UF_INTERDOMAIN_TRUST_ACCOUNT Or _ UF_WORKSTATION_TRUST_ACCOUNT Or _ UF_SERVER_TRUST_ACCOUNT) Private Const UF_SETTABLE_BITS As Long = _ (UF_SCRIPT Or _ UF_ACCOUNTDISABLE Or _ UF_LOCKOUT Or _ UF_HOMEDIR_REQUIRED Or _ UF_PASSWD_NOTREQD Or _ UF_PASSWD_CANT_CHANGE Or _ UF_ACCOUNT_TYPE_MASK Or _ UF_DONT_EXPIRE_PASSWD Or _ UF_MNS_LOGON_ACCOUNT Or _ UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED Or _ UF_SMARTCARD_REQUIRED Or _ UF_TRUSTED_FOR_DELEGATION Or _ UF_NOT_DELEGATED Or _ UF_USE_DES_KEY_ONLY Or _ UF_DONT_REQUIRE_PREAUTH) 'usri3_acct_expires Private Const TIMEQ_FOREVER As Long = -1 'Declares Private Declare Function NetGetDCName Lib "NETAPI32.DLL" ( _ ByVal ServerName As Long, _ ByVal DomainName As Long, _ bufptr As Long) As Long Private Declare Function NetAPIBufferFree Lib "NETAPI32.DLL" _ Alias "NetApiBufferFree" ( _ ByVal buffer As Long) As Long Private Declare Function lstrlenW Lib "kernel32" _ (ByVal lpString As Long) As Long Private Declare Function NetUserGetInfo Lib "NETAPI32.DLL" _ (ServerName As Any, UserName As Any, _ ByVal Level As Long, _ bufptr As Long) As Long Private Declare Sub RtlMoveMemory Lib "kernel32" ( _ Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Declare Function GetUserName Lib "advapi32.dll" _ Alias "GetUserNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private Declare Function NetWkstaUserGetInfo Lib "netapi32" ( _ ByVal reserved As Long, _ ByVal Level As Long, _ bufptr As Long) As Long Private Declare Function GetComputerName Lib "kernel32" _ Alias "GetComputerNameA" ( _ ByVal lpBuffer As String, _ nSize As Long) As Long Private Declare Function NetUserGetGroups Lib "netapi32" ( _ lpServer As Any, _ UserName As Byte, _ ByVal Level As Long, _ lpBuffer As Long, _ ByVal PrefMaxLen As Long, _ lpEntriesRead As Long, _ lpTotalEntries As Long) As Long Private Declare Function NetUserGetLocalGroups Lib "NETAPI32.DLL" ( _ lpServer As Any, _ UserName As Byte, _ ByVal Level As Long, _ ByVal Flags As Long, _ lpBuffer As Long, _ ByVal MAXLEN As Long, _ lpEntriesRead As Long, _ lpTotalEntries As Long) As Long 'Class property variables Private sPassword As String Private lPasswordAge As Long Private lPriv As Long Private sHomeDir As String Private sScriptPath As String Private lAuthFlags As Long Private sComment As String Private lFlags As Long Private sFullName As String Private sName As String Private sUsrComment As String Private sWorkstations As String Private dteLastLogon As Date Private dteLastLogoff As Date Private dteAcctExpires As Date Private lMaxStorage As Long Private lUnitsPerWeek As Long Private lLogonHours As Long Private lBadPWCount As Long Private lNumLogons As Long Private sLogonServer As String Private lCountryCode As Long Private lUserID As Long Private lPrimaryGroupID As Long Private sHomeDirDrive As String Private lPasswordExpired As Long Private sCurrentWS As String Private sDomain As String Private sAccessUsername As String Private colGroups As Collection Private colAuthFlags As Collection Private colAcctFlags As Collection Private colPrivileges As Collection Private colAccessGroups As Collection Private Sub GetUserInfo(Optional vFirstNameFirst As Variant = False) 'Populates the property variables with the specified user's details. 'NT and later only! Dim bufptr As Long Dim dwRec As Long Dim usrinfo As USER_INFO_3 Dim bytPDCName() As Byte Dim bytUserName() As Byte Dim lReturn As Long Dim vReturn As Variant Dim strUserName As String Dim vFirstName As Variant Dim vSurname As Variant On Error GoTo GetUserInfo_Err ' Unicode bytPDCName = GetDomainContName() & vbNullChar strUserName = GetCurrentUser bytUserName = strUserName & vbNullChar ' Get the info lReturn = NetUserGetInfo(bytPDCName(0), bytUserName(0), 3, bufptr) If (lReturn = ERROR_SUCCESS) Then 'Move the buffer contents into the Type Call RtlMoveMemory(usrinfo, ByVal bufptr, Len(usrinfo)) '---- Get the password ---- sPassword = Trim(Pointer2String(usrinfo.usri3_password)) '---- Get the password age ---- lPasswordAge = usrinfo.usri3_password_age '---- Get the home dir ---- sHomeDir = Trim(Pointer2String(usrinfo.usri3_home_dir)) '---- Get the comment ---- sComment = Trim(Pointer2String(usrinfo.usri3_comment)) '---- Get the username ---- sName = Trim(Pointer2String(usrinfo.usri3_name)) '---- Get the usr comment ---- sUsrComment = Trim(Pointer2String(usrinfo.usri3_usr_comment)) '---- Get the workstations ---- sWorkstations = Trim(Pointer2String(usrinfo.usri3_workstations)) '---- Get the last logon date ---- lReturn = usrinfo.usri3_last_logon dteLastLogon = DateAdd("s", lReturn, DateSerial(1970, 1, 1) + TimeSerial(0, 0, 0)) '---- Get the last logoff date ---- lReturn = usrinfo.usri3_last_logoff dteLastLogoff = DateAdd("s", lReturn, DateSerial(1970, 1, 1) + TimeSerial(0, 0, 0)) '---- Get the account expiry date ---- lReturn = usrinfo.usri3_acct_expires dteAcctExpires = DateAdd("s", lReturn, DateSerial(1970, 1, 1) + TimeSerial(0, 0, 0)) '---- Get the max storage ---- lMaxStorage = usrinfo.usri3_max_storage '---- Get the units per week ---- lUnitsPerWeek = usrinfo.usri3_units_per_week '---- Get the logon hours ---- lLogonHours = usrinfo.usri3_logon_hours '---- Get the bad password count ---- lBadPWCount = usrinfo.usri3_bad_pw_count '---- Get the logon count ---- lNumLogons = usrinfo.usri3_num_logons '---- Get the logon server ---- sLogonServer = Trim(Pointer2String(usrinfo.usri3_logon_server)) '---- Get the country code ---- lCountryCode = usrinfo.usri3_country_code '---- Get the user ID ---- lUserID = usrinfo.usri3_user_id '---- Get the primary group ID ---- lPrimaryGroupID = usrinfo.usri3_primary_group_id '---- Get the home dir drive ---- sHomeDirDrive = Trim(Pointer2String(usrinfo.usri3_home_dir_drive)) '---- Get the password expired flag ---- lPasswordExpired = usrinfo.usri3_password_expired '---- Get the script path ---- sScriptPath = Trim(Pointer2String(usrinfo.usri3_script_path)) '---- Get the full name ---- vReturn = Trim(Pointer2String(usrinfo.usri3_full_name)) If vFirstNameFirst = True Then 'Reverse the order of the names to [FN SN] vSurname = Left(vReturn, InStr(1, vReturn, " ") - 1) vFirstName = Mid(vReturn, InStr(1, vReturn, " ") + 1) vReturn = vFirstName & " " & vSurname End If sFullName = vReturn '---- Get the account flags ---- lFlags = usrinfo.usri3_flags If lFlags > 0 Then 'Populate the collection If (lFlags And UF_ACCOUNTDISABLE) Then _ colAcctFlags.Add "Account disabled", "Account disabled" If (lFlags And UF_HOMEDIR_REQUIRED) Then _ colAcctFlags.Add "Home directory required", "Home directory required" If (lFlags And UF_PASSWD_NOTREQD) Then _ colAcctFlags.Add "No password required", "No password required" If (lFlags And UF_PASSWD_CANT_CHANGE) Then _ colAcctFlags.Add "User cannot change password", "User cannot change password" If (lFlags And UF_LOCKOUT) Then _ colAcctFlags.Add "Account is currently locked out", "Account is currently locked out" If (lFlags And UF_DONT_EXPIRE_PASSWD) Then _ colAcctFlags.Add "Password should never expire", "Password should never expire" If (lFlags And UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED) Then _ colAcctFlags.Add "Password is stored under reversible encryption in the Active Directory", "Password is stored under reversible encryption in the Active Directory" If (lFlags And UF_NOT_DELEGATED) Then _ colAcctFlags.Add "Sensitive - other users cannot act as delegates of this user account", "Sensitive - other users cannot act as delegates of this user account" If (lFlags And UF_SMARTCARD_REQUIRED) Then _ colAcctFlags.Add "Smart card required to logon", "Smart card required to logon" If (lFlags And UF_USE_DES_KEY_ONLY) Then _ colAcctFlags.Add "Must use only Data Encryption Standard (DES) encryption types for keys", "Must use only Data Encryption Standard (DES) encryption types for keys" If (lFlags And UF_DONT_REQUIRE_PREAUTH) Then _ colAcctFlags.Add "Does not require Kerberos pre-authentication for logon", "Does not require Kerberos preauthentication for logon" If (lFlags And UF_TRUSTED_FOR_DELEGATION) Then _ colAcctFlags.Add "Account is enabled for delegation", "Account is enabled for delegation" 'If (lFlags And UF_PASSWORD_EXPIRED) Then _ colAcctFlags.Add "Password has expired", "Password has expired" 'If (lFlags And UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION) Then _ colAcctFlags.Add "Account is trusted to authenticate a user outside of the Kerberos security package and delegate that user through constrained delegation", "Account is trusted to authenticate a user outside of the Kerberos security package and delegate that user through constrained delegation" If (lFlags And UF_NORMAL_ACCOUNT) Then _ colAcctFlags.Add "Normal account", "Normal account" If (lFlags And UF_TEMP_DUPLICATE_ACCOUNT) Then _ colAcctFlags.Add "Account for user whose primary account is in another domain", "Account for user whose primary account is in another domain" If (lFlags And UF_WORKSTATION_TRUST_ACCOUNT) Then _ colAcctFlags.Add "Account for a computer that is a member of this domain", "Account for a computer that is a member of this domain" If (lFlags And UF_SERVER_TRUST_ACCOUNT) Then _ colAcctFlags.Add "Account for a backup domain controller that is a member of this domain", "Account for a backup domain controller that is a member of this domain" If (lFlags And UF_INTERDOMAIN_TRUST_ACCOUNT) Then _ colAcctFlags.Add "Permit to a trust account for a domain that trusts other domains", "Permit to a trust account for a domain that trusts other domains" End If '---- Get the user privileges ---- lPriv = usrinfo.usri3_priv If lPriv > 0 Then 'Populate the collection If (lPriv And USER_PRIV_GUEST) Then colPrivileges.Add "Guest", "Guest" If (lPriv And USER_PRIV_USER) Then colPrivileges.Add "User", "User" If (lPriv And USER_PRIV_ADMIN) Then colPrivileges.Add "Administrator", "Administrator" End If '---- Get the authority flags ---- lAuthFlags = usrinfo.usri3_auth_flags If lAuthFlags > 0 Then 'Populate the collection If (lAuthFlags And AF_OP_PRINT) Then colAuthFlags.Add "Print Operator", "Print Operator" If (lAuthFlags And AF_OP_COMM) Then colAuthFlags.Add "Communications Operator", "Communications Operator" If (lAuthFlags And AF_OP_SERVER) Then colAuthFlags.Add "Server Operator", "Server Operator" If (lAuthFlags And AF_OP_ACCOUNTS) Then colAuthFlags.Add "Accounts Operator", "Accounts Operator" End If End If GetUserInfo_Exit: 'Clean up Call NetAPIBufferFree(bufptr) Exit Sub GetUserInfo_Err: Resume GetUserInfo_Exit End Sub Private Function GetDomainContName() As String 'Returns the name of the domain controller Dim usrinfo As Long Dim lReturn As Long Dim abytBuf() As Byte lReturn = NetGetDCName(0, 0, usrinfo) If lReturn = NERR_SUCCESS Then GetDomainContName = Pointer2String(usrinfo) End If 'Clean up Call NetAPIBufferFree(usrinfo) End Function Private Function Pointer2String(lPointer As Long) As String 'Converts a Unicode pointer to an ANSI string Dim lLen As Long Dim bytString() As Byte lLen = lstrlenW(lPointer) * 2 If lLen > 0 Then ReDim bytString(0 To lLen - 1) Call RtlMoveMemory(bytString(0), ByVal lPointer, lLen) Pointer2String = bytString() End If End Function Private Function GetUserDomainInfo(Optional iSelection As Integer = 1) As String 'Returns the current user's domain information 'Windows NT/2000 only Dim lReturn As Long Dim lPointer As Long Dim wkstinfo As WKSTA_USER_INFO_1 On Error GoTo MachineName_Err lReturn = NetWkstaUserGetInfo(0&, 1&, lPointer) If lReturn = 0 Then RtlMoveMemory wkstinfo, ByVal lPointer, LenB(wkstinfo) If Not lPointer = 0 Then Select Case iSelection Case 1 'Return the logon domain name GetUserDomainInfo = Pointer2String(wkstinfo.wkui1_logon_domain) Case 2 'Return the logon server name GetUserDomainInfo = Pointer2String(wkstinfo.wkui1_logon_server) Case 3 'Return the logon other domains GetUserDomainInfo = Pointer2String(wkstinfo.wkui1_oth_domains) Case 4 'Return the username GetUserDomainInfo = Pointer2String(wkstinfo.wkui1_username) Case Else GetUserDomainInfo = "" End Select End If End If MachineName_Exit: Exit Function MachineName_Err: GetUserDomainInfo = vbNullString Resume MachineName_Exit End Function Private Function GetMachineName() As String 'Returns the current user's workstation (computer) name Dim lLength As Long Dim lReturn As Long Dim sMachineName As String lLength = 16 sMachineName = String(lLength, 0) lReturn = GetComputerName(sMachineName, lLength) If lReturn <> 0 Then GetMachineName = Left(sMachineName, lLength) Else GetMachineName = "" End If End Function Public Sub CollectInfo() 'Equivalent to Main() GetUserInfo If sDomain = "" Then sDomain = GetUserDomainInfo(1) If sLogonServer = "" Or sLogonServer = "\\*" Then sLogonServer = GetUserDomainInfo(2) If sCurrentWS = "" Then sCurrentWS = GetMachineName If sName = "" Then sName = GetUserDomainInfo(3) GetUserGroups sLogonServer, sName GetAccessUserSecurityInfo End Sub Private Sub GetUserGroups(ByVal sServerName As String, _ ByVal sUserName As String, _ Optional bLocalGroups As Boolean = False) 'Populates a collection with the NT user groups to which the specified user belongs Dim bytUser() As Byte Dim bytServer() As Byte Dim lBuffer As Long Dim lEntries As Long Dim lMaxLen As Long Dim lTotalEntries As Long Dim lReturn As Long Dim lGroups() As Long Dim bytBuffer() As Byte Dim iCtr As Integer Dim lLen As Long Dim sGroups() As String If bLocalGroups Then 'If we want the local groups only... sServerName = vbNullChar Else 'If we want the remote groups only... If Left(sServerName, 2) <> "\\" Then sServerName = "\\" & sServerName End If 'Initialize bytServer = sServerName & vbNullChar bytUser = sUserName & vbNullChar If bLocalGroups Then 'Get the local groups lReturn = NetUserGetLocalGroups(bytServer(0), bytUser(0), 0, 0, _ lBuffer, 1024, lMaxLen, lTotalEntries) Else 'Get the remote groups lReturn = NetUserGetGroups(bytServer(0), bytUser(0), 0, _ lBuffer, 1024, lMaxLen, lTotalEntries) End If If lReturn = 0 And lMaxLen > 0 Then ReDim lGroups(lMaxLen - 1) As Long ReDim sGroups(lMaxLen - 1) As String 'Move the groups from the buffer to the array RtlMoveMemory lGroups(0), ByVal lBuffer, lMaxLen * 4 For iCtr = 0 To lMaxLen - 1 'Get the length of the array lLen = lstrlenW(lGroups(iCtr)) * 2 If lLen > 0 Then 'Fix the byte buffer array size ReDim bytBuffer(lLen - 1) As Byte 'Move the groups from the array to the byte buffer RtlMoveMemory bytBuffer(0), ByVal lGroups(iCtr), lLen 'Populate a new string array from the byte buffer sGroups(iCtr) = bytBuffer 'Populate the collection from the string array colGroups.Add sGroups(iCtr), sGroups(iCtr) End If Next Else ReDim sGroups(0) As String End If 'Clean up If lBuffer > 0 Then NetAPIBufferFree (lBuffer) End Sub Private Function GetCurrentUser() As String 'Returns the current username Dim nSize As Long Dim lReturn As Long Dim sUserName As String sUserName = String(254, 0) nSize = 255 lReturn = GetUserName(sUserName, nSize) If lReturn <> 0 Then GetCurrentUser = Left(sUserName, nSize - 1) Else GetCurrentUser = "" End If End Function Private Sub GetAccessUserSecurityInfo() Dim iCtr As Integer Dim sGroupName As String 'Get the current user's Access username sAccessUsername = DBEngine(0).UserName 'Get the Access security groups that the current user belongs to For iCtr = 0 To DBEngine(0).Users(sAccessUsername).Groups.Count - 1 sGroupName = DBEngine(0).Users(sAccessUsername).Groups(iCtr).name colAccessGroups.Add sGroupName, sGroupName Next iCtr End Sub Public Property Get Password() As String Password = sPassword End Property Public Property Get PasswordAge() As Long PasswordAge = lPasswordAge End Property Public Property Get HomeDir() As String HomeDir = sHomeDir End Property Public Property Get ScriptPath() As String ScriptPath = sScriptPath End Property Public Property Get Comment() As String Comment = sComment End Property Public Property Get FullName() As String FullName = sFullName End Property Public Property Get UserName() As String UserName = sName End Property Public Property Get UsrComment() As String UsrComment = sUsrComment End Property Public Property Get Workstations() As String Workstations = sWorkstations End Property Public Property Get LastLogon() As Date LastLogon = dteLastLogon End Property Public Property Get LastLogoff() As Date LastLogoff = dteLastLogoff End Property Public Property Get AcctExpires() As Date AcctExpires = dteAcctExpires End Property Public Property Get MaxStorage() As Long MaxStorage = lMaxStorage End Property Public Property Get UnitsPerWeek() As Long UnitsPerWeek = lUnitsPerWeek End Property Public Property Get LogonHours() As Long LogonHours = lLogonHours End Property Public Property Get BadPWCount() As Long BadPWCount = lBadPWCount End Property Public Property Get NumLogons() As Long NumLogons = lNumLogons End Property Public Property Get LogonServer() As String LogonServer = sLogonServer End Property Public Property Get CountryCode() As Long CountryCode = lCountryCode End Property Public Property Get UserID() As Long UserID = lUserID End Property Public Property Get PrimaryGroupID() As Long PrimaryGroupID = lPrimaryGroupID End Property Public Property Get HomeDirDrive() As String HomeDirDrive = sHomeDirDrive End Property Public Property Get PasswordExpired() As Boolean PasswordExpired = IIf(lPasswordExpired = 0, False, True) End Property Public Property Get CurrentWS() As String CurrentWS = sCurrentWS End Property Public Property Get Domain() As String Domain = sDomain End Property Public Property Get AccessUsername() As String AccessUsername = sAccessUsername End Property Public Property Get UserGroups() As Collection Set UserGroups = colGroups End Property Public Property Get AuthFlags() As Collection Set AuthFlags = colAuthFlags End Property Public Property Get AcctFlags() As Collection Set AcctFlags = colAcctFlags End Property Public Property Get Privileges() As Collection Set Privileges = colPrivileges End Property Public Property Get AccessUserGroups() As Collection Set AccessUserGroups = colAccessGroups End Property Private Sub Class_Initialize() 'Instantiate all the collections Set colGroups = New Collection Set colAuthFlags = New Collection Set colAcctFlags = New Collection Set colPrivileges = New Collection Set colAccessGroups = New Collection End Sub Private Sub Class_Terminate() 'Clean up Set colGroups = Nothing Set colAuthFlags = Nothing Set colAcctFlags = Nothing Set colPrivileges = Nothing Set colAccessGroups = Nothing End Sub