Cette routine permet, sous VB5/VB6 de récupérer le chemin UNC d'un lecteur réseau passé en paramètre.
Source / Exemple :
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, ByVal lpBuffer As Long, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
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 CopyPointer2String Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As String, ByVal OldString As Long) As Long
Private Declare Function CopyString2Pointer Lib "kernel32" Alias "lstrcpyA" (ByVal NewString As Long, ByVal OldString As String) As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Public Function GetUNCFullPathFromMappedDrive(pLocalName As String) As String
Dim sLocalRoot As String
Dim sRemoteName As String
Dim sRemotePath As String
Dim cbRemoteName As Long
sRemoteName = Space(255)
cbRemoteName = Len(sRemoteName)
sLocalRoot = StripPathToRoot(pLocalName)
sRemotePath = StripRootFromPath(pLocalName)
If IpPathNetPath(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 Function
Public Function QualifyPath(pPath As String) As String
If Right(pPath, 1) <> "\" Then
QualifyPath = pPath & "\"
Else
QualifyPath = pPath
End If
End Function
Private Function IpPathNetPath(ByVal pPath As String) As Boolean
'Vérifie que pPath est bien un chemin réseau
IpPathNetPath = PathIsNetworkPath(pPath) = 1
End Function
Private Function IsUNCPathValid(ByVal pPath As String) As Boolean
'Vérifie que pPath est bien un UNC valide
IsUNCPathValid = PathIsUNC(pPath) = 1
End Function
Private Function StripPathToRoot(ByVal pPath As String) As String
'Garde uniquement la lettre de l'unité de pPath
Dim pos As Long
Call PathStripToRoot(pPath)
pos = InStr(pPath, Chr(0))
If pos Then
StripPathToRoot = Left(pPath, pos - 2)
Else
StripPathToRoot = pPath
End If
End Function
Private Function TrimNull(pStartPos As String) As String
TrimNull = Left(pStartPos, lstrlenW(StrPtr(pStartPos)))
End Function
Private Function StripRootFromPath(ByVal pPath As String) As String
'Renvoie l'arborescence sous la lettre correspondant au mappage
StripRootFromPath = TrimNull(GetStrFromPtrA(PathSkipRoot(pPath)))
End Function
Private Function GetStrFromPtrA(ByVal pPointerA As Long) As String
'Renvoie la chaîne correspondant au pointeur passé en paramètre
GetStrFromPtrA = String(lstrlenA(ByVal pPointerA), 0)
Call CopyPointer2String(ByVal GetStrFromPtrA, ByVal pPointerA)
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.