What you're trying to do is kind of complicated. :-) Here is the code to do it, but it would be best if you took some time to study it and read up on the API calls that are used so you really understand what is going on. You can paste the following into an agent.
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
Return to top
. . RE: Local Network Drive Letter to U... (Charles E. Robi... 25.Aug.07) 
Print this page
