Private Const NERR_SUCCESS As Long = 0&
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const ERROR_MORE_DATA As Long = 234&
Private Const LB_SETTABSTOPS As Long = &H192

'for use on Win NT/2000 only
Private Type WKSTA_USER_INFO_0
  wkui0_username  As Long
End Type

Private Type WKSTA_USER_INFO_1
  wkui1_username As Long
  wkui1_logon_domain As Long
  wkui1_oth_domains As Long
  wkui1_logon_server As Long
End Type

Private Declare Function NetWkstaUserEnum Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal level As Long, _
   bufptr As Long, _
   ByVal prefmaxlen As Long, _
   entriesread As Long, _
   totalentries As Long, _
   resume_handle As Long) As Long
        
Private Declare Function NetApiBufferFree Lib "netapi32" _
   (ByVal Buffer As Long) As Long

Private Declare Sub CopyMemory 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 SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
   

Private Sub Form_Load()

   ReDim TabArray(0 To 3) As Long
   
   TabArray(0) = 58
   TabArray(1) = 140
   TabArray(2) = 171
   TabArray(3) = 217
   
  'Clear existing tabs and set list tabstops
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 4&, TabArray(0))
   List1.Refresh

   Command1.Caption = "NetWkstaUserEnum 1"
   
   Label1.Caption = "call success (0) or error :"
   Label2.Caption = ""
      
End Sub


Private Sub Command1_Click()

   Dim bufptr          As Long
   Dim dwServer        As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim nStatus         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim bServer         As String
   Dim wui1            As WKSTA_USER_INFO_1
     
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   
   List1.Clear
   
  'begin do
   Do
   
     'call NetWkstaUserEnum function,
     'specifying level 1 data
      nStatus = NetWkstaUserEnum(dwServer, _
                                 1, _
                                 bufptr, _
                                 MAX_PREFERRED_LENGTH, _
                                 dwEntriesread, _
                                 dwTotalentries, _
                                 dwResumehandle)

      Label2.Caption = nStatus
   
     'Does the call succeed? Only members of the
     'Administrators local group can successfully
     'execute NetWkstaUserEnum locally and on
     'a remote server.
      If nStatus = NERR_SUCCESS Or _
         nStatus = ERROR_MORE_DATA Then
         
         If dwEntriesread > 0 Then
         
            nStructSize = LenB(wui1)
         
           'Loop through the entries
            For cnt = 0 To dwEntriesread - 1
            
              'cast data into a WKSTA_USER_INFO_1
              'type and add the data to a list
               CopyMemory wui1, ByVal bufptr + (nStructSize * cnt), nStructSize
   
               List1.AddItem GetPointerToByteStringW(wui1.wkui1_username) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_logon_domain) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_logon_server) & vbTab & _
                             GetPointerToByteStringW(wui1.wkui1_oth_domains)
                             
   
            Next
            
         Else
         
           'error: this will fire if the call
           'succeeded, but no data was returned,
           'such as when interrogating a Win9x machine.
            List1.AddItem "No data returned - possible Win9x machine  "
            
         End If
      
      Else  'error
         
         List1.AddItem "Call failed - error " & nStatus
      
      End If
   
  'continue to call NetWkstaUserEnum while
  'there are more entries.
   Loop While nStatus = ERROR_MORE_DATA
   
  'clean up
   Call NetApiBufferFree(bufptr)

End Sub


Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
   
      tmplen = lstrlenW(dwData) * 2
      
      If tmplen <> 0 Then
      
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
         
     End If
     
   End If
    
End Function