Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: NT
Expertise: Beginner
Oct 21, 1998



Building the Right Environment to Support AI, Machine Learning and Deep Learning

Finding User NAME on NT

My problem is that once I get the logged-on user id, I need to get their full name from the NT security. Is this possible? For example:

UID: jsmith123
Name: John Smith or Smith, John (however names are stored)

The following VB code will get you what you want (VB 4.0-32/VB 5.0/VB 6.0):

Option Explicit

Private m_strUserName      As String
Private m_strServerName    As String

Private Declare Function GetUserName _
   Lib "advapi32.dll" Alias "GetUserNameA" _
   (ByVal lpBuffer As String, _
    nSize As Long) As Long
Private Declare Function NetUserGetInfo _
   Lib "netapi32" _
   (ServerName As Byte, _
    UserName As Byte, _
    ByVal Level As Long, _
    lpBuffer As Long) As Long
Private Declare Function NetGetDCName _
   Lib "netapi32.dll" _
   (ServerName As Byte, _
    DomainName As Byte, _
    Buffer As Long) As Long
Private Declare Function NetApiBufferFree _
   Lib "netapi32" _
   (ByVal pBuffer As Long) As Long
Private Declare Sub CopyMem _
   Lib "kernel32" Alias "RtlMoveMemory" _
   (pTo As Any, _
    uFrom As Any, _
    ByVal lSize As Long)
Private Declare Function lstrlenW _
   Lib "kernel32" _
   (ByVal lpString As Long) As Long
Private Declare Function lstrlen _
   Lib "kernel32" _
   (ByVal lpString As Long) As Long

Private Const constUserInfo10       As Long = 10

Private Type USER_INFO_10_API
   Name As Long
   Comment As Long
   UserComment As Long
   FullName As Long
End Type

Private Type USER_INFO_10
   Name As String
   Comment As String
   UserComment As String
   FullName As String
End Type

Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Sub GetPDC(ByVal xi_strServer As String, _
                   ByVal xi_strDomain As String, _
                   ByRef xo_strPDC_Name As String)
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_astrTmp(100)                  As Byte
   Dim p_abytServerName()              As Byte
   Dim p_abytDomainName()              As Byte
   Dim p_vntReplacementStrings         As Variant
   ' ------------------------------------------
   ' Move to byte array
   ' ------------------------------------------
   p_abytServerName = xi_strServer & vbNullChar
   p_abytDomainName = xi_strDomain & vbNullChar
   ' ------------------------------------------
   ' Get the name of the PDC
   ' ------------------------------------------
   p_lngRtn = NetGetDCName(p_abytServerName(0), _
                           p_abytDomainName(0), _
   ' ------------------------------------------
   ' Set the return value (zero is success)
   ' ------------------------------------------
   If p_lngRtn <> 0 Then
      Exit Sub
   End If
   ' Translate the name
   If p_lngRtn = 0 Then
      xo_strPDC_Name = PointerToStringW(p_lngBufferPtr)
      xo_strPDC_Name = ""
   End If
   ' Free the buffer
   NetApiBufferFree p_lngBufferPtr
End Sub

Public Function UserFullName() As String
   Dim p_typUserInfo                   As USER_INFO_10
   Dim p_typUserInfoAPI                As USER_INFO_10_API
   Dim p_lngBuffer                     As Long
   Dim p_bytServerName()               As Byte
   Dim p_bytUserName()                 As Byte
   Dim p_lngRtn                        As Long

   ' Get the server name
   If Len(Trim$(m_strServerName)) = 0 Then
      GetPDC "", "", m_strServerName
   End If
   ' Convert string to a pointer
   If Len(Trim$(m_strServerName)) = 0 Then
      'p_lngPtrServerName = 0&
      p_bytServerName = vbNullChar
      p_bytServerName = m_strServerName & vbNullChar
      'p_lngPtrServerName = StrPtr(m_strServerName)
   End If
   ' Make sure we have a user name
   If m_strUserName = vbNullString Then
      m_strUserName = Module1.UserName()
   End If
   ' Convert the user name to a pointer
   If Len(Trim$(m_strUserName)) = 0 Then
      Exit Function 'Handle the error
      p_bytUserName = m_strUserName & vbNullChar
   End If
   ' Get the current info
   p_lngRtn = NetUserGetInfo(p_bytServerName(0), _
                             p_bytUserName(0), _
                             constUserInfo10, _
   If p_lngRtn = NERR_Success Then
      CopyMem p_typUserInfoAPI, _
              ByVal p_lngBuffer, _
      p_typUserInfo.FullName = PointerToStringW(p_typUserInfoAPI.FullName)
      p_typUserInfo.Comment = PointerToStringW(p_typUserInfoAPI.Comment)
      p_typUserInfo.Name = PointerToStringW(p_typUserInfoAPI.Name)
      p_typUserInfo.UserComment = PointerToStringW(p_typUserInfoAPI.UserComment)
      UserFullName = p_typUserInfo.FullName
   End If
   If p_lngBuffer Then
      Call NetApiBufferFree(p_lngBuffer)
   End If
End Function

Public Function UserName() As String
   Dim p_strBuffer                     As String
   Dim p_lngBufSize                    As Long
   Dim p_strName                       As String
   Dim p_lngRtn                        As Long
   ' ------------------------------------------
   ' Retrieve the curent user's name from the
   '     operating system
   ' ------------------------------------------
   p_strBuffer = Space$(255)
   p_lngBufSize = Len(p_strBuffer)
   p_lngRtn = GetUserName(p_strBuffer, p_lngBufSize)
   ' ------------------------------------------
   ' If failed, then just put in a blank
   ' Otherwise, fill in user name on the form
   ' ------------------------------------------
   If p_lngRtn > 0 Then
      m_strUserName = Left$(p_strBuffer, p_lngBufSize - 1)
      m_strUserName = vbNullString
   End If
   UserName = m_strUserName
End Function

Private Function PointerToStringW(lpStringW As Long) As String
   Dim Buffer() As Byte
   Dim nLen As Long
   If lpStringW Then
      nLen = lstrlenW(lpStringW) * 2
      If nLen Then
         ReDim Buffer(0 To (nLen - 1)) As Byte
         CopyMem Buffer(0), ByVal lpStringW, nLen
         PointerToStringW = Buffer
      End If
   End If
End Function
DevX Pro
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date