Code - Visual Basic Research Center

~ Edito ~

12/03/2006 @ 13:39
Depuis la dernière mise à jour (qui remonte à... oulala plusieurs mois), un petit ménage de printemps s'impose. Ca tombe bien, c'est presque la période.
Au menu, et progressivement sur les jours à venir, rafraîchissement de plusieurs fonctions et procédures, nouvelles APIs et nouveaux programmes.

~ Rechercher ~

~ Annuaire VB ~

~ Partenaires ~

Retour à la liste des fonctions

Fonction : GetDirectory
Affiche une fenêtre de sélection de répertoire en utilisant les API.
(Consulté 20245 fois.)

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
         (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
         (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type

Public Function GetDirectory(stTitre As String) As String
' Cette fonction permet de récupérer un chemin de répertoire.
Dim stTmp As String
Dim biStruct As BrowseInfo
Dim lgRep As Long
' On passe le handle de la fenêtre appellante (ici on suppose que c'est la fenêtre courante).
biStruct.hWndOwner = Me.hwnd
' On utilise lstrcat pour récupérer un pointeur sur une chaîne.
biStruct.lpszTitle = lstrcat(stTitre, vbNullString)
biStruct.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
' Affichage de la fenêtre de sélection.
lgRep = SHBrowseForFolder(biStruct)
If lgRep Then
    stTmp = Space$(MAX_PATH)
' On récupère le répertoire choisit.
    SHGetPathFromIDList lgRep, stTmp
    stTmp = Left$(stTmp, InStr(stTmp, vbNullChar) - 1)
Else
    stTmp = vbNullString
End If
' Retourne la valeur (ou un chaîne vide en cas d'erreur).
GetDirectory = stTmp
End Function

Retour à la liste des fonctions