VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsUserInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database
Option Explicit

'-------------------------------------------------------------------------------
' Author: Graham R Seach
'         Pacific Database Pty Limited
' Phone:  +62 2 9872 9594  Fax: +61 2 9872 9593
' Email:  sales@pacificdb.com.au
'-------------------------------------------------------------------------------
' Date: 06-06-2003
'
' Class to retrieve information about the current user.
' Example:
'
'Public Sub Test2_mod1()
'    Dim objUser As clsUserInfo
'    Dim x As Integer
'
'    Set objUser = New clsUserInfo
'
'    With objUser
'        .CollectInfo
'        Debug.Print .UserName
'        Debug.Print .FullName
'        Debug.Print .Domain
'        For x = 1 To .UserGroups.Count
'            Debug.Print .UserGroups(x)
'        Next
'
'    End With
'    Set objUser = Nothing
'
'End Sub
'
'-------------------------------------------------------------------------------

'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&
Private Const MAX_PREFERRED_LENGTH = &HFFFFFFFF

'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

'*******************************************************************************
'Use this line instead of the line above to get info on another user name hard-coded.
'    strUserName = "UserNameGoesHere"
'*******************************************************************************
    
    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
    'If lReturn = 234 the PrefMaxLen parameter is too small.
    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, MAX_PREFERRED_LENGTH, lMaxLen, lTotalEntries)
    Else
        'Get the remote groups
        lReturn = NetUserGetGroups(bytServer(0), bytUser(0), 0, _
            lBuffer, MAX_PREFERRED_LENGTH, 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