Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 168 fois - Téléchargée 35 fois
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.