SNTT - the Win32 API series - Getting the UNC path from a mapped drive letter

Someone in the developerWorks Lotus forum asked how to get the UNC path from a mapped drive letter. It turns out it's not exceedingly difficult, but it's not a trivial task, either. The following not only retrieves the path, but ensures it is valid and properly formatted.

Option Public
Option Declare

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Adapted from sample code by Randy Birch, http://vbnet.mvps.org
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const ERROR_SUCCESS = 0
Const MAX_PATH  = 260

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

Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathA"_
(Byval pszPath As String) As Long

Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCA"  _
(Byval pszPath As String) As Long

Declare Function PathStripToRoot Lib "shlwapi.dll"  Alias "PathStripToRootA"  _
(Byval pPath As String) As Long

Declare Function PathSkipRoot Lib "shlwapi.dll"  Alias "PathSkipRootA" _
(Byval pPath As String) As Long

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

Sub Initialize
    Msgbox GetUncFullPathFromMappedDrive("Z:")
End Sub

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 PathIsNetworkPath(sLocalRoot) = 1 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 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 StripRootFromPath(Byval spath As String) As String
   
    'Parses a path, ignoring the drive
    'letter or UNC server/share path parts
    'You need to use a separate function
    'because the API call modifies the value
    'you pass to it.
    StripRootFromPath = TrimNull(GetStrFromPtrA(PathSkipRoot(spath)))
   
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 IsUNCPathValid(Byval spath As String) As Boolean
   
  'Determines if string is a valid UNC
    IsUNCPathValid = PathIsUNC(spath) = 1
   
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

Private Function TrimNull(startstr As String) As String
    Dim lFound As Long
   
    lFound = Instr(1, startstr, Chr$(0))
    If  lFound > 0 Then
        TrimNull = Left$(startstr, lFound - 1)
    Else
        TrimNull = startstr
    End If
   
End Function

This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.