Récupérer le nom unc en vb5/6

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 983 fois - Téléchargée 35 fois

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.

Du même auteur (Matesys)