Tweet
Code:
' --------------------------------------------------
' Exhookdemo.bas
' PURPOSE:
' Demonstrate use of Explorer-style hook procedures with modified
' versions of PB-Supplied "OpenFileDialog" and "saveFileDialog" procedures.
'Also shows how to use a 'dwuser' parameter in the Explorer-Style
' callback (hook) procedure
' AUTHOR : Michael Mattias Tal Systems Inc. Racine WI
' DATE : March 31 2007
' USE : Placed in public domain by author 3/31/07
' COMPILER: PB/Windows 8.03, but should work with all versions
' of PB's Windows' GUI compilers.
' LIMITATION: Open Callback is not designed to handle multiple files, so the
' use of OFN_ALLOWMULTISELECT flag is done at user's risk.
' -------------------------------------------------
#COMPILE EXE
#DEBUG ERROR ON
#REGISTER NONE
#DIM ALL
#TOOLS OFF
'=====[Windows API Header Files] ============================
' If you don't need all of the functionality supported by these APIs
' (and who does?), you can selectively turn off various modules by putting
' the following constants in your program BEFORE you #include "win32api.inc":
'
' %NOGDI = 1 ' no GDI (Graphics Device Interface) functions
' %NOMMIDS = 1 ' no Multimedia ID definitions
%NOMMIDS = 1
#INCLUDE "WIN32API.INC" ' Feb 2005
'==[End Windows API Header Files]============================
#IF NOT %DEF (%INVALID_HANDLE_VALUE_LONG)
%INVALID_HANDLE_VALUE_LONG = -1&
#ENDIF
#INCLUDE "COMDLG32.INC" ' 11 March 2003. required for many support equates and structures
' equates from shlobj.h not found in Win32API.INC
%SHGFP_TYPE_CURRENT = 0& ' // current value for user, use verify it exists
%SHGFP_TYPE_DEFAULT = 1& ' // default value, may or may not exist
' -----------------------------------------------------------------
' NEW VERSIONS OF "OpenFileDialog" and "SaveFileDialog"
' Changes from PB-Supplied routines:
' 1. Functions named "OpenFileDialogHook" and "SaveFileDialogHook" to avoid
' name conflicts with functions defined in COMDLG32.INC
' 2. Optional Parameters cbAddress and lparam added to parameter list for functions.
' 3. When optional parameter cbaddress is not null, additional code to set the
' flags member of OFN structure and since this member is returned to caller,
' any additional flags addded as a result of adding the members for the callback
' are removed. In openFileDialog the only flag which changes other than by explicit
' assignment is OFN_READONLY; no flags are changed by user action in SaveFileDialog.
' ------------------------------------------------------------------
' ========================================================================
' The "OpenFileDialogHook" and SaveFiledialogHook" procedures are 100%
' backward-compatible with the supplied PB "OpenFileDialog" and "SaveFileDialog"
' procedures, since all callback options are specified by OPTIONAL parameter.
' Typically these 'wrapper' functions would be in an #INCLUDE file, but the
' callback procedures themselves would be 'in-line' in the program using them.
' ========================================================================
FUNCTION OpenFileDialogHook (BYVAL hWnd AS DWORD, _ ' parent window
BYVAL sCaption AS STRING, _ ' caption
sFileSpec AS STRING, _ ' filename
BYVAL sInitialDir AS STRING, _ ' start directory
BYVAL sFilter AS STRING, _ ' filename filter
BYVAL sDefExtension AS STRING, _ ' default extension
dFlags AS DWORD, _ ' flags
OPTIONAL BYVAL cbAddr AS DWORD, _ ' callback address
OPTIONAL BYVAL lparam AS DWORD _ ' callback parameter
) AS LONG
LOCAL ix AS LONG
LOCAL ofn AS OPENFILENAME
LOCAL szFileTitle AS ASCIIZ * %MAX_PATH
' added to support the hook procedure
LOCAL iHookMask AS LONG, initFlags AS LONG
' Filter is a sequence of ASCIIZ strings with a final (extra) $NUL terminator
REPLACE "|" WITH $NUL IN sFilter
sFilter = sFilter + $NUL
IF LEN(sInitialDir) = 0 THEN
sInitialDir = CURDIR$
END IF
ix = INSTR(sFileSpec, $NUL)
IF ix THEN
sFileSpec = LEFT$(sFileSpec, ix) + SPACE$(%OFN_FILEBUFFERSIZE - ix)
ELSE
sFileSpec = sFileSpec + $NUL + SPACE$(%OFN_FILEBUFFERSIZE - (LEN(sFileSpec) + 1))
END IF
ofn.lStructSize = SIZEOF(ofn)
ofn.hWndOwner = hWnd
ofn.lpstrFilter = STRPTR(sFilter)
ofn.nFilterIndex = 1
ofn.lpstrFile = STRPTR(sFileSpec)
ofn.nMaxFile = LEN(sFileSpec)
ofn.lpstrFileTitle = VARPTR(szFileTitle)
ofn.nMaxFileTitle = SIZEOF(szFileTitle)
ofn.lpstrInitialDir = STRPTR(sInitialDir)
IF LEN(sCaption) THEN
ofn.lpstrTitle = STRPTR(sCaption)
END IF
ofn.Flags = dFlags
IF LEN(sDefExtension) THEN
ofn.lpstrDefExt = STRPTR(sDefExtension)
END IF
' Set up to use Explorer-style hook proc. To use this we
' need to set the EXPLORER, ENABLEHOOK and ENABLESIZING flags.
IF ISTRUE cbAddr THEN
initFlags = ofn.flags ' save for restore
iHookmask = %OFN_EXPLORER OR %OFN_ENABLEHOOK OR %OFN_ENABLESIZING
' make sure these flags are on for the call
Ofn.flags = ofn.flags OR iHookMask
' set callback address
ofn.lpfnhook = cbAddr
' set the user parameter for use in the callback procedure
ofn.lcustData = lparam
END IF
FUNCTION = GetOpenFilename(ofn)
ix = INSTR(-1, sFileSpec, $NUL)
IF ix THEN
sFileSpec = LEFT$(sFileSpec, ix - 1)
ELSE
sFileSpec = ""
END IF
' adjust flags if callback in use
IF ISTRUE cbAddr THEN
' reset any flags we set for return to caller, allowing for possibility
' that OFN_READONLY was set during call by virtue of user checking the box.
ofn.flags = initFlags OR (ofn.flags AND %OFN_READONLY)
END IF
dFlags = ofn.Flags
END FUNCTION
FUNCTION SaveFileDialogHook (BYVAL hWnd AS DWORD, _ ' parent window
BYVAL sCaption AS STRING, _ ' caption
sFileSpec AS STRING, _ ' filename
BYVAL sInitialDir AS STRING, _ ' start directory
BYVAL sFilter AS STRING, _ ' filename filter
BYVAL sDefExtension AS STRING, _ ' default extension
dFlags AS DWORD, _ ' flags
OPTIONAL BYVAL cbAddr AS DWORD, _ ' callback procedure
OPTIONAL BYVAL lparam AS LONG _ ' callback parameter
) AS LONG
LOCAL ix AS LONG
LOCAL ofn AS OPENFILENAME
LOCAL szFileTitle AS ASCIIZ * %MAX_PATH
' added to support the hook procedure
LOCAL iHookMask AS LONG, InitFlags AS LONG
' Filter is a sequence of ASCIIZ strings with a final (extra) $NUL terminator
REPLACE "|" WITH $NUL IN sFilter
sFilter = sFilter + $NUL
IF LEN(sInitialDir) = 0 THEN
sInitialDir = CURDIR$
END IF
IF LEN(sFileSpec) > %MAX_PATH THEN
sFileSpec = LEFT$(sFileSpec, %MAX_PATH)
END IF
ix = INSTR(sFileSpec, $NUL)
IF ix THEN
sFileSpec = LEFT$(sFileSpec, ix) + SPACE$(%MAX_PATH - ix)
ELSE
sFileSpec = sFileSpec + $NUL + SPACE$(%MAX_PATH - LEN(sFileSpec))
END IF
ofn.lStructSize = SIZEOF(ofn)
ofn.hWndOwner = hWnd
ofn.lpstrFilter = STRPTR(sFilter)
ofn.nFilterIndex = 1
ofn.lpstrFile = STRPTR(sFileSpec)
ofn.nMaxFile = LEN(sFileSpec)
ofn.lpstrFileTitle = VARPTR(szFileTitle)
ofn.nMaxFileTitle = SIZEOF(szFileTitle)
ofn.lpstrInitialDir = STRPTR(sInitialDir)
IF LEN(sCaption) THEN
ofn.lpstrTitle = STRPTR(sCaption)
END IF
ofn.Flags = dFlags
IF LEN(sDefExtension) THEN
ofn.lpstrDefExt = STRPTR(sDefExtension)
END IF
' Set up to use Explorer-style hook proc. To use this we
' need to set the EXPLORER, ENABLEHOOK and ENABLESIZING flags.
IF ISTRUE cbAddr THEN
initFlags = dflags ' save for restore
iHookmask = %OFN_EXPLORER OR %OFN_ENABLEHOOK OR %OFN_ENABLESIZING
' make sure these flags are on for the call
Ofn.flags = ofn.flags OR iHookMask
' set callback address
ofn.lpfnhook = cbAddr
' set callback parameter
ofn.lcustdata = lparam
END IF
FUNCTION = GetSaveFilename(ofn)
ix = INSTR(sFileSpec, $NUL)
IF ix THEN
sFileSpec = LEFT$(sFileSpec, ix - 1)
ELSE
sFileSpec = ""
END IF
IF ISTRUE cbAddr THEN
' reset any flags we set for return to caller.
' since readonly is silly for "save file" we do not even bother
' with the readonly bit.
ofn.flags = initflags
END IF
dFlags = ofn.Flags
END FUNCTION
' ======================================
' DEMO PROGRAM MATERIAL STARTS HERE
' ======================================
'----- CONTROL IDS ------'
%ID_OPEN_BUTTON = 101&
%ID_OPEN_FILENAME = 102&
%ID_SAVE_BUTTON = 201&
%ID_SAVE_FILENAME = 202&
%ID_USE_HOOK = 251&
%ID_COURTESY = 301&
%ID_EXIT = 302&
' Equates that should have been built-in to compiler but aren't
%DDT_CHECKED = 1&
%DDT_UNCHECKED = 0&
' ENTRY POINT
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL hDlg AS LONG
DIALOG FONT "Ms Sans Serif", 10 ' default size 8 is just too small for me to read.
DIALOG NEW 0, "Explorer-Style Hook Procs in Open/Save File Dialogs", 10,10,300,100 TO hDlg
CONTROL ADD BUTTON, hDlg, %ID_OPEN_BUTTON, "&Open", 10, 20, 40,14
CONTROL ADD LABEL, hDlg, %ID_OPEN_FILENAME, "" , 60, 20, 240, 12
CONTROL ADD BUTTON, hDlg, %ID_SAVE_BUTTON, "&Save", 10, 44, 40,14
CONTROL ADD LABEL, hDlg, %ID_SAVE_FILENAME, "" , 60, 44, 240, 12
CONTROL ADD CHECKBOX, hDLG, %ID_USE_HOOK, "Use Hook", 10,68, 84, 14
CONTROL ADD BUTTON, hDlg, %ID_EXIT, "&Exit", 255, 82, 40,14
CONTROL ADD LABEL, hDlg, %ID_COURTESY, "Demo Courtesy Michael Mattias" ,10, 86, 240, 12
DIALOG SHOW MODAL hDLG, CALL DialogProc
END FUNCTION ' WinMain
CALLBACK FUNCTION DialogProc() AS LONG
LOCAL sCaption AS STRING, sFileSpec AS STRING, sInitialDir AS STRING
LOCAL sFilter AS STRING, sdefExt AS STRING, dFlags AS DWORD, cbAddr AS DWORD
LOCAL w AS STRING, iRet AS LONG
LOCAL iCHECK AS LONG
' for our callback procedures...
LOCAL szForbidden AS ASCIIZ * %MAX_PATH, dwData AS DWORD
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' preselect "use the hook"
CONTROL SET CHECK CBHNDL, %ID_USE_HOOK, %DDT_CHECKED
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %ID_OPEN_BUTTON
CONTROL GET CHECK CBHNDL, %ID_USE_HOOK TO iCheck
iCheck = (iCheck = %DDT_CHECKED) ' convert to true/false
sCaption = "Get file name for OPEN " & IIF$(icheck, " (with hook", "")
sFilespec = "" ' no initial file
sInitialDir = "" ' no initial directory
sFilter = "" ' no filter
sDefExt = "" ' no default extension
dFlags = %NULL ' nothing special
IF ISTRUE iCheck THEN
cbAddr = CODEPTR (HookProcOpen)
ELSE
cbAddr = %NULL
END IF
' We are not going to allow the user to open any file
' in the Windows directory. Our callback will
' disable the OK button if they browse to that folder
' Get the name of the Windows directory on this system
iRet = ShgetFolderPath (BYVAL %NULL,_
(%CSIDL_WINDOWS), _
-1&, _ ' get for default user
%SHGFP_TYPE_CURRENT ,_
szForbidden)
' set callback param to address of the forbidden string
IF iret = %S_OK THEN
dwData = VARPTR(szForbidden)
ELSE
dwData = %NULL
END IF
CALL OpenFileDialogHook (%NULL, sCaption, sFileSpec, sInitialDir,_
sFilter, sDefExt, dFlags, Cbaddr, dwData) TO iRet
IF Iret THEN
w = sFileSpec
ELSE
w = "no file selected"
END IF
CONTROL SET TEXT CBHNDL, %ID_OPEN_FILENAME, w
CASE %ID_SAVE_BUTTON
CONTROL GET CHECK CBHNDL, %ID_USE_HOOK TO iCheck
iCheck = (iCheck = %DDT_CHECKED) ' convert to true/false
sCaption = "Get filename for SAVE " & IIF$(icheck, "(with hook", "")
sFilespec = "" ' no initial file
sInitialDir = "" ' no initial directory
sFilter = "" ' no filter
sDefExt = "" ' no default extension
' for save, let's set some flags in advance
dFlags = %OFN_LONGNAMES _
OR %OFN_PATHMUSTEXIST _
OR %OFN_HIDEREADONLY _
OR %OFN_NOCHANGEDIR
' ----------------------------------------------------------
' Just to see what happens, try adding %OFN_OVERWRITEPROMPT
' to the flags here and you will see why it is handled in the
' callback (hook) procedure.
' ------------------------------------------------------------
IF ISTRUE iCheck THEN
cbAddr = CODEPTR (HookProcSave)
ELSE
cbAddr = %NULL
END IF
' note that this callback does not use a "dwData" parameter
' so we do not use it in the call (it's OPTIONAL).
CALL SaveFileDialogHook (%NULL, sCaption, sFileSpec, sInitialDir,_
sFilter, sDefExt, dFlags, Cbaddr) TO iRet
IF Iret THEN
w = sFileSpec
ELSE
w = "no file selected"
END IF
CONTROL SET TEXT CBHNDL, %ID_SAVE_FILENAME, w
CASE %ID_EXIT
DIALOG END CBHNDL, 0
END SELECT ' of control sending the WM_COMMAND
END SELECT ' of message
END FUNCTION
' ====================================
' CENTER ANY WINDOW ON DESKTOP
' ====================================
FUNCTION CenterWindow (BYVAL hWnd AS LONG) AS LONG
' centers given Window on the desktop and forces to top
LOCAL rDW AS RECT, rDlg AS RECT
GetClientRect GetDesktopWindow, Rdw
GetWindowRect hWnd, rDlg
SetWindowPos hWnd,_
%HWND_TOP,_
((rDW.nright - rDW.nleft + 1) - (rDlg.nright - rDlg.nleft +1)) \2, _
((rDw.nBottom - rDW.nTop + 1) - (rDlg.nbottom - rDlg.nTop + 1)) \ 2, _
0&,_
0&, _
%SWP_NOSIZE
END FUNCTION
' REFERENCE:
'TYPE NMHDR
' hwndFrom AS DWORD
' idfrom AS DWORD
' code AS DWORD
'END TYPE
'TYPE OFNOTIFY
' hdr AS NMHDR
' lpOFN AS OPENFILENAME PTR
' pszFile AS ASCIIZ PTR
'END TYPE
' ============================================================
' EXPLORER-STYLE HOOK PROC FOR OPEN, THIS PROGRAM
' Centers the dialog on the desktop
' Prohibits selection of files "*.exe" by checking after OK is clicked
' Disables OK button if user is in the path named by the asciiz pointer
' passed as 'lcustdata' in OPENFILENAME structure, which value is added
' the the OpenFileDialogHook Procedure as "lparam" parameter
' ============================================================
FUNCTION HookProcOpen (BYVAL hWnd AS LONG, BYVAL uMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL pOFNotify AS OFNOTIFY PTR , _ ' get on WM_NOTIFY as lparam
w AS STRING
LOCAL pOFN AS OPENFILENAME PTR ' get on WM_INITDIALOG as lparam
LOCAL szPath AS ASCIIZ * %MAX_PATH
LOCAL sFile AS STRING, dotPos AS LONG, sExt AS STRING
LOCAL pAZ AS ASCIIZ PTR, iEnable AS LONG
SELECT CASE AS LONG uMSG
CASE %WM_INITDIALOG
' return: 0 to allow default proc to handle.
pOFN = lparam ' not used here, but could be
CALL CenterWindow (GetParent(hWnd)) ' center the common dialog box on desktop
' This is not centering, but WM_NOTIFY is happening.???
' Oh, yes it is centering, but only if hook is specified
' on FIRST call. Windows seems to 'remember and use' the last position when
' this is called more than once in single program run.
FUNCTION = 0 ' allow default processing
CASE %WM_NOTIFY ' wparam unused. lparam = pOFNotify
pOfnotify = lparam
SELECT CASE AS LONG @pOFnotify.hdr.code
CASE %CDN_FILEOK
'If the hook procedure returns zero, the dialog box accepts the specified
' file name and closes.
'To reject the specified file name and force the dialog box to remain open,
' return a nonzero value from the hook procedure and call the SetWindowLong
' function to set a nonzero DWL_MSGRESULT value
' *******************************************
' REJECT OPEN of any "*.exe" file.
' *******************************************
' get name of the file the user want to 'open'
sFile = @[email protected]@lpstrfile
' find its extension
DotPos = INSTR(-1, sfile, ".")
IF dotPos THEN
sExt = LCASE$(MID$(sFile, dotPos+1))
IF sext = "exe" THEN
MSGBOX "Can't select file with 'exe' extension
' because this is a dialog we have to return "no" this way
SetWindowLong hWnd, %DWL_MSGRESULT, %TRUE
FUNCTION = %TRUE
EXIT FUNCTION
END IF
END IF
CASE %CDN_FOLDERCHANGE
'You get this message at the very start of the dialog, too
'Is this the 'forbidden' folder?
pAZ = @[email protected]
IF ISTRUE pAZ THEN ' a parameter was passed
' get name of new folder to which we just changed
SendMessage getParent(hWnd), %CDM_GETFOLDERPATH, _
SIZEOF(szPath), BYVAL VARPTR(szPath)
'enable or disable the OK button depending if this is
'or is not the forbidden folder
iEnable = ISFALSE( LCASE$(@pAZ) = LCASE$(szPath))
EnableWindow getDlgItem(GetParent(hWnd), %IDOK), iEnable
END IF
END SELECT ' of code
END SELECT ' of uMSG
END FUNCTION
' ============================================================
' EXPLORER-STYLE HOOK PROC FOR SAVE
' Centers the dialog on the desktop
' Prohibits selection of a read-only file. While this *result*
' can be obtained using the OFN_NOREADONLYRETURN flag in the OPENFILENAME
' structure, this allows you to customize the error message.
' Note, too, that because the initial OFN_OVERWRITEPROMPT flag was used,
' ============================================================
FUNCTION HookProcSave (BYVAL hWnd AS LONG, BYVAL uMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL pOFNotify AS OFNOTIFY PTR , _ ' get on WM_NOTIFY as lparam
w AS STRING
LOCAL pOFN AS OPENFILENAME PTR ' get on WM_INITDIALOG as lparam
LOCAL szFIle AS ASCIIZ * %MAX_PATH
LOCAL sFile AS STRING, dotPos AS LONG, sExt AS STRING
LOCAL YesOrNo AS LONG
SELECT CASE AS LONG uMSG
CASE %WM_INITDIALOG
' return: 0 to allow default proc to handle.
pOFN = lparam ' not used here, but could be
CALL CenterWindow (GetParent(hWnd)) ' center the common dialog box on desktop
FUNCTION = 0 ' allow default processing
CASE %WM_NOTIFY ' wparam unused. lparam = pOFNotify
pOfnotify = lparam
SELECT CASE AS LONG @pOFnotify.hdr.code
CASE %CDN_FILEOK
'If the hook procedure returns zero, the dialog box accepts
' the specified file name and closes.
'To reject the specified file name and force the dialog box to remain open,
' return a nonzero value from the hook procedure and call the SetWindowLong
' function to set a nonzero DWL_MSGRESULT value
' *******************************************
' REJECT AN EXISTING READ ONLY FILE
' AND CONFIRM OVERWRITE IF NOT READ ONLY
' *******************************************
' get name of the file the user want to use for 'save'
sFile = @[email protected]@lpstrfile
IF DIR$ (sFile) > "" THEN ' if the selected file exists already exists
IF (GETATTR (sFile) AND %READONLY) THEN
MSGBOX "Yo! You can't overwrite this file: it is read-only", _
%MB_APPLMODAL OR %MB_ICONHAND, "Save File Name Error"
SetWindowLong hWnd, %DWL_MSGRESULT, 1 '<< THIS IS A DIALOG!!
FUNCTION = 1
EXIT FUNCTION
ELSE
' had spurious %MB_I in styles here, removed 4/1/07
YesOrNo = MSGBOX ("Ok to Overwrite?", _
%MB_ICONQUESTION OR %MB_YESNO OR %MB_APPLMODAL, "Confirm")
IF YesOrNo <> %IDYES THEN
SetWindowLong hWnd, %DWL_MSGRESULT, 1 '<< THIS IS A DIALOG!!
FUNCTION = 1
EXIT FUNCTION
END IF
END IF
END IF
' if we get this far the default is to 'accept and return'
END SELECT ' of code
END SELECT ' of uMSG
END FUNCTION
'/// END OF FILE
4/1/07: Programmer error: used %BST_CHECKED instead of %DDT_CHECKED. Operation immaterial as these equates have same value, but loss of style points incurred. Shortened a few code lines so post can be read without horizontal scrolling.
4/2/07: Added LIMITATION statement re multiple files on open. Added date of COMDLG32.INC used.
------------------
Michael Mattias
Tal Systems Inc.
Racine WI USA
mailto:[email protected][email protected]</A>
www.talsystems.com
[This message has been edited by Michael Mattias (edited April 02, 2007).]
Comment