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 STYPE_DISKTREE = 0
Private Const STYPE_PRINTQ = 1
Private Const STYPE_DEVICE = 2
Private Const STYPE_IPC = 3

'for use on Win NT/2000 only
Private Type CONNECTION_INFO_1
  coni1_id As Long
  coni1_type As Long
  coni1_num_opens As Long
  coni1_num_users As Long
  coni1_time As Long
  coni1_username As Long
  coni1_netname As Long
End Type

Private Declare Function NetConnectionEnum Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal qualifier 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
   
'common routines
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 5) As Long
   
   TabArray(0) = 59
   TabArray(1) = 128
   TabArray(2) = 159
   TabArray(3) = 185
   TabArray(4) = 212
   TabArray(5) = 243
   
  'Clear existing tabs and set
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 6&, TabArray(0))
   List1.Refresh
   
   Command1.Caption = "NetConnectionEnum"
   Label1.Caption = "call success (0) or error :"
   Label2.Caption = ""
   
End Sub


Private Sub Command1_Click()

   Dim bufptr          As Long  'output
   Dim dwServer        As Long  'pointer to the server 
   Dim dwShare         As Long  'pointer to the share 
   Dim dwEntriesread   As Long  'out
   Dim dwTotalentries  As Long  'out
   Dim dwResumehandle  As Long  'out
   Dim success         As Long  
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim bServer         As String
   Dim bShare          As String   
   Dim ci1             As CONNECTION_INFO_1
     
  'use the local machine for testing. This parameter can 
  'specify the local machine or the server upon which 
  'the enumeration should occur. Note that COMPUTERNAME 
  'is an NT/2000 environment variable.
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   
   bShare = "C$"
   dwShare = StrPtr(bShare)
   
  'this is the NT/2000 declare being called! 
   success = NetConnectionEnum(dwServer, _
                               dwShare, _
                               1, _
                               bufptr, _
                               MAX_PREFERRED_LENGTH, _
                               dwEntriesread, _
                               dwTotalentries, _
                               dwResumehandle)

   List1.Clear
   Label2.Caption = success
   
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
      
      nStructSize = LenB(ci1)
      
      For cnt = 0 To dwEntriesread - 1
         
        'get one chunk of data and cast
        'into an CONNECTION_INFO_1 type,
        'and add the data to a list
         CopyMemory ci1, ByVal bufptr + (nStructSize * cnt), nStructSize
         
        'ci1.coni1_time returns the number of seconds; 
        'here we translate that into minutes
         List1.AddItem GetPointerToByteStringW(ci1.coni1_username) & vbTab & _
                       GetPointerToByteStringW(ci1.coni1_netname) & vbTab & _
                       ci1.coni1_time \ 60 & vbTab & _
                       ci1.coni1_num_opens & vbTab & _
                       ci1.coni1_num_users & vbTab & _
                       ci1.coni1_id & vbTab & _
                       GetConnectionType(ci1.coni1_type)

      Next
   End If
   
   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


Private Function GetConnectionType(ByVal dwSessionType As Long) As String

   Select Case dwSessionType
      Case STYPE_DISKTREE: GetConnectionType = "Disk drive"
      Case STYPE_PRINTQ:   GetConnectionType = " Print queue"
      Case STYPE_DEVICE:   GetConnectionType = "Communication device"
      Case STYPE_IPC:      GetConnectionType = "(IPC)"
      Case Else:           GetConnectionType = ""
   End Select
   
End Function