Re: Getting Windows Display Name

Attached is a text file containing a class I wrote some time ago. Copy its contents into a new class module.

It contains methods and properties you can use to get a whole heap of info about the current user. If you can't make head or tail of it, let me know and I'll guide you through it.

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia


"coconut78" <coconut78@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:9796F7E3-746A-4094-90E3-38CD71E44B39@xxxxxxxxxxxxxxxx
I'm sorry, let me elaborate. With our network, the Windows login name is
firstname.lastname - I already know how to get this. But after a person is
logged in, there's a display name (you can find it at the top of the start
windows) and the format is usually "Lastname FirstName MI Title". I'm trying
to get that information for the database to fill out paperwork using the
user's title.

If you do a search for 'Windows Display Name', you'll find someone else who
wanted this, and found the answer and posted it, but it doesn't work for me.
Maybe I'm using a different type of network or something.

"Graham R Seach" wrote:

Display Name? Sorry, I don't understand what you mean. Can you elaborate? Do
you mean the user's full name?

Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia


"coconut78" <coconut78@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:CDCC4981-3FD2-4011-9A00-3F0BD59869AC@xxxxxxxxxxxxxxxx
> Does anybody know how to get the Display Name of Windows? I've tried > the
> one
> posted by Chris, but to no avail. I keep getting an error message.
>
> Also, I've gotten the windows username, but not the Display name.
> CN='display name'
>
> Thanks
>
> John

'-------------------------------------------------------------------------------
' Author: Graham R Seach
' Pacific Database Pty Limited
' Phone: +62 2 9872 9594 Fax: +61 2 9872 9593
' Email: sales@xxxxxxxxxxxxxxxx
'-------------------------------------------------------------------------------
' 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&
Private Const PERMISSION_FLAG = "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 colPermissionObjects As Collection 'contains a list of forms in the database that the application must maintain permissions for
Private blnLockoutState As Boolean
Private strODBCConnection As String
Private strDatabaseLoginID As String
Private strDatabaseLoginPWD As String
Private blnLockoutInitiator As Boolean

Private colHelpForms As Collection
Public Enum HelpFormActionEnum
Add = -1
Remove = 0
End Enum

Public Enum SecurityParameterTypeEnum
ObjectType = 1
ActionType = 2
End Enum

'Enable user to pick up Export to Excel menu item
Private WithEvents mnuExporter As CommandBarButton

Private Const LOCKOUT_TEST = True

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
On Error Resume Next
Call NetAPIBufferFree(bufptr)
Exit Sub
GetUserInfo_Err:
Resume GetUserInfo_Exit
Resume
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
'Initialise
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

Public Property Get PermissionObjects() As Collection
Set PermissionObjects = colPermissionObjects
End Property

Public Property Get DatabaseLoginID() As String
DatabaseLoginID = strDatabaseLoginID
End Property

Public Property Let DatabaseLoginID(ByVal sNewValue As String)
strDatabaseLoginID = sNewValue
End Property

Public Property Get DatabaseLoginPWD() As String
DatabaseLoginPWD = strDatabaseLoginPWD
End Property

Public Property Let DatabaseLoginPWD(ByVal sNewValue As String)
strDatabaseLoginPWD = sNewValue
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
Set colPermissionObjects = New Collection
Me.CollectInfo
End Sub

Private Sub Class_Terminate()
'Clean up
Set colGroups = Nothing
Set colAuthFlags = Nothing
Set colAcctFlags = Nothing
Set colPrivileges = Nothing
Set colAccessGroups = Nothing
Set colPermissionObjects = Nothing
End Sub