Salut,

Je migre un code vb6 en vb.net, et j'utilise l'api SHBrowseForFolder pour choisir un dossier. Cette api fonctionne avec la structure BrowseInfo tel qu'expliqué dans ce post de 2005 à ce sujet mais sous ACCESS, donc vb6 grosso modo :

http://www.developpez.net/forums/d25...rtoire-racine/

C'est la façon dont mon code est fait en vb6 et il fonctionne parfaitement (avec repertoire par défaut grace à fonction callback)

Je tente cependant desespérément de migrer ça en vb.net, je suis passé par le système de delegate en lieu et place de adressof mais sans résultat.

Voici mon code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Strict Off
Option Explicit On
Module mdlFolder
 
	Delegate Function BrowseCallbackProcDlg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
 
    Private Structure BrowseInfo
        Dim hWndOwner As Long
        Dim pIDLRoot As Long
        Dim pszDisplayName As Long
        Dim lpszTitle As String
        Dim ulFlags As Long
        Dim lpfnCallback As BrowseCallbackProcDlg
        Dim lParam As Long
    End Structure
 
    Private Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (ByRef lpBrowseInfo As BrowseInfo) As Long
    Private Declare Function SHGetIDListFromPath Lib "SHELL32.DLL" Alias "#162" (ByVal szPath As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
 
    Public Function GetFolderName(ByRef lngHandle_I As Long, ByVal strDefaultDirectory_I As String) As String
    Dim lngIDList As Long
    Dim strBuffer As String
    Dim tBrowseInfo As new BrowseInfo()
    Dim dlgCallBack As BrowseCallbackProcDlg
    Const BIF_RETURNONLYFSDIRS As Short = 1
 
        GetFolderName = ""
 
        'Initialisation de la structure
        dlgCallBack = new BrowseCallbackProcDlg(AddressOf BrowseCallbackProc)
        With tBrowseInfo
        	.hWndOwner = lngHandle_I
        	.lpszTitle = "Sélectionner le répertoire"
        	.ulFlags = BIF_RETURNONLYFSDIRS
        	.lpfnCallback = dlgCallBack
			.lParam = SHGetIDListFromPath(Convert.ToString(strDefaultDirectory_I))
        End With
 
         'Affichage de la fenêtre de sélection du répertoire
        lngIDList = SHBrowseForFolder(tBrowseInfo)
 
         'Récupération du répertoire sélectionné
        If lngIDList Then
        	strBuffer = Space(512)
        	SHGetPathFromIDList(lngIDList, strBuffer)
        	GetFolderName = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
        End If
    End Function
 
    Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    Const BFFM_INITIALIZED As Short = 1
    Const WM_USER As Long = &H400
    Const BFFM_SETSELECTIONA As Decimal = (WM_USER + 102)
 
        If uMsg = BFFM_INITIALIZED Then Call SendMessage(hWnd, BFFM_SETSELECTIONA, 0, lpData)
    End Function
End Module
La dialog box se lance bien, mais à aucun moment elle ne passe dans BrowseCallbackProc (point d'arret)

si vous avez une idée ...

merci, bonne journée
seb