Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Browse for folder

algraham
Beginner
7,694 Views
Hello,
I am new to IVF and I am attempting to display a BrowseForFolder dialog. I downloaded some code from the IVF forum (CmnDlgChooseFolder sample code posted by Paul-Curtis 02-24-2005) but I am having a couple of problems with it.
1. It calls CoTaskMemFree to free the memory allocated by the SHBrowseForFolder function. However CoTaskMemFree generates an unresolved exrernal error, even though I have the "use ole32" statement, in placeand I have added ole32.lib to the list of default libraries for the linker. I noticed that ole32.f90 does not include an interface for CoTaskMemFree, and so I have tried to create my own interface, but I can't get it right. Does anyone know how to use these functions correctly? Or is there another way to free the memory?
2. My BrowseForFolder dialog displays behind all other windows, instead of on top. Any idea why that would happen?
Help would begreatly appreciated - thanks very much.
0 Kudos
30 Replies
alexeyam
Beginner
2,368 Views
I have read this note and initializedCoInitializeExwith flagCOINIT_APARTMENTTHREADED.
Also, if I useBIF_NEWDIALOGSTYLE, I get an option of creating new folder, that is important for me.
By the way, code showed another spurious behavior. In order to work with it in separate project I created a simple dialog project (which IVF creates by default) and added in it this function (connecting to one of the buttons). And... it stopped compling. Compiler reported about errors:
Error 3 error LNK2019: unresolved external symbol _SHSimpleIDListFromPath@4 referenced in function _BROWSEFORFOLDER Modules.obj
Error 4 error LNK2019: unresolved external symbol _SHBrowseForFolderA@4 referenced in function _BROWSEFORFOLDER Modules.obj
Error 5 error LNK2019: unresolved external symbol _SHGetPathFromIDListA@8 referenced in function _BROWSEFORFOLDER Modules.obj
Here is all code. All functions are defined in it.
SUBROUTINE OPEN_RES_FOLDER( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: OPEN_RES_FOLDER
use iflogm
use comdlg32
use user32
use Input_dialogGlobals
implicit none
INCLUDE 'RESOURCE.FD'
type (dialog) dlg
integer id, callbacktype
LOGICAL status, BROWSEFORFOLDER
CHARACTER dir*512
INTEGER ires
status = BROWSEFORFOLDER(dir)
!ires = MessageBox (GetForegroundWindow(), TRIM(dir) , ''c ,MB_ICONWARNING )
END SUBROUTINE OPEN_RES_FOLDER
LOGICAL Function BROWSEFORFOLDER(dir)
use browsefolder
USE ifwinty
use ExtraWinTy
USE user32
USE kernel32
implicit none
character*(*) dir
integer lpIDList, iret
INTEGER(4) itemidlistptr, initdirptr
CHARACTER(511) initdir
TYPE(T_BROWSEINFO) BI
CHARACTER(256) STARTPATH1
INTEGER(2) UCPATH1(512)
INTEGER IACP, IBYTESNEED, IBYTESWRITTEN,IWIDE
!INTEGER ITEMIDLISTPTR
STARTPATH1="e:\\Data"//CHAR(0) ! Must be a null-terminated string
UCPATH1=0
IACP=GetACP() ! get the code page in use
IWIDE=0
! find out how many bytes are needed...
IBYTESNEED=MultiByteToWideChar(IACP, 0, STARTPATH1,-1,UCPATH1, IWIDE)
!..then write them to UCPATH1..
IBYTESWRITTEN=MultiByteToWideChar(IACP, 0, STARTPATH1,-1,UCPATH1, IBYTESNEED)
UCPATH1(IBYTESWRITTEN+1)=0 ! terminate with an added zero
ITEMIDLISTPTR=SHSimpleIDListFromPath (LOC(UCPATH1))
bi.hwndOwner = GetForegroundWindow()
bi.pidlRoot = ITEMIDLISTPTR !NULL !Starts with Workspace
bi.pszDisplayName = LOC(Dir)
bi.lpszTitle = LOC("Please select directory:"C)
bi.ulFlags = BIF_RETURNONLYFSDIRS .XOR. BIF_NEWDIALOGSTYLE
bi.lpfn = 0
bi.lParam = 0
bi.iImage = 0
iret = CoInitializeEx (NULL, COINIT_APARTMENTTHREADED ) ! Needed for BIF_NEWDIALOGSTYLE flag
lpIDList = SHBrowseForFolder(bi)
IF (lpIDList.ne.0) THEN
BrowseForFolder = SHGetPathFromIDList (lpIDList, dir)
else
BrowseForFolder = .false.
END IF
CALL CoUninitialize () ! Needed for CoInitializeEx
return
end function
MODULE ExtraWinTy
USE ifwinty
integer, parameter :: BIF_RETURNONLYFSDIRS = #00000001 ! For finding a folder to start document searching
integer, parameter :: BIF_DONTGOBELOWDOMAIN = #00000002 ! For starting the Find Computer
integer, parameter :: BIF_STATUSTEXT = #00000004
integer, parameter :: BIF_RETURNFSANCESTORS = #00000008
integer, parameter :: BIF_EDITBOX = #00000010
integer, parameter :: BIF_BROWSEFORCOMPUTER = #00001000 ! Browsing for Computers.
integer, parameter :: BIF_BROWSEFORPRINTER = #00002000 ! Browsing for Printers
integer, parameter :: BIF_BROWSEINCLUDEFILES = #00004000 ! Browsing for Everything
integer, parameter :: BIF_NONEWFOLDERBUTTON = #00000200
integer, parameter :: BIF_NEWDIALOGSTYLE = #00000040
TYPE T_BROWSEINFO
SEQUENCE
INTEGER(HANDLE) :: hwndOwner
INTEGER :: pidlRoot
INTEGER :: pszDisplayName
INTEGER :: lpszTitle
INTEGER :: ulFlags
INTEGER :: lpfn
INTEGER(fLPARAM) :: lParam
INTEGER :: iImage
END TYPE T_BROWSEINFO
TYPE T_STRRET
SEQUENCE
INTEGER(UINT) :: uType
CHARACTER(LEN=MAX_PATH) :: cStr
END TYPE T_STRRET
TYPE ****EMID
SEQUENCE
INTEGER(2) :: cb
INTEGER(1) :: abID
END TYPE ****EMID
TYPE ITEMIDLIST
SEQUENCE
TYPE(****EMID) :: mkid
END TYPE ITEMIDLIST
END MODULE ExtraWinTy
MODULE BrowseFolder
interface
integer(4) function SHBrowseForFolder (pBI)
use ExtraWinTy
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHBrowseForFolderA@4' :: SHBrowseForFolder
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHBrowseForFolderA' :: SHBrowseForFolder
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: pBI
TYPE(T_BROWSEINFO) :: pBI
end function SHBrowseForFolder
end interface
interface
logical(4) function SHGetPathFromIDList (pidl, pszPath)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHGetPathFromIDListA@8' :: SHGetPathFromIDList
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHGetPathFromIDListA' :: SHGetPathFromIDList
!DEC$ ENDIF
!DEC$ ATTRIBUTES VALUE :: pidl
!DEC$ ATTRIBUTES REFERENCE :: pszPath
integer :: pidl
character*(*) :: pszPath
end function SHGetPathFromIDList
end interface
INTERFACE
INTEGER(4) FUNCTION CoInitializeEx (pvReserved, dwCoInit)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_CoInitializeEx@8' :: CoInitializeEx
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'CoInitializeEx' :: CoInitializeEx
!DEC$ ENDIF
!DEC$ ATTRIBUTES VALUE :: pvReserved
!DEC$ ATTRIBUTES REFERENCE :: dwCoInit
INTEGER(4) :: pvReserved
INTEGER(4) :: dwCoInit
END FUNCTION
END INTERFACE
INTERFACE
SUBROUTINE CoUninitialize ()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_CoUninitialize@0' :: CoUninitialize
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'CoUninitialize' :: CoUninitialize
!DEC$ ENDIF
END SUBROUTINE
END INTERFACE
INTERFACE
INTEGER(4) FUNCTION SHSimpleIDListFromPath (pszPath)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHSimpleIDListFromPath@4' :: SHSimpleIDListFromPath
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHSimpleIDListFromPath' :: SHSimpleIDListFromPath
!DEC$ ENDIF
INTEGER(4) :: pszPath
END FUNCTION
END INTERFACE
end module
0 Kudos
anthonyrichards
New Contributor III
2,368 Views
The version of Shell32.dll that I have in c:\windows\system32\ has symbols for the functions you need but lacking a leading underscore. This would explain why the symbols specified in the ALIAS directives with leading underscore are not found when the libraries are searched.
0 Kudos
alexeyam
Beginner
2,368 Views
As it is told in IVF Help on STDCALL Attributes, "On IA-32 architecture, an underscore ( _ ) is placed at the beginning of the external name of a subprogram." Also, I tried to compile without underscore and compiler reported error.
0 Kudos
Steven_L_Intel1
Employee
2,368 Views
_SHSimpleIDListFromPath@4 is correct on IA-32. This is defined in shell32.lib. You need to add shell32.lib to the list of libraries you link against. You can also USE SHELL32, though this routine is not defined in it (using the module will pull in the library.)
0 Kudos
alexeyam
Beginner
2,368 Views
Thanks.
After I added USE SHELL32 compilation passes well. But when I launch program and press button, linked with this routine, a mistake message appears as it is described in post 16.
This message appears only if I explicitly set a start folder other then default (E:\Data in this example).
[fortran]LOGICAL Function BROWSEFORFOLDER(dir)
    use browsefolder
    USE ifwinty
    use ExtraWinTy
    USE user32
    USE kernel32
    
    implicit none

    character*(*) dir
    integer lpIDList, iret
    INTEGER(4) itemidlistptr, initdirptr
    CHARACTER(511) initdir
    TYPE(T_BROWSEINFO) BI
    
CHARACTER(256) STARTPATH1
INTEGER(2) UCPATH1(512)
INTEGER IACP, IBYTESNEED, IBYTESWRITTEN,IWIDE
!INTEGER ITEMIDLISTPTR


STARTPATH1="E:Data"//CHAR(0) ! Must be a null-terminated string
UCPATH1=0
IACP=GetACP()     ! get the code page in use
IWIDE=0
! find out how many bytes are needed...
IBYTESNEED=MultiByteToWideChar(IACP, 0, STARTPATH1,-1,UCPATH1, IWIDE)
!..then write them to UCPATH1..
IBYTESWRITTEN=MultiByteToWideChar(IACP, 0, STARTPATH1,-1,UCPATH1, IBYTESNEED)
UCPATH1(IBYTESWRITTEN+1)=0    ! terminate with an added zero

ITEMIDLISTPTR=SHSimpleIDListFromPath (LOC(UCPATH1))

    bi.hwndOwner      = GetForegroundWindow()
    bi.pidlRoot       = ITEMIDLISTPTR !NULL !Starts with Workspace
    bi.pszDisplayName = LOC(Dir)
    bi.lpszTitle      = LOC("Please select directory:"C)
    bi.ulFlags        = BIF_RETURNONLYFSDIRS  .XOR. BIF_NEWDIALOGSTYLE 
    bi.lpfn           = 0
    bi.lParam         = 0
    bi.iImage         = 0

    iret = CoInitializeEx (NULL, COINIT_APARTMENTTHREADED ) ! Needed for BIF_NEWDIALOGSTYLE flag

    lpIDList = SHBrowseForFolder(bi)

    IF (lpIDList.ne.0) THEN
	    BrowseForFolder = SHGetPathFromIDList (lpIDList, dir)
    else
	    BrowseForFolder = .false.
    END IF
    CALL CoUninitialize ()                                  ! Needed for CoInitializeEx
    return
end function


MODULE ExtraWinTy 
   USE ifwinty 
 	
 	integer, parameter :: BIF_RETURNONLYFSDIRS   = #00000001  ! For finding a folder to start document searching 
    integer, parameter :: BIF_DONTGOBELOWDOMAIN  = #00000002  ! For starting the Find Computer 
    integer, parameter :: BIF_STATUSTEXT         = #00000004
    integer, parameter :: BIF_RETURNFSANCESTORS  = #00000008
    integer, parameter :: BIF_EDITBOX            = #00000010

    integer, parameter :: BIF_BROWSEFORCOMPUTER  = #00001000  ! Browsing for Computers. 
    integer, parameter :: BIF_BROWSEFORPRINTER   = #00002000  ! Browsing for Printers 
    integer, parameter :: BIF_BROWSEINCLUDEFILES = #00004000  ! Browsing for Everything 
    integer, parameter :: BIF_NONEWFOLDERBUTTON  = #00000200 
    integer, parameter :: BIF_NEWDIALOGSTYLE     = #00000040
    
    TYPE T_BROWSEINFO 
        SEQUENCE 
        INTEGER(HANDLE)                :: hwndOwner 
        INTEGER                        :: pidlRoot 
        INTEGER                        :: pszDisplayName 
        INTEGER                        :: lpszTitle 
        INTEGER                        :: ulFlags 
        INTEGER                        :: lpfn 
        INTEGER(fLPARAM)               :: lParam 
        INTEGER                        :: iImage 
    END TYPE T_BROWSEINFO 

    TYPE T_STRRET
        SEQUENCE
        INTEGER(UINT)             :: uType
        CHARACTER(LEN=MAX_PATH)   :: cStr
    END TYPE T_STRRET

END MODULE ExtraWinTy 

MODULE BrowseFolder
    USE SHELL32
	interface
		integer(4) function  SHBrowseForFolder (pBI)
			use ExtraWinTy
		!DEC$ IF DEFINED(_X86_)
		!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHBrowseForFolderA@4' :: SHBrowseForFolder
		!DEC$ ELSE
		!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHBrowseForFolderA'   :: SHBrowseForFolder
		!DEC$ ENDIF
		!DEC$ ATTRIBUTES REFERENCE :: pBI
			TYPE(T_BROWSEINFO)	:: pBI
		end function SHBrowseForFolder
	end interface

	interface
		logical(4) function SHGetPathFromIDList (pidl, pszPath)
		!DEC$ IF DEFINED(_X86_)
		!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHGetPathFromIDListA@8' :: SHGetPathFromIDList
		!DEC$ ELSE
		!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHGetPathFromIDListA'   :: SHGetPathFromIDList
		!DEC$ ENDIF
		!DEC$ ATTRIBUTES VALUE :: pidl
		!DEC$ ATTRIBUTES REFERENCE :: pszPath
			integer			:: pidl
			character*(*)	:: pszPath
		end function SHGetPathFromIDList
	end interface

    INTERFACE
        INTEGER(4) FUNCTION CoInitializeEx (pvReserved, dwCoInit)
        !DEC$ IF DEFINED(_X86_)
		!DEC$ ATTRIBUTES STDCALL, ALIAS:'_CoInitializeEx@8' :: CoInitializeEx
		!DEC$ ELSE
		!DEC$ ATTRIBUTES STDCALL, ALIAS: 'CoInitializeEx'   :: CoInitializeEx
		!DEC$ ENDIF
		!DEC$ ATTRIBUTES VALUE :: pvReserved
		!DEC$ ATTRIBUTES REFERENCE :: dwCoInit
		    INTEGER(4)    :: pvReserved
		    INTEGER(4)    :: dwCoInit
		END FUNCTION
    END INTERFACE
    
    INTERFACE
        SUBROUTINE CoUninitialize ()
        !DEC$ IF DEFINED(_X86_)
		!DEC$ ATTRIBUTES STDCALL, ALIAS:'_CoUninitialize@0' :: CoUninitialize
		!DEC$ ELSE
		!DEC$ ATTRIBUTES STDCALL, ALIAS: 'CoUninitialize'   :: CoUninitialize
		!DEC$ ENDIF
		END SUBROUTINE
    END INTERFACE
    
    INTERFACE
        INTEGER(4) FUNCTION SHSimpleIDListFromPath (pszPath)
        !DEC$ IF DEFINED(_X86_)
		!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHSimpleIDListFromPath@4' :: SHSimpleIDListFromPath
		!DEC$ ELSE
		!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHSimpleIDListFromPath'   :: SHSimpleIDListFromPath
		!DEC$ ENDIF
		    INTEGER(4)    :: pszPath
		END FUNCTION
    END INTERFACE

end module[/fortran]
0 Kudos
anthonyrichards
New Contributor III
2,368 Views
Please try removing the BIF_NEWDIALOGSTYLE flag and use defaults, just to see whether that makes any difference.
I know you say you need it to get an edit box but it may be the problem.
Also, is there anything special about your E:\ drive and its folders (acess, security-wise etc.)?
What Windows operating system are you using?
0 Kudos
alexeyam
Beginner
2,368 Views
When I removeBIF_NEWDIALOGSTYLE flag and use E:\data as starting folder it shows the following window:
This starting folder could not be expanded by clicking the cross on the left. It is abnormal too.
When I use default starting folder (bi.pidlRoot = NULL) everything goes OK both with and withoutBIF_NEWDIALOGSTYLE flag.
E: drive is usual partition. I keep all data on it, including "My Documents". Folder "Data" on it was made by Windows Explorer, specially to test this function and has no additional attributes.
I use Windows XP SP3.
0 Kudos
anthonyrichards
New Contributor III
2,368 Views
I predict that your problem(s) will go away after you have replaced

ITEMIDLISTPTR=SHSimpleIDListFromPath(LOC(UCPATH1))

with

INTEGER, PARAMETER :: CSIDL_FLAG_CREATE ='8000'X
integer, parameter :: CSIDL_PROGRAM_FILES = '0026'x
...
...
ITEMIDLISTPTR=0
IATTRIBUTES=CSIDL_FLAG_CREATE
IRET=SHILCREATEFROMPATH(UCPATH1, ITEMIDLISTPTR, IATTRIBUTES)

The problem appears to be linked to using the output from SHSimpleIDListFromPath instead of
SHILCreateFromPath

you will need the following interface block:

interface
logical(4) function SHILCreateFromPath(pszPath, pidl, iflags)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS:'_SHILCreateFromPath@12' :: SHILCreateFromPath
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS: 'SHILCreateFromPath' :: SHILCreateFromPath
!DEC$ ENDIF
!DEC$ ATTRIBUTES REFERENCE :: pidl
!DEC$ ATTRIBUTES REFERENCE :: iflags
!DEC$ ATTRIBUTES REFERENCE :: pszPath
integer :: pidl, iflags
integer(2) :: pszPath(*)
end function SHILCreateFromPath
end interface
0 Kudos
alexeyam
Beginner
2,368 Views
Yes!YES!!! Thanks a lot.
It works.
The only problem is that I missed initial folder and root folder.
This is what I have now:
And this is my dream (I generated this dialog by AutoIt script):
I have not found anyBROWSEINFO flags which could set initial folder. May be not all of them are documented?
May be, there is a function, which after BrowseForForder dialog is evoked sets focus on initial folder?
0 Kudos
anthonyrichards
New Contributor III
2,368 Views
You will probably have to play with the IATTRIBUTES value. Research MSDN information on SHilCreateFromPath for useful values.

The CSIDL_FLAG_CREATE value I gave as an example causes the requested folder to be created if it is not present.

I believe that BrowsForFolder will only display folders from the requested folder path downwards. It will not display folders at a higher level.
0 Kudos
Reply