0

Now I trying to write a Fortran code which can display a dialog for selecting a directory by using SHBrowseForFolder. However I don't know the procedure to change the initial directory in SHBrowseForFolder. Doesn't someone know that for Fortran? My current Fortran code is as shown below.

program selectFolder
  use ifwinty
  use ifcom, only: COMInitialize, COMUnInitialize
  implicit none
  integer, parameter :: BIF_RETURNONLYFSDIRS  = Z'00000001'
  integer, parameter :: BIF_DONTGOBELOWDOMAIN = Z'00000002'
  integer,parameter :: BIF_STATUSTEXT         = Z'00000004'
  integer,parameter :: BIF_RETURNFSANCESTORS  = Z'00000008'
  integer,parameter :: BIF_EDITBOX            = Z'00000010'
  integer,parameter :: BIF_VALIDATE           = Z'00000020'
  integer,parameter :: BIF_NEWDIALOGSTYLE     = Z'00000040'
  integer,parameter :: BIF_USENEWUI           = ior(BIF_NEWDIALOGSTYLE,BIF_EDITBOX)
  integer,parameter :: BIF_BROWSEINCLUDEURLS  = Z'00000080'
  integer,parameter :: BIF_UAHINT             = Z'00000100'
  integer,parameter :: BIF_NONEWFOLDERBUTTON  = Z'00000200'
  integer,parameter :: BIF_NOTRANSLATETARGETS = Z'00000400' 
  integer,parameter :: BIF_BROWSEFORCOMPUTER  = Z'00001000'
  integer,parameter :: BIF_BROWSEFORPRINTER   = Z'00002000'
  integer,parameter :: BIF_BROWSEINCLUDEFILES = Z'00004000'
  integer,parameter :: BIF_SHAREABLE          = Z'00008000'
  integer,parameter :: BFFM_INITIALIZED       = 1

  type :: t_browseinfo  
!    sequence
    integer(HANDLE) :: hwndOwner = NULL
    integer(LPINT)  :: pidlRoot  = NULL
    integer(LPSTR)  :: pszDisplayName 
    integer(LPCSTR) :: lpszTitle  
    integer(UINT)   :: ulFlags = BIF_RETURNONLYFSDIRS
    integer(UINT)   :: lpfn = NULL 
    integer(HANDLE) :: lParam = 0
    integer         :: iImage = 0
  end type t_browseinfo
  type(t_browseinfo) :: test

  interface
    integer function SHBrowseForFolder(t)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHBrowseForFolder' :: SHBrowseForFolder
      import
      integer(LPINT), intent(in) :: t
    end function SHBrowseForFolder

    integer function SHGetPathFromIDList(pidl, pszPath)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHGetPathFromIDList' :: SHGetPathFromIDList
      import
      integer(LPINT), intent(in) :: pidl
      integer(LPINT), intent(in) :: pszPath
    end function SHGetPathFromIDList

    integer function CoTaskMemFree(pv)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'CoTaskMemFree' :: CoTaskMemFree
      import
      integer(LPINT), intent(in) :: pv
    end function CoTaskMemFree
  end interface

  character(len = *), parameter :: msg = "Select a directory!"C
  character(len = 512) :: buff, path
  integer(LPINT) :: status
  integer(BOOL)  :: iret
! 
  test%lpszTitle = loc(msg)
  test%pszDisplayName = loc(buff)
  status = SHBrowseForFolder(loc(test))
!  print *, 'status=', status
  if (status /= 0) then
    iret = SHGetPathFromIDList(status, loc(path))
    print *, path(:index(path, ""C))
    print *, buff(:index(buff, ""C))
    iret = CoTaskMemFree(status)
  else
    print *, 'No directory was selected !!'
  end if  
end program selectFolder
kachigusa
  • 219
  • 1
  • 9
  • What is `SHBrowseForFolder`? Where does it come from? Can you use the non-standard `CHDIR()`? https://gcc.gnu.org/onlinedocs/gfortran/CHDIR.html or https://software.intel.com/en-us/fortran-compiler-developer-guide-and-reference-chdir – Vladimir F Героям слава Jan 15 '19 at 13:55
  • Or a possibly https://stackoverflow.com/questions/26730836/change-of-directory-in-fortran-in-a-non-compiler-specific-way But I am really not sure it is what you need. Again, what is SHBrowseForFolder? Where does it come from and what it does? What is the "initial directory"? – Vladimir F Героям слава Jan 15 '19 at 13:58
  • 1
    Possible duplicate? https://stackoverflow.com/questions/17471771/force-shbrowseforfolder-to-show-desired-directory – Vladimir F Героям слава Jan 15 '19 at 14:17
  • 1
    @VladimirF [`SHBrowseForFolder()`](https://learn.microsoft.com/en-us/windows/desktop/api/shlobj_core/nf-shlobj_core-shbrowseforfoldera) is a Microsoft Win32 API function. It is a system dialog UI for letting a user select a folder. – Remy Lebeau Jan 15 '19 at 16:13
  • 1
    You need to be able to use a callback function (passed in the `lpfn` parameter); it will be called in response to the "initialized" message and needs to respond by sending a "set selection" message back to the dialog. Can you do that sort of thing from Fortran? – Jonathan Potter Jan 15 '19 at 19:17
  • `SHBrowseForFolder` is an outdated API with bad usability. The recommended API is `IFileOpenDialog` in folder picker mode (`FOS_PICKFOLDERS`). – zett42 Jan 15 '19 at 22:42
  • @zett42 `IFileOpenDialog` is C++ only. @Jonathan Potter, yes, Fortran can pass callback functions. I have always used `GetOpenFileName` for this - it is easily usable from Fortran. – Steve Lionel Jan 16 '19 at 01:54
  • Thank you very much for your useful comments and advices. @Steve Lionel, I could understand the need of a callback function to this Win32 API. But I don't know the way to write the callback function for this API in fortran style. I cannot find a good example in fortran, althogh there are many C style examples. If it is possible, could you show me simple fortran code? Or, could you modifiy my fortran code? I'm really sorry for bothering you. – kachigusa Jan 16 '19 at 03:10
  • Implement [BFFCALLBACK function](https://msdn.microsoft.com/en-us/e9109f38-34c7-46c0-aa0c-a6b4570f1c3a) and send `BFFM_SETSELECTION` when handling `BFFM_INITIALIZED` message. I do not know how it works in Fortran, maybe [Calling the Windows API](http://www.lahey.com/docs/lfpro78help/F95UGMLPDLLWinAPI.htm) could help. – Daniel Sęk Jan 16 '19 at 08:43
  • @Steve `IFileOpenDialog` is a COM API that can be used from a wide variety of languages, even non-object-oriented ones, like C. And it doesn't require callbacks for simple tasks like setting the initial directory. – zett42 Jan 16 '19 at 09:04
  • I added an answer with a complete example. – Steve Lionel Jan 16 '19 at 16:38

1 Answers1

3

Here is a modified version of your program that does what you want. Note the addition of the BrowseCallbackFunction that sends the BFFM_SETSELECTION message as @Daniel Sęk suggests. I didn't add calls to ComInitialize and ComUnIntialize, which the MS docs recommend (I see them mentioned in a USE but you don't call them.)

program selectFolder
  use ifwinty
  use ifcom, only: COMInitialize, COMUnInitialize
  implicit none
  integer, parameter :: BIF_RETURNONLYFSDIRS  = Z'00000001'
  integer, parameter :: BIF_DONTGOBELOWDOMAIN = Z'00000002'
  integer,parameter :: BIF_STATUSTEXT         = Z'00000004'
  integer,parameter :: BIF_RETURNFSANCESTORS  = Z'00000008'
  integer,parameter :: BIF_EDITBOX            = Z'00000010'
  integer,parameter :: BIF_VALIDATE           = Z'00000020'
  integer,parameter :: BIF_NEWDIALOGSTYLE     = Z'00000040'
  integer,parameter :: BIF_USENEWUI           = ior(BIF_NEWDIALOGSTYLE,BIF_EDITBOX)
  integer,parameter :: BIF_BROWSEINCLUDEURLS  = Z'00000080'
  integer,parameter :: BIF_UAHINT             = Z'00000100'
  integer,parameter :: BIF_NONEWFOLDERBUTTON  = Z'00000200'
  integer,parameter :: BIF_NOTRANSLATETARGETS = Z'00000400' 
  integer,parameter :: BIF_BROWSEFORCOMPUTER  = Z'00001000'
  integer,parameter :: BIF_BROWSEFORPRINTER   = Z'00002000'
  integer,parameter :: BIF_BROWSEINCLUDEFILES = Z'00004000'
  integer,parameter :: BIF_SHAREABLE          = Z'00008000'
  integer,parameter :: BFFM_INITIALIZED       = 1


  type, bind(C) :: t_browseinfo  
   ! sequence
    integer(HANDLE) :: hwndOwner = NULL
    integer(LPINT)  :: pidlRoot  = NULL
    integer(LPSTR)  :: pszDisplayName 
    integer(LPCSTR) :: lpszTitle  
    integer(UINT)   :: ulFlags = BIF_RETURNONLYFSDIRS
    integer(LPVOID)   :: lpfn = NULL 
    integer(HANDLE) :: lParam = 0
    integer         :: iImage = 0
  end type t_browseinfo
  type(t_browseinfo) :: test

  interface
    integer(LPINT) function SHBrowseForFolder(t)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHBrowseForFolder' :: SHBrowseForFolder
      import
      integer(LPINT), intent(in) :: t
    end function SHBrowseForFolder

    integer(BOOL) function SHGetPathFromIDList(pidl, pszPath)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHGetPathFromIDList' :: SHGetPathFromIDList
      import
      integer(LPINT), intent(in) :: pidl
      integer(LPINT), intent(in) :: pszPath
    end function SHGetPathFromIDList

    integer function CoTaskMemFree(pv)
      !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'CoTaskMemFree' :: CoTaskMemFree
      import
      integer(LPINT), intent(in) :: pv
    end function CoTaskMemFree
  end interface

  character(len = *), parameter :: msg = "Select a directory!"C
  character(len = 512) :: buff, path
  integer(LPINT) :: status
  integer(BOOL)  :: iret

  character(len = *), parameter :: initial_folder = "C:\\Windows"C
! 
  test%lpszTitle = loc(msg)
  test%pszDisplayName = loc(buff)
  test%lpfn = loc(BrowseCallbackProc)
  test%lparam = loc(initial_folder)
  status = SHBrowseForFolder(loc(test))
!  print *, 'status=', status
  if (status /= 0) then
    iret = SHGetPathFromIDList(status, loc(path))
    print *, path(:index(path, ""C))
    print *, buff(:index(buff, ""C))
    iret = CoTaskMemFree(status)
  else
    print *, 'No directory was selected !!'
  end if  

    contains

    function BrowseCallbackProc (hwnd,umsg,lparam,lpdata)
    use user32, only: SendMessage
    implicit none
    integer(UINT) :: BrowseCallbackProc
    !DEC$ ATTRIBUTES STDCALL :: BrowseCallbackProc
    integer(HANDLE), intent(in) :: hwnd
    integer(UINT), intent(in) :: umsg
    integer(fLPARAM), intent(in) :: lparam, lpdata

    ! message from browser
    integer, parameter :: BFFM_INITIALIZED        = 1
    integer, parameter :: BFFM_SELCHANGED         = 2
    integer, parameter :: BFFM_VALIDATEFAILEDA    = 3   ! lParam:szPath ret:1(cont),0(EndDialog)
    integer, parameter :: BFFM_VALIDATEFAILEDW    = 4   ! lParam:wzPath ret:1(cont),0(EndDialog)
    integer, parameter :: BFFM_IUNKNOWN           = 5   ! provides IUnknown to client. lParam: IUnknown*
    ! messages to browser
    integer, parameter :: BFFM_SETSTATUSTEXTA     = (WM_USER + 100)
    integer, parameter :: BFFM_ENABLEOK           = (WM_USER + 101)
    integer, parameter :: BFFM_SETSELECTIONA      = (WM_USER + 102)
    integer, parameter :: BFFM_SETSELECTIONW      = (WM_USER + 103)
    integer, parameter :: BFFM_SETSTATUSTEXTW     = (WM_USER + 104)
    integer, parameter :: BFFM_SETOKTEXT          = (WM_USER + 105) ! Unicode only
    integer, parameter :: BFFM_SETEXPANDED        = (WM_USER + 106) ! Unicode only

    integer(LRESULT) :: ret

    if (uMsg==BFFM_INITIALIZED) ret = SendMessage(hwnd, BFFM_SETSELECTIONA, TRUE, lpData)
    BrowseCallbackProc = 0
    end function BrowseCallbackProc

    end program selectFolder
Steve Lionel
  • 6,972
  • 18
  • 31
  • I really thank you for your helpful comment and modified program. I'm sorry for my delayed response. Now I tryed to compile it together with shell32.lib and ole32.lib, and I probably got its correct executable file. However, an access violation error ocuured. If I comment line 68 out (although this means the omitting of your modifiecation), this error does not shown. I'm very afraid of asking this kind of basic question, but what do you thincking about this error? – kachigusa Jan 18 '19 at 09:02
  • You had multiple errors in how you declared things, so that it worked in 32-bit but not 64-bit. I made corrections above. – Steve Lionel Jan 19 '19 at 01:20