'Windows type used to call the Net API
Private Type USER_INFO_10
   usr10_name          As Long
   usr10_comment       As Long
   usr10_usr_comment   As Long
   usr10_full_name     As Long
End Type

'private type to hold the actual strings displayed
Private Type USER_INFO
   name          As String
   fullname     As String
   comment       As String
   usrcomment   As String
End Type

Private Const ERROR_SUCCESS As Long = 0&
Private Const MAX_COMPUTERNAME As Long = 15
Private Const MAX_USERNAME As Long = 256

Private Declare Function NetUserGetInfo Lib "netapi32" _
   (lpServer As Byte, _
   username As Byte, _
   ByVal Level As Long, _
   lpBuffer As Long) As Long
   
Private Declare Function NetApiBufferFree Lib "netapi32" _
  (ByVal Buffer As Long) As Long

Private Declare Function GetUserName Lib "advapi32" _
   Alias "GetUserNameA" _
  (ByVal lpBuffer As String, _
   nSize As Long) As Long
   
Private Declare Function GetComputerName Lib "kernel32" _
   Alias "GetComputerNameA" _
  (ByVal lpBuffer As String, _
   nSize As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (xDest As Any, _
   xSource As Any, _
   ByVal nBytes As Long)

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Declare Function StrLen Lib "kernel32" _
   Alias "lstrlenW" _
  (ByVal lpString As Long) As Long


Private Sub Form_Load()

   Text1.Text = rgbGetUserName()
   Text2.Text = rgbGetComputerName()
   
End Sub


Private Sub Command1_Click()

   Dim usr As USER_INFO
   Dim bUsername() As Byte
   Dim bServername() As Byte
   Dim tmp As String
  
  'This assures that both the server
  'and user params have data.  Must
  'perform actual comparisons to 0 since 
  'results such as "2 And 5" equate to False! 
   If Len(Text1.Text) > 0 And _
      Len(Text2.Text) > 0 Then
   
      bUsername = Text1.Text & Chr$(0)
   
     'This demo uses the current machine as the
     'server param, which works on NT4 and Win2000.
     'If connected to a PDC or BDC, pass that
     'name as the server, instead of the return
     'value from GetComputerName().
      tmp = Text2.Text
   
     'assure the server string is properly formatted
      If Len(tmp)> 0 Then
      
         If InStr(tmp, "\\") Then
            bServername = tmp & Chr$(0)
         Else
            bServername = "\\" & tmp & Chr$(0)
         End If
      
      End If

     'Return the user information for the passed
     'user. The return values are assigned directly
     'to the non-API USER_INFO data type that we
     'defined (I prefer UDTs). Alternatively, if
     'you're a 'classy' sort of guy,  the return
     'values could be assigned directly to properties
     'in the function.
      usr = GetUserNetworkInfo(bServername(), bUsername())
      
      Text3.Text = usr.name
      
     'The call may or may not return the
     'full name, comment or usrcomment
     'members, depending on the user's
     'listing in User Manager.
      Text4.Text = usr.fullname
      Text5.Text = usr.comment
      Text6.Text = usr.usrcomment
   
   End If

End Sub


Private Function rgbGetComputerName() As String

  'return the name of the computer
   Dim tmp As String
   
   tmp = Space$(MAX_COMPUTERNAME + 1)
    
   If GetComputerName(tmp, Len(tmp)) <> 0 Then
      rgbGetComputerName = TrimNull(tmp)
   End If
   
End Function


Private Function TrimNull(item As String)

   Dim pos As Integer
   
   pos = InStr(item, Chr$(0))
   
   If pos Then
      TrimNull = Left$(item, pos - 1)
   Else
      TrimNull = item
   End If
   
End Function


Private Function rgbGetUserName() As String

  'return the name of the user
   Dim tmp As String
   
   tmp = Space$(MAX_USERNAME)
   
   If GetUserName(tmp, Len(tmp)) Then
      rgbGetUserName = TrimNull(tmp)
   End If

End Function


Private Function GetUserNetworkInfo(bServername() As Byte, _
                                    bUsername() As Byte) As USER_INFO
   
   Dim usrapi As USER_INFO_10
   Dim buff As Long
   
   If NetUserGetInfo(bServername(0), bUsername(0), 10, buff) = ERROR_SUCCESS Then
      
     'copy the data from buff into the
     'API user_10 structure
      CopyMemory usrapi, ByVal buff, Len(usrapi)
      
     'extract each member and return
     'as members of the UDT
      GetUserNetworkInfo.name = GetPointerToByteStringW(usrapi.usr10_name)
      GetUserNetworkInfo.fullname = GetPointerToByteStringW(usrapi.usr10_full_name)
      GetUserNetworkInfo.comment = GetPointerToByteStringW(usrapi.usr10_comment)
      GetUserNetworkInfo.usrcomment = GetPointerToByteStringW(usrapi.usr10_usr_comment)
   
      NetApiBufferFree buff
   
   End If
   
End Function


Private Function GetPointerToByteStringW(lpString As Long) As String
  
   Dim buff() As Byte
   Dim nSize As Long
   
   If lpString Then
   
     'its Unicode, so mult. by 2
      nSize = lstrlenW(lpString) * 2
      
      If nSize Then
         ReDim buff(0 To (nSize - 1)) As Byte
         CopyMemory buff(0), ByVal lpString, nSize
         GetPointerToByteStringW = buff
     End If
     
   End If
   
End Function