Visual Basic Network Services

WNetGetConnection: Get UNC Path for Mapped Drive
     
Posted:   Sunday July 07, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows XP
Windows 2000 (or Windows NT 4.0 with Internet Explorer 4.0 or later)
Windows 98 (or Windows 95 with Internet Explorer 4.0 or later)
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
IsNetDrive: Determining the Connection State of a Mapped Drive
NetShareAdd: Create a Local or Remote Share
WNetGetUser: User, Share and Share User for Network Resources
WNetGetConnection: Get UNC Path for Mapped Drive
     
 Prerequisites
One of the operating systems listed under OS Restrictions above.

WNetGetConnection, when passed the drive letter of a mapped drive, will return the full UNC path to the \\server\share that drive is mapped to. By adding a few Shell APIs we can 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
To a form add a command button (Command1),a label (Label1) and two text boxes (Text1, Text2). 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 ERROR_SUCCESS As Long = 0
Private Const MAX_PATH As Long = 260

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 PathIsNetworkPath Lib "shlwapi.dll" _
   Alias "PathIsNetworkPathA" _
  (ByVal pszPath As String) As Long
  
Private Declare Function PathIsUNC Lib "shlwapi.dll" _
   Alias "PathIsUNCA" _
  (ByVal pszPath As String) As Long
  
Private Declare Function PathStripToRoot Lib "shlwapi.dll" _
   Alias "PathStripToRootA" _
  (ByVal pPath As String) As Long
  
Private Declare Function PathSkipRoot Lib "shlwapi.dll" _
   Alias "PathSkipRootA" _
  (ByVal pPath As String) As Long
  
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" _
  (ByVal RetVal As String, ByVal Ptr As Long) As Long
                        
Private Declare Function lstrlenA Lib "kernel32" _
  (ByVal Ptr As Any) As Long



Private Sub Form_Load()

   Command1.Caption = "Get UNC"
   
End Sub


Private Sub Command1_Click()

   Dim sLocalName As String
   
  'Change to a valid mapped share. The string can
  'be either the drive letter alone, or contain
  'path info below the mapped drive (as shown). 
  'When this is the case, the second routine below
  '(GetUncFullPathFromMappedDrive) returns the 
  'full UNC path including the folders. 
  
   sLocalName = "Z:\target\LabInfo"
   
   Label1.Caption = sLocalName
   Text1.Text = GetUncFromMappedDrive(sLocalName)
   Text2.Text = GetUncFullPathFromMappedDrive(sLocalName)

End Sub

  
Private Function GetUncFromMappedDrive(sLocalName As String) As String

   Dim sLocalRoot As String
   Dim sRemoteName As String
   Dim cbRemoteName As Long
   
   sRemoteName = Space$(MAX_PATH)
   cbRemoteName = Len(sRemoteName)
   
  'get the drive letter 
   sLocalRoot = StripPathToRoot(sLocalName)
   
  'if drive letter is a network share, 
  'resolve the share UNC name 
   If IsPathNetPath(sLocalRoot) Then
      If WNetGetConnection(sLocalRoot, _
                           sRemoteName, _
                           cbRemoteName) = ERROR_SUCCESS Then
         
        'this assures the retrieved name is in
        'fact a valid UNC path. 
         If IsUNCPathValid(sRemoteName) Then
            GetUncFromMappedDrive = TrimNull(sRemoteName)
         End If
         
      End If
   End If
   
End Function


Private Function GetUncFullPathFromMappedDrive(sLocalName As String) As String

   Dim sLocalRoot As String
   Dim sRemoteName As String
   Dim sRemotePath As String
   Dim cbRemoteName As Long
   
   sRemoteName = Space$(MAX_PATH)
   cbRemoteName = Len(sRemoteName)
   
   sLocalRoot = StripPathToRoot(sLocalName)
   
  'modification to the GetUncFromMappedDrive() 
  'routine. Save the path info to a variable for 
  're-adding below.
   sRemotePath = StripRootFromPath(sLocalName)
   
   If IsPathNetPath(sLocalRoot) Then
      If WNetGetConnection(sLocalRoot, _
                           sRemoteName, _
                           cbRemoteName) = ERROR_SUCCESS Then
         
         sRemoteName = QualifyPath(TrimNull(sRemoteName)) & sRemotePath
         
         If IsUNCPathValid(sRemoteName) Then
            GetUncFullPathFromMappedDrive = sRemoteName
         End If
         
      End If
   End If   
End Function


Private Function QualifyPath(spath As String) As String

  'add trailing slash if required
   If Right$(spath, 1) <> "\" Then
      QualifyPath = spath & "\"
   Else
      QualifyPath = spath
   End If
      
End Function


Private Function IsPathNetPath(ByVal spath As String) As Boolean

  'Determines whether a path represents network resource.
   IsPathNetPath = PathIsNetworkPath(spath) = 1

End Function


Private Function IsUNCPathValid(ByVal spath As String) As Boolean

  'Determines if string is a valid UNC
   IsUNCPathValid = PathIsUNC(spath) = 1
   
End Function


Private Function StripPathToRoot(ByVal spath As String) As String

  'Removes all of the path except for
  'the root information (ie drive. Also
  'removes any trailing slash.
   Dim pos As Integer
   
   Call PathStripToRoot(spath)
   
   pos = InStr(spath, Chr$(0))
   If pos Then
      StripPathToRoot = Left$(spath, pos - 2)
   Else
      StripPathToRoot = spath
   End If
      
End Function


Private Function TrimNull(startstr As String) As String

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


Private Function StripRootFromPath(ByVal spath As String) As String

  'Parses a path, ignoring the drive
  'letter or UNC server/share path parts
   StripRootFromPath = TrimNull(GetStrFromPtrA(PathSkipRoot(spath)))
   
End Function


Private Function GetStrFromPtrA(ByVal lpszA As Long) As String

  'Given a pointer to a string, return the string
   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
   
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