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

Private Const PLATFORM_ID_DOS As Long = 300
Private Const PLATFORM_ID_OS2 As Long = 400
Private Const PLATFORM_ID_NT  As Long = 500
Private Const PLATFORM_ID_OSF As Long = 600
Private Const PLATFORM_ID_VMS As Long = 700
   
'for use on Win NT/2000 only
Private Type WKSTA_INFO_102
  wki102_platform_id As Long
  wki102_computername As Long
  wki102_langroup As Long
  wki102_ver_major As Long
  wki102_ver_minor As Long
  wki102_lanroot As Long
  wki102_logged_on_users As Long
End Type

Private Declare Function NetWkstaGetInfo Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal level As Long, _
   bufptr As Long) As Long
   
Private Type WKSTA_USER_INFO_0 'not used; provided for completeness
  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 6) As Long
   
   TabArray(0) = 78
   TabArray(1) = 129
   TabArray(2) = 159
   TabArray(3) = 198
   TabArray(4) = 227
   TabArray(5) = 253
   TabArray(6) = 302

  'Clear existing tabs and set list tabstops
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 7&, TabArray(0))
   List1.Refresh

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


Private Sub Command1_Click()

   Dim bufptr          As Long
   Dim dwServer        As Long
   Dim success         As Long
   Dim nStructSize     As Long
   Dim bServer         As String
   Dim ws102           As WKSTA_INFO_102
   Dim wui1            As WKSTA_USER_INFO_1
     
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   
   success = NetWkstaGetInfo(dwServer, 102, bufptr)

   List1.Clear
   Label2.Caption = success
   
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
      
      nStructSize = LenB(ws102)
      
        'cast data into a WKSTA_INFO_102 type
        'and add the data to a list
         CopyMemory ws102, ByVal bufptr, nStructSize

   
         With List1
            .AddItem "\\" & GetPointerToByteStringW(ws102.wki102_computername)
            .AddItem GetPointerToByteStringW(ws102.wki102_langroup)
            .AddItem GetPlatformID(ws102.wki102_platform_id) & _
                     " " & ws102.wki102_ver_major & _
                     "." & ws102.wki102_ver_minor
         
            .AddItem ""  'spacer
         

           'because user info can only be retrieved
           'from NT / 2000, test the platform id and
           'process if valid
            Select Case ws102.wki102_platform_id
               Case PLATFORM_ID_NT
               
                   wui1 = GetWorkstationUserInfo(dwServer)
                  .AddItem GetPointerToByteStringW(wui1.wkui1_username)
                  .AddItem GetPointerToByteStringW(wui1.wkui1_logon_server)
                  .AddItem GetPointerToByteStringW(wui1.wkui1_logon_domain)
   
               Case Else
               
                  .AddItem "not available"
                  .AddItem "not available"
                  .AddItem "not available"
                  
            End Select
         
         End With
                      
   End If
   
   Call NetApiBufferFree(bufptr)
   
End Sub


Private Function GetWorkstationUserInfo(ByVal dwWorkstation As Long) _
                                        As WKSTA_USER_INFO_1

   Dim bufptr          As Long
   Dim dwEntriesread   As Long
   Dim dwTotalentries  As Long
   Dim dwResumehandle  As Long
   Dim success         As Long
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim wui1            As WKSTA_USER_INFO_1
   
   success = NetWkstaUserEnum(dwWorkstation, _
                              1, _
                              bufptr, _
                              MAX_PREFERRED_LENGTH, _
                              dwEntriesread, _
                              dwTotalentries, _
                              dwResumehandle)

   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
      
      nStructSize = LenB(wui1)
      
      If dwEntriesread > 0 Then
         
        'cast data into WKSTA_USER_INFO_1
        'and return the type. Although this
        'API enumerates and returns information
        'about all users currently logged on to
        'the workstation, including interactive,
        'service and batch logons, chances are
        'that the first user enumerated was the
        'user who logged on the session so we
        'exit after the first user info is returned.
        '
        'If this presumption is incorrect, please 
        'let me know via the VBnet Comments link.        
         CopyMemory GetWorkstationUserInfo, _
                    ByVal bufptr, _
                    nStructSize
         
        'clean up before exiting
         Call NetApiBufferFree(bufptr)
         Exit Function

      End If
      
   End If
   
  'clean up
   Call NetApiBufferFree(bufptr)
   
End Function


Private Function GetPlatformID(ByVal dwPlatformID As Long) As String

   Select Case dwPlatformID
      Case PLATFORM_ID_DOS: GetPlatformID = "DOS"
      Case PLATFORM_ID_OS2: GetPlatformID = "Windows"
      Case PLATFORM_ID_NT:  GetPlatformID = "Windows NT"
      Case PLATFORM_ID_OSF: GetPlatformID = "OSF"
      Case PLATFORM_ID_VMS: GetPlatformID = "VMS"
      Case Else
   End Select
   
End Function


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