Here is a routine taken from Randy Birch's site, just de-formed, which will
return the UNC name for you
Option
Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2004 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'--end block--'
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
dumbass said:
Hi-
is there any way to write below code without the drive letter so that
users who have a network drived mapped to different drive letters will
always be able to open it? For instance, I have a shared drive named
ahfcsharedfiles on 'ahfctor01'.
