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