Link to home
Start Free TrialLog in
Avatar of caraf_g
caraf_g

asked on

A component for Browse for Folder?

Having hacked away at Shell32.dll 's version of SHBrowseForFolder I'm about
to throw in the towel...

The problem with the above is that
1 - I cannot control where the dialog is going to appear
2 - I cannot set a startup folder, so the thing always pops up with focus on
"My Computer" and everything collapsed.
Apart from that, it just doesn't look nice.

The MSDN Help tantalisingly mentions the above method under the heading of "Browse for a Folder the Non-COM Way", which seems to indicate that there also must be a "Browse for a Folder the COM Way"?

It even mentions it:
"In a later article, you can compare it to the COM way, with a guided tour of SHDOCVW.DLL and the powerful shell features it provides."

Guess what, the "later article" is nowhere to be found. I'm about ready to fly over to Seattle and strangle Bill myself.

Anyone?

I'm not interested in solutions creating a dialog myself with Drive/File and Dir listboxes. The "common dialog" is out there, I want to use it.

Avatar of Juilette
Juilette

you can do it through API using the windows commondialog box..

'using API open commondialogue box and read file content into text box
'
'put this in a bas module
'
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
'
Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustomFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As String
  lpstrFileTitle As String
  nMaxFileTitle As String
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type
'
'
'use in an event
'
' Call the Open File dialog box and look for *.txt files
Dim filebox As OPENFILENAME  ' structure that sets the dialog box
Dim fname As String  ' will receive selected file's name
Dim retval As Long  ' return value

' Configure how the dialog box will look
filebox.lStructSize = Len(filebox)  ' the size of the structure
filebox.hwndOwner = Form1.hWnd  ' handle of the form calling the function
filebox.lpstrTitle = "Open File"  ' text displayed in the box's title bar
' The next line sets up the file types drop-box
filebox.lpstrFilter = "Text Files" & vbNullChar & "*.txt" & vbNullChar & "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
filebox.lpstrFile = Space(255)  ' initalize buffer that receives path and filename of file
filebox.nMaxFile = 255  ' length of file and pathname buffer
filebox.lpstrFileTitle = Space(255)  ' initialize buffer that receives filename of file
filebox.nMaxFileTitle = 255  ' length of filename buffer
' Allow only existing files and hide the read-only check box
filebox.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY

' Execute the dialog box
retval = GetOpenFileName(filebox)
If retval <> 0 Then  ' if the dialog box completed successfully
  ' Remove null space from the file name
  fname = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
  Dim filenum As Integer
  filenum = FreeFile
  Dim strFile As String
'read the file in question and output it's content to text1 textbox
Open fname For Input As #1
Text1.Text = Input(LOF(1), 1)
Close #1
 
  End If
 
CommonDialog1.InitDir = "C:\"
    CommonDialog1.CancelError = True
    CommonDialog1.Filter = "All files(*.*)|*.*"
    CommonDialog1.ShowOpen
Avatar of caraf_g

ASKER

Sorry, Juilette..

I'm looking for Browse For FOLDER, not an Open File dialog!
I'm using this

' Form code, add 1 textbox
Option Explicit

Private Sub Form_Click()
    On Error Resume Next
    Dim strResult As String, prompt As String
    prompt = "Copy modules to Folder: " & Text1.Text
    strResult = BrowseForFolder(hwnd, Text1.Text, prompt)
    If Len(strResult) > 0 Then
        Text1.Text = strResult
    End If
End Sub


' module code
Option Explicit
'common to both methods
Private Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
   "shell32.dll" Alias "SHBrowseForFolderA" _
   (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
   "shell32.dll" Alias "SHGetPathFromIDListA" _
   (ByVal pidl As Long, _
   ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
   (pDest As Any, _
   pSource As Any, _
   ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam  parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'message.
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
   "shell32" Alias "#162" _
   (ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
   (ByVal uFlags As Long, _
   ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
   (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
   (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
   (lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

Private Function BrowseCallbackProcStr(ByVal hwnd As Long, _
   ByVal uMsg As Long, _
   ByVal lParam As Long, _
   ByVal lpData As Long) As Long
   'Callback for the Browse STRING method.
   'On initialization, set the dialog's  'pre-selected folder from the pointer
   'to the path allocated as bi.lParam,
   'passed back to the callback as lpData param.
   Select Case uMsg
   Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
         True, ByVal StrFromPtrA(lpData))
   Case Else:
   End Select
End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, _
   ByVal uMsg As Long, _
   ByVal lParam As Long, _
   ByVal lpData As Long) As Long
   
   'Callback for the Browse PIDL method.
   'On initialization, set the dialog's
   'pre-selected folder using the pidl
   'set as the bi.lParam, and passed back
   'to the callback as lpData param.
   Select Case uMsg
   Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
         False, ByVal lpData)
   Case Else:
   End Select
End Function

Private Function FARPROC(pfn As Long) As Long
   'A dummy procedure that receives and returns
   'the value of the AddressOf operator.
   'Obtain and set the address of the callback
   'This workaround is needed as you can't assign
   'AddressOf directly to a member of a user-
   'defined type, but you can assign it to another
   'long and use that (as returned here)
   FARPROC = pfn
End Function

Private Function StrFromPtrA(lpszA As Long) As String
   'Returns an ANSII string from a pointer to an ANSII string.
   Dim sRtn As String
   sRtn = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal sRtn, ByVal lpszA)
   StrFromPtrA = sRtn
End Function

Public Function BrowseForFolder(hwndOwner As Long, sSelPath As String, sPrompt As String) As String
   Dim BI As BROWSEINFO
   Dim pidl As Long
   Dim lpSelPath As Long
   Dim sPath As String * MAX_PATH
   With BI
      .hOwner = hwndOwner
      .pidlRoot = 0
      .lpszTitle = sPrompt
      .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
      lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
      MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
      .lParam = lpSelPath
   End With
   pidl = SHBrowseForFolder(BI)
   If pidl Then
      If SHGetPathFromIDList(pidl, sPath) Then
         BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
      End If
      Call CoTaskMemFree(pidl)
   End If
   Call LocalFree(lpSelPath)
End Function
shlwapi.dll: useful functions
http://codeguru.developer.com/bbs/wt/showpost.pl?Board=vb&Number=9201&page=1&view=collapsed&sb=5
>>>
I've also added a couple of extra calls to the class module (StripToRoot, Compact (eg. c:\.....\test.exe) and StripExtension)

- I just can't believe that I've missed this functionality for so long !, time to rewrite lot's of old legacy code I think !
<<<
ameba wrote:
>shlwapi.dll: useful functions
but you mentioned the other sh... dll
>with a guided tour of SHDOCVW.DLL

Sorry.
Avatar of caraf_g

ASKER

Ok, Ameba... excellent so far...

How can I make the dialog appear in a particular location rather than where it wants to?
ASKER CERTIFIED SOLUTION
Avatar of ameba
ameba
Flag of Croatia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of caraf_g

ASKER

Exactly, that's what I'm trying to avoid...

I've also posted this in devx, and some guy just came back with this comment:

"You need to pass a callback procedure in the .pFunc element of your
structure. Then, in the callback, you'll receive the message
BFFM_INITIALIZED. You can use this message to move the window
whereever you want it."

Does that make sense to you?
Avatar of caraf_g

ASKER

<doh>

Just use MoveWindow API in the callback routine. Gotcha!
Avatar of caraf_g

ASKER

;-)
caraf_g,

Take a look at the following references:

HOWTO: Browse for Folders from the Current Directory
http://support.microsoft.com/support/kb/articles/Q179/3/78.ASP 

Browse for a Folder the COM Way
http://msdn.microsoft.com/library/periodic/period99/html/08vcd/vc99h8.htm 
 
Browse for a Folder the Non-COM Way
http://msdn.microsoft.com/library/periodic/period99/html/vc99c1.htm 
 
HOWTO: Select a Directory Without the Common Dialog Control
http://support.microsoft.com/support/kb/articles/Q179/4/97.ASP 


Cheers!

Avatar of caraf_g

ASKER

mcrider, thanks for your references.

Just a quick question; how do you manage to find these? I find searching microsoft.com a nightmare, and I can't seem to be able to find what I'm looking for?
I use this URL as a starting point:

http://search.microsoft.com/us/dev/?MSCOMTB=ICP_SEARCH%20MSDN 

Then I enable searching of "Additional Developer Content", "Knowledge Base",
and "Product Information"

This basically searches the entire online developers network...

Cheers!
Avatar of caraf_g

ASKER

Yes, I've been there too. So the only conclusion is that somehow I must not be able to phrase my searches correctly. What search criteria did you enter to come up with the above list?
Avatar of caraf_g

ASKER

In the mean time, back at the ranch...

ameba, I've modified your code slightly, so now in the browseforfolder procedure you pass in an "Owner" window and a relative Left and Top position. The Browse For Folder dialog is then positioned nicely.

Modified code:

(.bas Module)

Option Explicit

'common to both methods
Private Type BROWSEINFO
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
   "shell32.dll" Alias "SHBrowseForFolderA" _
   (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
   "shell32.dll" Alias "SHGetPathFromIDListA" _
   (ByVal pidl As Long, _
   ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
   (pDest As Any, _
   pSource As Any, _
   ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam  parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'message.
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
   "shell32" Alias "#162" _
   (ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
   (ByVal uFlags As Long, _
   ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
   (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
   (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
   (lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private mlngLeft As Long
Private mlngTop As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Function BrowseCallbackProcStr(ByVal hwnd As Long, _
   ByVal uMsg As Long, _
   ByVal lParam As Long, _
   ByVal lpData As Long) As Long
   'Callback for the Browse STRING method.
   'On initialization, set the dialog's  'pre-selected folder from the pointer
   'to the path allocated as bi.lParam,
   'passed back to the callback as lpData param.
   Dim orgPos As RECT
   
   Select Case uMsg
   Case BFFM_INITIALIZED
      GetWindowRect hwnd, orgPos
      MoveWindow hwnd, mlngLeft, mlngTop, orgPos.Right - orgPos.Left, orgPos.Bottom - orgPos.Top, True
      Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
         True, ByVal StrFromPtrA(lpData))
   Case Else:
   End Select
End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, _
   ByVal uMsg As Long, _
   ByVal lParam As Long, _
   ByVal lpData As Long) As Long
   
   'Callback for the Browse PIDL method.
   'On initialization, set the dialog's
   'pre-selected folder using the pidl
   'set as the bi.lParam, and passed back
   'to the callback as lpData param.
   Select Case uMsg
   Case BFFM_INITIALIZED
      Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
         False, ByVal lpData)
   Case Else:
   End Select
End Function

Private Function FARPROC(pfn As Long) As Long
   'A dummy procedure that receives and returns
   'the value of the AddressOf operator.
   'Obtain and set the address of the callback
   'This workaround is needed as you can't assign
   'AddressOf directly to a member of a user-
   'defined type, but you can assign it to another
   'long and use that (as returned here)
   FARPROC = pfn
End Function

Private Function StrFromPtrA(lpszA As Long) As String
   'Returns an ANSII string from a pointer to an ANSII string.
   Dim sRtn As String
   sRtn = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal sRtn, ByVal lpszA)
   StrFromPtrA = sRtn
End Function

Public Function BrowseForFolder(objOwner As Object, _
                                sSelPath As String, _
                                sPrompt As String, _
                                lngLeft As Long, _
                                lngTop As Long) As String
   Dim BI As BROWSEINFO
   Dim pidl As Long
   Dim lpSelPath As Long
   Dim sPath As String * MAX_PATH
   Dim lngAO As Long
   Dim lngScaleBorder As Long
   
   Dim objWork As Object
   Set objWork = objOwner
   
   mlngTop = lngTop
   mlngLeft = lngLeft
   On Error Resume Next
   Do While True
      lngScaleBorder = (objWork.Width - objWork.ScaleWidth) / 2
      mlngTop = mlngTop + objWork.Top + objWork.Height - objWork.ScaleHeight - lngScaleBorder
      mlngLeft = mlngLeft + objWork.Left + lngScaleBorder
      If objWork.Container Is Nothing Then
        Exit Do
      End If
      Set objWork = objWork.Container
   Loop
   mlngTop = (mlngTop + lngTop) / Screen.TwipsPerPixelY
   mlngLeft = (mlngLeft + lngLeft) / Screen.TwipsPerPixelX
   With BI
      .hOwner = objOwner.hwnd
      .pidlRoot = 0
      .lpszTitle = sPrompt
      .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
      lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
      MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
      .lParam = lpSelPath
   End With
   pidl = SHBrowseForFolder(BI)
   If pidl Then
      If SHGetPathFromIDList(pidl, sPath) Then
         BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
      End If
      Call CoTaskMemFree(pidl)
   End If
   Call LocalFree(lpSelPath)
End Function


one word search: SHBrowseForFolder

You should get about 29 hits.

Cheers!
Avatar of caraf_g

ASKER

..and the code in the form. I added a picture box on it so I could choose between either the form or the picturebox as the "owner" of the dialog, by commenting one or the other line out.

' module code
Option Explicit
Private Sub Form_Click()
    On Error Resume Next
    Dim strResult As String, prompt As String
    prompt = "Copy modules to Folder: " & Text1.Text
    'strResult = BrowseForFolder(Me, Text1.Text, prompt, 0, 0)
    strResult = BrowseForFolder(Picture1, Text1.Text, prompt, 0, 0)
    If Len(strResult) > 0 Then
        Text1.Text = strResult
    End If
End Sub

Thanks for your points.
I keep this out of my projects as black box. Now I know where to go to update my dll.
Avatar of caraf_g

ASKER

ameba,

I have another question.

In the code the following values are defined
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)

I'm currently using NT but I'm using BFFM_SETSELECTIONA

BFFM_SETSELECTIONW is used in Unicode (?) How do I know when I need to use one rather than the other?
I use Win95 and BFFM_SETSELECTIONA.
I don't think you will ever need BFFM_SETSELECTIONW.

Another sample for Browse dialog
http://www.mvps.org/btmtz/
Hello,
I am not sure if this will get anyone sent an email, I hope so.  Awarding points are no problem, but I wanted to give this to you guys first so since I have been reading your post here.  I have been struggling SHBrowseForFolder for a little while now.  I am afraid I know the answer to my question, but you guys seem to be in the know on this stuff so I thought I would ask.  I have used several samples from around the web and they work great except doing exactly what I need done.  I want to browse a particular directory structure on a REMOTE computer.  I have the callback working, but if I put, for example, "\\Remote Computer\"  the directory structure comes back with the Network Neighborhood Root directory!  If I do a local directory like "C:\Program Files\" then it works.  Can you guys help me solve this one?
Kevin
You most likely need to create a share on the remote computer and add it to the directory structure you want to view.  For example,

\\Remote Computer\ShareName

Or if the user has sufficient rights, you could use the administrative share...

\\Remote Computer\c$

Note that you may need to create a share (above called "Share Name").  In NT, this is done by right clicking on a directory, selecting properties, and then selecting the "Sharing" tab.  This dialog allows you to create a share.
Good point, but I tried that.  I have Admin rights on the remote machine that I am working with, but still no luck.  I can use the Common Dialog control and get into the Directory structure that way, so I don't think it is a network thing, I would use the Common Dialog control to do this, but I want to provide a way for the User to select a directory not a file.