Helper functions for fetching user information from the system/environment/network.

GetUserInfo.bas

Private Type ExtendedUserInfo
    EUI_name As Long
    EUI_password  As Long ' Null, only settable
    EUI_password_age  As Long
    EUI_priv  As Long
    EUI_home_dir  As Long
    EUI_comment  As Long
    EUI_flags  As Long
    EUI_script_path  As Long
    EUI_auth_flags  As Long
    EUI_full_name As Long
    EUI_usr_comment  As Long
    EUI_parms  As Long
    EUI_workstations  As Long
    EUI_last_logon  As Long
    EUI_last_logoff  As Long
    EUI_acct_expires  As Long
    EUI_max_storage  As Long
    EUI_units_per_week  As Long
    EUI_logon_hours  As Long
    EUI_bad_pw_count  As Long
    EUI_num_logons  As Long
    EUI_logon_server  As Long
    EUI_country_code  As Long
    EUI_code_page  As Long
End Type
 
 'Windows API function declarations
Private Declare Function apiNetGetDCName Lib "netapi32.dll" _
Alias "NetGetDCName" (ByVal servername As Long, _
ByVal DomainName As Long, _
bufptr As Long) As Long
 
 ' function frees the memory that the NetApiBufferAllocate function allocates.
Private Declare Function apiNetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (ByVal buffer As Long) As Long
 
 ' Retrieves the length of the specified Unicode string.
Private Declare Function apilstrlenW Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
 
Private Declare Function apiNetUserGetInfo Lib "netapi32.dll" _
Alias "NetUserGetInfo" (servername As Any, _
username As Any, _
ByVal level As Long, _
bufptr As Long) As Long
 
 ' moves memory either forward or backward, aligned or unaligned,
 ' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)
 
Private Declare Function apiGetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 
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&
 
Function GetFullNameOfLoggedUser(Optional strUserName As String) As String
     '
     ' Returns the full name for a given network username (NT/2000/XP only)
     ' Omitting the argument will retrieve the full name for the currently logged on user
     '
    On Error GoTo Err_GetFullNameOfLoggedUser
    Dim pBuf As Long
    Dim dwRec As Long
    Dim pTmp As ExtendedUserInfo
    Dim abytPDCName() As Byte
    Dim abytUserName() As Byte
    Dim lngRet As Long
    Dim i As Long
     
     ' Unicode
    abytPDCName = GetDCName() & vbNullChar
    If (Len(strUserName) = 0) Then
        strUserName = GetUserName()
    End If
    abytUserName = strUserName & vbNullChar
     
     ' Level 2
    lngRet = apiNetUserGetInfo(abytPDCName(0), abytUserName(0), 2, pBuf)
    If (lngRet = ERROR_SUCCESS) Then
        Call sapiCopyMem(pTmp, ByVal pBuf, Len(pTmp))
        GetFullNameOfLoggedUser = StrFromPtrW(pTmp.EUI_full_name)
    End If
     
    Call apiNetAPIBufferFree(pBuf)
     
Exit_GetFullNameOfLoggedUser:
    Exit Function
     
Err_GetFullNameOfLoggedUser:
    MsgBox Err.Description, vbExclamation
    GetFullNameOfLoggedUser = vbNullString
    Resume Exit_GetFullNameOfLoggedUser
End Function
 
Private Function GetUserName() As String
     ' Returns the network login name
    Dim lngLen As Long, lngRet As Long
    Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngRet = apiGetUserName(strUserName, lngLen)
    If lngRet Then
        GetUserName = Left$(strUserName, lngLen - 1)
    End If
End Function
 
Function GetDCName() As String
    Dim pTmp As Long
    Dim lngRet As Long
    Dim abytBuf() As Byte
     
    lngRet = apiNetGetDCName(0, 0, pTmp)
    If lngRet = NERR_SUCCESS Then
        GetDCName = StrFromPtrW(pTmp)
    End If
    Call apiNetAPIBufferFree(pTmp)
End Function
 
Private Function StrFromPtrW(pBuf As Long) As String
    Dim lngLen As Long
    Dim abytBuf() As Byte
     
     ' Get the length of the string at the memory location
    lngLen = apilstrlenW(pBuf) * 2
     ' if it's not a ZLS
    If lngLen Then
        ReDim abytBuf(lngLen)
         ' then copy the memory contents
         ' into a temp buffer
        Call sapiCopyMem(abytBuf(0), ByVal pBuf, lngLen)
         ' return the buffer
        StrFromPtrW = abytBuf
    End If
End Function