An olde worlde open file dialog

[deltarho[1859]]

In the thread AfxOpenFileDialog I was getting close to pulling my hair out over Microsoft changing the way, in Windows 7, that the initial directory is determined. It looked like PowerBASIC was using the pre Windows 7 algorithm. So, I wrote a PowerBASIC dll and it is using the 'old' technology.

Attached is PBOpenFile.dll. It is only 13.5KB (16KB on disk).

Here is an example usage:

Code: Select all

/'DROpenFile parameters
1. hParent
2. Title
3. InitialDir
4. Filter
'/
 
' **************************
Dim As Any Ptr library = DyLibLoad( "PBOpenFile.dll" )
If library = 0  Then
  Print "Failed to load PBOpenFile.dll"
  Sleep
  end 1
End If
 
Dim DROpenFile As Function( As Ulong, Byref As Zstring, Byref As Zstring, Byref As Zstring ) As Zstring Ptr
DROpenFile = DyLibSymbol( library, "PBOpenFile" )
If DROpenFile = 0  Then
  Print "Could not retrieve the entry point of PBOpenFile"
  Sleep
  End 1
End If
' **************************
 
Dim As Zstring *260 InitialDir, Filter
Dim Result As Zstring Ptr
 
InitialDir = "F:\alice"
Filter = "All files" + Chr(1) + "*.*" + Chr(1)
Result = DROpenFile( 0, "Test", InitialDir, Filter )
Print *Result
 
Filter = "RSAPublicKey" + Chr(1) + "*RSAPublicKey*.dat" + Chr(1)
Result = DROpenFile( 0, "Test", InitialDir, Filter )
Print *Result
 
InitialDir = "" ' The current directory will be used
Filter = "All files" + Chr(1) + "*.*" + Chr(1)
Result = DROpenFile( 0, "Test", InitialDir, Filter )
Print *Result
 
Sleep 

The filter syntax is slightly different to José's AfxOpenFileDialog but it should be clear from the above how it works.

You may be wondering what on earth am I doing using Chr(1) as a separator. There again you may not. <smile> Anyway, if we used Chr(0), which is needed, the filter would be clipped since we are using Zstrings. The dll replaces the Chr(1) with Chr(0). Is that sneaky or what?

My initial trials had the dll outputting a string but I got a memory access violation when FB input a string. The dll now outputs a string pointer.

With the first test F:/alice is opened with all files displayed. We can navigate and select a file anywhere, perhaps even on removable media, and this has no effect on the second test which also opens F:\alice but this time the filter *RSAPublicKey*.dat is used so only files satisfying the filter get displayed. With the third test the initial directory is empty so the current directory, the application's directory, gets opened.

If we used an empty string again for the initial directory then the previous ending directory will be used, rather than honouring a empty string for the current directory. That is fine with me. If we don't want that then it is a simple matter to not use an empty string again.

Added: The last statement is false - the empty string is still being honoured. I just spotted the fact that 'honor' got past my spell checker. For some reason I was using English( United States) and English (United Kingdom) had gone 'walkabout'. Maybe the last browser update upset the apple-cart. This has now been corrected with extreme prejudice. <laugh>

Needless to say if we Close or Cancel the dialog we get an empty string returned.

The open file dialog display is a little different to later versions of Windows but not enough to frighten the horses.

I got fed up using the 'My' prefix for functions so used 'DR'. You can, of course, rename DROpenFile to almost anything you like.

So, there we have it - an open file dialog that behaves as it did with Windows 2000/XP/Vista.

BTW, if you do use the dll you don't need to credit me - I am not into that sort of thing. I get enough buzz seeing my stuff being used. <Smile>

PBOpenFile.zip

[jj2007]

You may be wondering what on earth am I doing using Chr(1) as a separator. There again you may not. <smile> Anyway, if we used Chr(0), which is needed, the filter would be clipped since we are using Zstrings. The dll replaces the Chr(1) with Chr(0). Is that sneaky or what?

That's pretty sneaky indeed, and your program works fine on Win7-64 ;-)

I wonder, though, what happens if you simply use a "normal" FB string here, with Chr(0) embedded. That string is read-only anyway, and if you pass the pointer to the OS, Windows sees just a range of memory containing strings with embedded zeros.

Just checked the manual - is there really no OpenFile() command?

[deltarho[1859]]

your program works fine on Win7-64

That is great news because that is when the rot set in with Microsoft deciding to be 'helpful'.

I wonder, though, what happens if you simply use a "normal" FB string here, with Chr(0) embedded.

I am using Zstring because the dll uses PB's Stringz*260 as input. If they both used Strings they simply would not talk to each other - FB strings are not the same as PB strings.

Just checked the manual - is there really no OpenFile() command?

I could not find one but even if one existed it would probably fall foul of Windows 7 helpfulness remembering that Windows 7 became generally available on October 22, 2009. In a way I am surprised that the PB compiler is still using the pre Windows 7 initial directory algorithm but Bob Zale being Bob Zale he may may have decided not to update 'Display OpenFile' when he saw what Microsoft did. Either way I am very glad because we now have pre Windows 7 or Windows 7 and later to chose from.

[jj2007]

Yes, it's messy. My own implementation (FileIOpen$) sets lpstrInitialDir and works ok, but it was a long fight, also because OpenFile doesn't like being debugged - Olly crashes and freezes.

[dodicat]

You should really have written, e.g.:

Print "Failed to load PBOpenFile.dll"
sleep
end 1
...
...
edit.
OK, got it working now.

[jj2007]

Sorry, I don't get your last post. Your DLL loads and works just fine, I only wonder if there isn't a pure FB solution that works. Can you post a non-DLL version that shows the incorrect behaviour?

See also MSDN Social, GetOpenFilename crash on SOME 64 bit Win7 boxes

[deltarho[1859]]

@dodicat

Well spotted. That reminds me of the messagebox that got invoked to tell us something was wrong with our monitor when our monitor was dead. I may be wrong but I think it was a Microsoft notification many years ago.

I am quoting myself here from the AfxOpenFileDialog thread.

I have just read a post, going back a few years, where one guy described the Windows 7 algorithm as 'sagacity' - my very sentiment. One poor guy was getting hammered by his customers and it had nothing to do with him.

With the latter the customers upgraded to Windows 7 and the new behaviour was driving them nutty. They thought it was his software 'playing up'. They found themselves having to do a lot more navigating as the folders were not opening in the places they once did.

[Josep Roca]

> but Bob Zale being Bob Zale he may may have decided not to update 'Display OpenFile' when he saw what Microsoft did

Wrong. What he did was to enable a hook, which has the side effect of disabling the new style.

Please try the following example. If it works as you like, then I will change my procedures to add an optional parameter to set the hook address.

Code: Select all

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx

CONST IDC_OFD = 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

FUNCTION AfxOpenFileDialogHookProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
   RETURN FALSE
END FUNCTION

' ========================================================================================
PRIVATE FUNCTION AfxOpenFileDialogHook ( _
   BYVAL hwndOwner AS HWND _                    ' // Parent window
 , BYREF wszTitle AS WSTRING _                  ' // Caption
 , BYREF wszFile AS WSTRING _                   ' // Filename
 , BYREF wszInitialDir AS WSTRING _             ' // Start directory
 , BYREF wszFilter AS WSTRING _                 ' // Filename filter
 , BYREF wszDefExt AS WSTRING _                 ' // Default extension
 , BYVAL pdwFlags AS DWORD PTR = NULL _         ' // Flags
 , BYVAL pdwBufLen AS DWORD PTR = NULL _        ' // Buffer length
 ) AS CWSTR

   DIM dwFlags AS DWORD, dwBufLen AS DWORD
   IF pdwFlags THEN dwFlags = *pdwFlags
   IF pdwBufLen THEN dwBufLen = *pdwBuflen

   ' // Filter is a sequence of WSTRINGs with a final (extra) double null terminator
   ' // The "|" characters are replaced with nulls
   DIM wszMarkers AS WSTRING * 4 = "||"
   IF RIGHT(wszFilter, 1) <> "|" THEN wszMarkers += "|"
   DIM cwsFilter AS CWSTR = wszFilter & wszMarkers
   DIM dwFilterStrSize AS DWORD = LEN(cwsFilter)
   ' // Replace markers("|") with nulls
   DIM pchar AS WCHAR PTR = *cwsFilter
   FOR i AS LONG = 0 TO LEN(cwsFilter) - 1
      IF pchar[i] = ASC("|") THEN pchar[i] = 0
   NEXT

   ' // If the initial directory has not been specified, assume the current directory
   ' // FreeBasic 64 bit fails if we pass an empty string and we try to modify wszInitialDir
   DIM _wszInitialDir AS WSTRING * MAX_PATH = wszInitialDir
   IF LEN(_wszInitialDir) = 0 THEN _wszInitialDir = CURDIR
   ' // The size of the buffer must be at least MAX_PATH characters
   IF dwBufLen = 0 THEN
      IF (dwFlags AND OFN_ALLOWMULTISELECT = OFN_ALLOWMULTISELECT) THEN dwBufLen = 32768  ' // 64 Kb buffer
   END IF
   IF dwBufLen < 260 THEN dwBufLen = 260   ' // Make room for at least one path
   ' // Allocate the file name and a marker ("|") to be replaced with a null
   DIM cwsFile AS CWSTR = wszFile & "|"
   ' // Store the position of the marker
   DIM cbPos AS LONG = LEN(cwsFile) - 1
   ' // Allocate room for the buffer
   IF LEN(cwsFile) < dwBufLen THEN cwsFile += SPACE(dwBufLen - LEN(cwsFile))
   DIM dwFileStrSize AS DWORD = LEN(cwsFile)
   ' // The filename must be null terminated (replace the marker with a null)
   pchar = *cwsFile
   pchar[cbPos] = 0

   ' // Fill the members of the structure
   DIM ofn AS OPENFILENAMEW
   ofn.lStructSize     = SIZEOF(ofn)
   IF AfxWindowsVersion < 5 THEN ofn.lStructSize = 76
   ofn.hwndOwner       = hwndOwner
   ofn.lpstrFilter     = *cwsFilter
   ofn.nFilterIndex    = 1
   ofn.lpstrFile       = *cwsFile
   ofn.nMaxFile        = dwFileStrSize
   ofn.lpstrInitialDir = @_wszInitialDir
   IF LEN(wszTitle) THEN ofn.lpstrTitle = @wszTitle
   ofn.Flags = dwFlags OR OFN_ENABLEHOOK OR OFN_EXPLORER
   IF LEN(wszDefExt) THEN ofn.lpstrDefExt = @wszDefExt
   ofn.lpfnHook = @AfxOpenFileDialogHookProc

   ' // Call the open file dialog
   IF GetOpenFilenameW(@ofn) THEN
      pchar = *cwsFile
      FOR i AS LONG = 0 TO dwFileStrSize - 1
         ' // If double null, exit
         IF pchar[i] = 0 AND pchar[i + 1] = 0 THEN EXIT FOR
         ' // Replace null with ","
         IF pchar[i] = 0 THEN pchar[i] = ASC(",")
      NEXT
      ' // Trim trailing spaces
      cwsFile = RTRIM(**cwsFile, CHR(32))
      IF RIGHT(**cwsFile, 1) = "," THEN cwsFile = LEFT(**cwsFile, LEN(cwsFile) - 1)
   ELSE
      ' // Buffer too small
      IF CommDlgExtendedError = FNERR_BUFFERTOOSMALL THEN
         dwBufLen = ASC(**cwsFile)
      END IF
      cwsFile = ""
   END IF

   ' // Return the retrieved values
   IF pdwFlags THEN *pdwFlags = ofn.Flags
   IF pdwBufLen THEN *pdwBufLen = dwBufLen
   RETURN cwsFile

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "AfxOpenFileDialog example", @WndProc)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", , IDC_OFD, "&Open File Dialog", 350, 250, 110, 23)

   

   ' // Dispatch messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            ' // Display the Open File Dialog
            CASE IDC_OFD
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  DIM wszFile AS WSTRING * 260 = "*.*"
                  DIM wszInitialDir AS WSTRING * 260 = CURDIR
                  DIM wszFilter AS WSTRING * 260 = "BAS files (*.BAS)|*.BAS|" & "All Files (*.*)|*.*|"
                  DIM dwFlags AS DWORD = OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY
                  DIM cws AS CWSTR = AfxOpenFileDialogHook(hwnd, "", wszFile, wszInitialDir, wszFilter, "BAS", @dwFlags, NULL)
                  MessageBoxW(hwnd, cws, "File", MB_OK)
                  EXIT FUNCTION
               END IF
         END SELECT

    	CASE WM_DESTROY
         ' // Quit the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

[Josep Roca]

Note: If you remove OFN_EXPLORER in ofn.Flags = dwFlags OR OFN_ENABLEHOOK OR OFN_EXPLORER you will get an even more retro style, like with Windows 98 :)

[jj2007]

#INCLUDE ONCE "Afx/CWindow.inc"

Josep, can you post a link to the download page? Forum search wasn't successful.

[Josep Roca]

#INCLUDE ONCE "Afx/CWindow.inc"

Josep, can you post a link to the download page? Forum search wasn't successful.

It is not a single file, but a framework.

The framework is avilable at GitHub: https://github.com/JoseRoca/WinFBX

On-line help: http://www.jose.it-berater.org/WinFBX/WinFBX.html

[jj2007]

The framework is avilable at GitHub: https://github.com/JoseRoca/WinFBX

Yep, there it is, thanks!

Code: Select all

                  DIM wszInitialDir AS WSTRING * 260 = "\somepath\صندوقرسالة"
                  DIM wszFilter AS WSTRING * 260 = "BAS files (*.BAS)|*.BAS|" & "All Files (*.*)|*.*|"
                  DIM dwFlags AS DWORD = OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY
                  DIM cws AS CWSTR = AfxOpenFileDialogHook(hwnd, "", wszFile, wszInitialDir, wszFilter, "BAS", @dwFlags, NULL)
                  MessageBoxW(hwnd, cws, "File", MB_OK)

That works basically fine, but the MessageBoxW shows ??? when I select a file with an exotic name. Does AfxOpenFileDialogHook return a true Unicode string?

[Josep Roca]

I will have to check. It is a real pain to use GetOpenFilenameW (unicode) with FB. I use the IFileDialog interface (see example below), but had to write the AfxOpeFileDialog wrapper because there is always people that wants particular things or don't want to use COM. An hook is often used to center the Open File Dialog in the screen.

Code: Select all

' ########################################################################################
' Microsoft Windows
' File: COM_IFileOpenDialog.fbtpl (single selection)
' Contents: Demonstrates the use of the IFileOpenDialog interface.
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "win/shobjidl.bi"
USING Afx

CONST IDC_OFD = 1001

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION AfxIFileOpenDialog (BYVAL hwndOwner AS HWND, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH) AS WSTRING PTR

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Initialize the COM library
   CoInitialize(NULL)

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Create the main window
   DIM pWindow AS CWindow
   pWindow.Create(NULL, "IFileOpenDialog example", @WndProc)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", , IDC_OFD, "&Open File Dialog", 350, 250, 110, 23)

   

   ' // Dispatch messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

   ' // Uninitialize the COM library
   CoUninitialize

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            ' // Display the Open File Dialog
            CASE IDC_OFD
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  DIM pwszName AS WSTRING PTR = AfxIFileOpenDialog(hwnd)
                  ' // Display the name of the selected file
                  IF pwszName THEN
                     MessageBoxW(hwnd, *pwszName, "IFileOpenDialog", MB_OK)
                     CoTaskMemFree(pwszName)
                  END IF
                  EXIT FUNCTION
               END IF
         END SELECT

    	CASE WM_DESTROY
         ' // Quit the application
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Displays the File Open Dialog
' The returned pointer must be freed with CoTaskMemFree
' ========================================================================================
FUNCTION AfxIFileOpenDialog (BYVAL hwndOwner AS HWND, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH) AS WSTRING PTR

   ' // Create an instance of the FileOpenDialog interface
   DIM hr AS LONG
   DIM pofd AS IFileOpenDialog PTR
   hr = CoCreateInstance(@CLSID_FileOpenDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @pofd)
   IF pofd = NULL THEN RETURN NULL

   ' // Set the file types
   DIM rgFileTypes(1 TO 3) AS COMDLG_FILTERSPEC
   rgFileTypes(1).pszName = @WSTR("FB code files")
   rgFileTypes(2).pszName = @WSTR("Executable files")
   rgFileTypes(3).pszName = @WSTR("All files")
   rgFileTypes(1).pszSpec = @WSTR("*.bas;*.inc;*.bi")
   rgFileTypes(2).pszSpec = @WSTR("*.exe;*.dll")
   rgFileTypes(3).pszSpec = @WSTR("*.*")
   pofd->lpVtbl->SetFileTypes(pofd, 3, @rgFileTypes(1))

   ' // Set the title of the dialog
   hr = pofd->lpVtbl->SetTitle(pofd, "A Single-Selection Dialog")
   ' // Display the dialog
   hr = pofd->lpVtbl->Show(pofd, hwndOwner)

   ' // Set the default folder
   DIM pFolder AS IShellItem PTR
   SHCreateItemFromParsingName (CURDIR, NULL, @IID_IShellItem, @pFolder)
   IF pFolder THEN
      pofd->lpVtbl->SetDefaultFolder(pofd, pFolder)
      pFolder->lpVtbl->Release(pFolder)
   END IF

   ' // Get the result
   DIM pItem AS IShellItem PTR
   DIM pwszName AS WSTRING PTR
   IF SUCCEEDED(hr) THEN
      hr = pofd->lpVtbl->GetResult(pofd, @pItem)
      IF SUCCEEDED(hr) THEN
         hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
         FUNCTION = pwszName
      END IF
   END IF

   ' // Cleanup
   IF pItem THEN pItem->lpVtbl->Release(pItem)
   IF pofd THEN pofd->lpVtbl->Release(pofd)

END FUNCTION
' ========================================================================================

[Josep Roca]

> That works basically fine, but the MessageBoxW shows ??? when I select a file with an exotic name. Does AfxOpenFileDialogHook return a true Unicode string?

I have found the problem. Change cwsFile = RTRIM(cwsFile, CHR(32)) to cwsFile = RTRIM(**cwsFile, CHR(32)).

[jj2007]

rgFileTypes(1).pszName = @WSTR("FB code files")
rgFileTypes(1).pszSpec = @WSTR("*.bas;*.inc;*.bi")

Your COM version works fine and shows the Unicode MessageBox. I see that the combobox shows
FB code files (*.bas;*.inc;*.bi) instead of only
FB code files

Is that a style or a flag? Some Windows components use the upper, some the lower version, it seems.

Change cwsFile = RTRIM(cwsFile, CHR(32)) to cwsFile = RTRIM(**cwsFile, CHR(32)).

Where is the thumbs up button here? ;-)