Visual Basic Network Services

WNetGetUser: User, Share and Share User for Network Resources
     
Posted:   Wednesday January 15, 2003
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   none
Author:   VBnet - Randy Birch
     

Related:  

WNetAddConnection2: Transparently Connect to Network Shares
NetShareCheck: Determine Remote Folder or Device Share Status
WNetEnumResource: Enumerating Local Network Resources
NetConnectionEnum: Enumerating Share Connection Information
NetShareEnum: Enumerating Shared Resources on Other Machines  
NetShareAdd: Create a Local or Remote Share
WNetGetUser: User, Share and Share User for Network Resources
WNetGetConnection: Get UNC Path for Mapped Drive
     
 Prerequisites
None.

This demo enumerates the local drives, determines which represent remote paths, and on list click returns the thread username, network username, share username and the UNC path to that share.

WNetGetConnection: Get UNC Path for Mapped Drive uses a similar technique to obtain the remote share path, but adds additional Shell APIs to create wrapper routines to perform tests on the constituent portions of the mapped path to assure the returned value points to a valid, existing remote path.

 BAS Module Code
None.

 Form Code
Place a listbox (List1), four text boxes (Text1 through Text4), and five labels (Label1 through Label5) on a form. The Load event positions the controls. Add the following to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const ERROR_NOT_CONNECTED As Long = 2250&
Private Const ERROR_MORE_DATA As Long = 234
Private Const ERROR_NO_NETWORK As Long = 1222&
Private Const ERROR_EXTENDED_ERROR As Long = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH As Long = 1203&
Private Const DRIVE_REMOTE As Long = 4

Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
  (ByVal nBufferLength As Long, _
   ByVal lpBuffer As String) As Long
  
Private Declare Function GetDriveType Lib "kernel32" _
   Alias "GetDriveTypeA" _
  (ByVal lpRootPathName As String) As Long

Private Declare Function WNetGetConnection Lib "mpr.dll" _
   Alias "WNetGetConnectionA" _
  (ByVal lpszLocalName As String, _
   ByVal lpszRemoteName As String, _
   cbRemoteName As Long) As Long

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

Private Declare Function WNetGetUser Lib "Mpr" _
   Alias "WNetGetUserA" _
  (ByVal lpName As String, _
   ByVal lpUserName As String, _
   lpnLength As Long) As Long

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



Private Sub Form_Load()

   Dim dx As Long
   
   dx = TextWidth("User Name (network connection)")
   
  'load the remote drives
   LoadRemoteDrives List1
   
   With Text1
      .Move dx + 360, 240, 3000, 285
      .Text = ""
   End With

   With Text2
      .Move dx + 360, Text1.Top + Text1.Height + 90, 3000, 285
      .Text = ""
   End With
   
   With List1
      .Move dx + 360, Text2.Top + Text2.Height + 90, 3000, 840
      .Text = ""
   End With
   
   With Text3
      .Move dx + 360, List1.Top + List1.Height + 90, 3000, 285
      .Text = ""
   End With

   With Text4
      .Move dx + 360, Text3.Top + Text3.Height + 90, 3000, 285
      .Text = ""
   End With
   
   With Label1
      .AutoSize = True
      .Caption = "User Name (network connection)"
      .Move 240, Text1.Top + (Text1.Height - .Height) \ 2
   End With

   With Label2
      .AutoSize = True
      .Caption = "User Name (current thread)"
      .Move 240, Text2.Top + (Text2.Height - .Height) \ 2
   End With
      
   With Label3
      .AutoSize = True
      .Caption = "Available Mapped Drives (" & List1.ListCount & ")"
      .Move 240, List1.Top + (List1.Height - .Height) \ 2
   End With
      
   With Label4
      .AutoSize = True
      .Caption = "Share Name"
      .Move 240, Text3.Top + (Text3.Height - .Height) \ 2
   End With
   
   With Label5
      .AutoSize = True
      .Caption = "Share User"
      .Move 240, Text4.Top + (Text4.Height - .Height) \ 2
   End With
   

End Sub


Private Sub List1_Click()

   Dim sDrive As String
   
   If List1.ListIndex > -1 Then
   
      If Len(List1.List(List1.ListIndex)) > 2 Then
      
         sDrive = Left$(List1.List(List1.ListIndex), 2)
      
         Text1.Text = GetNetworkUserName()
         Text2.Text = GetThreadUserName()
         Text3.Text = GetNetResourceName(sDrive)
         Text4.Text = GetNetResourceUserName(sDrive)
         
      End If
   
   End If
   
End Sub
  
         
Private Function GetNetworkUserName() As String

  'Retrieves the current default user name,
  'or the user name used to establish a
  'network connection.
   Dim buff As String
   Dim nSize As Long
   
   buff = Space$(MAX_PATH)
   nSize = Len(buff)
   
  'get the user name of the current machine
  'logged on to network by passing vbNullString
  'as lpName
   If WNetGetUser(vbNullString, buff, nSize) = 0 Then
    
     'Call succeeded. This does not necessarily
     'mean however that the user has logged on
     'to the network, as WNetGetUser should
     'return the current user's Windows name
     'even if not logged on.
      GetNetworkUserName = TrimNull(buff)
        
    End If

End Function


Private Function GetThreadUserName() As String

  'Retrieves the user name of the current
  'thread. This is the name of the user
  'currently logged onto the system. If
  'the current thread is impersonating
  'another client, GetUserName returns
  'the user name of the client that the
  'thread is impersonating.
   Dim buff As String
   Dim nSize As Long
   
   buff = Space$(MAX_PATH)
   nSize = Len(buff)

   If GetUserName(buff, nSize) = 1 Then

      GetThreadUserName = TrimNull(buff)
      Exit Function

   End If

End Function


Private Function GetNetResourceName(sShare As String) As String

  'Returns the UNC name of share passed if
  'the user has logged on to a network.
  'The default return value is an empty string,
  'meaning either the share didn't exist or
  'there was no net connection.
   Dim buff As String
   Dim nSize As Long

   buff = Space$(MAX_PATH)
   nSize = Len(buff)
   
  'get name of resource associated with
  'the passed drive. Returns 0 on success,
  'or the error code
   If WNetGetConnection(sShare, buff, nSize) = 0 Then
    
      GetNetResourceName = TrimNull(buff)
    
   End If
   
End Function


Private Function GetNetResourceUserName(sShare As String) As String

  'If the user is logged on to the network, the 
  'full name of the user (machine/username) who 
  'created the share is returned.

  'The default return value is an empty string,
  'meaning either the share didn't exist or
  'there was no net connection.
   Dim buff As String
   Dim nSize As Long

   buff = Space$(MAX_PATH)
   nSize = Len(buff)
   
  'get the user name of the current machine
  'logged on to network by passing vbNullString
  'as lpName
   If WNetGetUser(sShare, buff, nSize) = 0 Then
    
     'user owning the share
      GetNetResourceUserName = TrimNull(buff)
      Exit Function
        
    End If

End Function


Private Sub LoadRemoteDrives(lst As ListBox)

   Dim lpBuffer As String
   Dim currDrive As String

  'get list of available drives
   lpBuffer = GetDriveString()

  'Separate the drive strings
  'and add to the list. StripNulls
  'will continually shorten the
  'string, looping until a single
  'remaining terminating null is
  'encountered.
   Do Until lpBuffer = vbNullChar
  
     'strip off one drive item
     'and if its type is DRIVE_REMOTE,
     'add it to the list
      currDrive = StripNulls(lpBuffer)
   
      If GetDriveType(currDrive) = DRIVE_REMOTE Then
         lst.AddItem currDrive
      End If
    
   Loop
  
End Sub


Private Function GetDriveString() As String

  'returns of available drives each
  'separated by a null
   Dim sBuffer As String
   
  'possible 26 drives, three characters
  'each plus separating null
   sBuffer = Space$(26 * 4)
  
   If GetLogicalDriveStrings(Len(sBuffer), sBuffer) <> 0 Then

     'trim string but do not
     'remove trailing null
      GetDriveString = Trim$(sBuffer)
      
   End If

End Function


Private Function StripNulls(startstr As String) As String

  'Take a string separated by vbnullchar
  'and split off 1 item, shortening the
  'string so next item is ready for removal.
   Dim pos As Long

   pos = InStr(startstr, vbNullChar)
  
   If pos Then
   
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
   
   End If

End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter