Tweet
Discussion thread here.
Code:
' Program1.BAS
' Demonstration of using a worker thread in GUI program, with screen updating and abort function
' Author: Michael Mattias Racine WI
' Date : November 24 2007
' Compiler: PB/Windows 8.03
' Use/Distribution: Placed in public domain by author 11/24/07
' ----------------------------------------------------------------------------------------------------
' Comments. "Processing" the file for this demo means simply reading each record
' and periodically reporting the number of records read. In Real Life
' you'd be doing something else. For demonstration purposes:
' 1. The file is completely 'processed' %NUMBER_CYCLES times before the thread
' function is deemed to have "completed processing"
' 2. When the file is small, it's just too fast to actually get a feel for what's going on
' unless the SLEEP 5 is included in the 'read' (LINE INPUT #) loop
' 3. Look Ma, no GLOBALs!
' 4. Look Ma, no polling a flag variable!
' ---------------------------------------------------------------------------------------------------
#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"
#INCLUDE "COMDLG32.INC" ' for OpenFileDialog
' Get message from GetLastError as string
FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
LOCAL Buffer AS ASCIIZ * 255
FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
FUNCTION = FORMAT$(ECode, "##### ") & Buffer
END FUNCTION
'==[End Windows API Header Files]============================
' --------------------------
' CONTROLS ON MAIN SCREEN
' --------------------------
%ID_TIMER = 101 ' will be continuously updated whilst running
%ID_DATETIME = 102
%ID_FILENAME = 105 ' pick the file to be 'processed'
%ID_FILENAME_BROWSE = 106
%ID_START = 111
%ID_ABORT = 112
%ID_Progress = 115 ' text control telling us what worker thread is doing.
%DLG_STYLE = %WS_VISIBLE OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX
' DIALOG SET USER slots
%DSU_HWND = 1 ' handle to main dialog
%DSU_HTHREAD = 2 ' if true, it's an open handle to an executing worker thread
%DSU_HEVENTREADY = 3 '
%DSU_FILENAME_PTR = 4
$EVENT_ABORT = "Abort_Worker_Thread_Event"
%NUMBER_CYCLES = 10 ' number of times the target file will be 'processed' before thread
' function ends if worker thread not aborted.
%PROGRESS_MODULO = 50 ' update screen every this many records
MACRO m_CreateThreadReadyEvent = CreateEvent (BYVAL %NULL, BYVAL %TRUE, BYVAL %FALSE, BYVAL %NULL)
' private window message:
%PWM_THREAD_FUNCTION_COMPLETED = %WM_USER + 1 ' posted to main window on completion. lPAram= Aborted (True/False)
' -----------------------------------------------------
' PROGRAM 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 NEW %NULL, "Worker Thread With Abort Demo", 10,10, 300,200, %DLG_STYLE TO hDlg
CONTROL ADD LABEL, hDlg, %ID_DATETIME, "", 200, 10, 90, 12
CONTROL ADD TEXTBOX, hDlg, %ID_FILENAME, "", 10, 24, 220,12
CONTROL ADD BUTTON, hDlg, %ID_FILENAME_BROWSE, "&Browse", 241, 24, 40, 14
CONTROL ADD BUTTON, hDLg, %ID_START, "&Start", 10, 40, 40, 14
CONTROL ADD BUTTON, hDlg, %ID_ABORT, "&Abort", 10, 56, 40, 14
CONTROL ADD LABEL, hDlg, %ID_PROGRESS, "Nothing Happening", 10, 80, 280, 48
DIALOG SHOW MODAL hDlg, CALL DlgProc
END FUNCTION ' WinMain
' ----------------------------------------------------------------
' Helper Function to abort the designated worker Thread function.
' Should never be called unless a worker thread is running
' ----------------------------------------------------------------
FUNCTION AbortWorkerThread (BYVAL hWnd AS LONG, BYVAL hThread AS LONG ) AS LONG
LOCAL hEvent AS LONG, szEvent AS ASCIIZ * 128
LOCAL bInherit AS LONG
LOCAL iWait AS LONG
' get handle to abort event so we can signal it
szEvent = $EVENT_ABORT
bInherit = %FALSE ' we will not be passing this handle to any other process
hEvent = OpenEVent (%EVENT_ALL_ACCESS, bINherit, szEvent)
' OpenEvent will fail if the event does not exist; but that means the worker thread is not running;
' meaning either this function was called when it shouldn't have been; OR.... the thread function
' ended 'normally' between the time the abort command is issued and "now."
' However, waiting on the thread handle is safe, since that handle cannot be closed yet.
IF ISTRUE hEvent THEN
SetEvent hEvent
END IF
' wait for the thread function to end (which it may have even before we got here):
iWait = WaitForSingleObject (hThread, %INFINITE)
' close our handle to abort event (clean up)
' The thread handle is closed in DlgProc when this function returns
CloseHandle hEvent
END FUNCTION
'----------------------------------
' MAIN WINDOW PROCESSOR
'----------------------------------
CALLBACK FUNCTION DlgPRoc () AS LONG
LOCAL sText AS STRING
LOCAL hThread AS LONG, hEventReady AS LONG
LOCAL iRet AS LONG
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' disable Abort button, Start button waiting for file to be selected
CONTROL DISABLE CBHNDL, %ID_START
CONTROL DISABLE CBHNDL, %ID_ABORT
' set up a timer so we can see that the screen is always updating
' one second (1000 millisecond) update period. We don't need the return value
SetTimer CBHNDL, %ID_TIMER, 1& * 1000&, BYVAL %NULL
CASE %WM_TIMER
' update the timer label with the current time
sText = DATE$ & " " & TIME$
CONTROL SET TEXT CBHNDL, %ID_DATETIME, sText
CASE %WM_SYSCOMMAND
IF (CBWPARAM AND &hFFF0) = %SC_CLOSE THEN
DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hThread
IF ISTRUE hThread THEN
MSGBOX "Must abort worker thread function " & $CRLF _
& "(or wait for it to complete) to exit", _
%MB_APPLMODAL OR %MB_ICONHAND, "Can't Exit Now"
' Return True To prevent default action (close).
FUNCTION = %TRUE
EXIT FUNCTION
END IF
END IF
CASE %WM_DESTROY
' we should never get here unless it's OK to exit
' kill the timer
KillTimer CBHNDL, %ID_TIMER
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %ID_START
' should not be enabled unless the file in the filename control is available
' create a ready event and save in the designated dialog user value slot
' start a worker thread, passing handle to the dialog
' create a ready event:
hEventReady = m_CreateThreadReadyEvent
' store it where our thread function can read it:
DIALOG SET USER CBHNDL, %DSU_HEVENTREADY, hEVentReady
' get filename and set the pointer; cannot use CONTROL GET TEXT from thread function
' since this thread is in a Wait State
CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
DIALOG SET USER CBHNDL, %DSU_FILENAME_PTR, VARPTR(sText)
' create suspended, set priority, and resume:
THREAD CREATE WorkerThreadFunction (CBHNDL) SUSPEND TO hThread
SetThreadPriority hThread, %THREAD_PRIORITY_BELOW_NORMAL
THREAD RESUME hThread TO iRet ' hard to believe the "TO var" is REQUIRED huh?
' wait for the thread function to copy its run parameters:
WaitForSingleObject hEventReady, %INFINITE
' clean up
CloseHandle hEventReady
' Save the (open) thread handle
DIALOG SET USER CBHNDL, %DSU_HTHREAD, hThread
' now that thread function has started, disable the start and enable the abort buttons
CONTROL DISABLE CBHNDL, %ID_START
CONTROL ENABLE CBHNDL, %ID_ABORT
' -------------------------------------------------------------------
' HERE IS THE POINT WHERE YOU WOULD DISABLE/ENABLE *ALL* CONTROLS
' WHOSE ENABLE STATUS DEPENDS IF A WORKER THREAD IS RUNNING OR NOT.
' -------------------------------------------------------------------
CASE %ID_ABORT
' should not be enabled unless a worker thread is running.
DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hTHREAD
CALL AbortWorkerThread (CBHNDL, hThread)
' this will (eventually) post a completion message to this window,
' at which time we close the thread handle
CASE %ID_FILENAME_BROWSE
'FUNCTION OpenFileDialog (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
' ) AS LONG
sText = ""
IF OpenFileDialog(CBHNDL, "Select File to Process", sText, "", "*.*","", %OFN_FILEMUSTEXIST) THEN
CONTROL SET TEXT CBHNDL, %ID_FILENAME, sText
' this will trigger an EN_CHANGE which will enable the ID_START if it should be enabled
END IF
CASE %ID_FILENAME
' check if the file is avaiable and no worker thread is running already,
' if so enable the start button
IF CBCTLMSG = %EN_CHANGE THEN
DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hThread
IF ISFALSE hThread THEN ' no worker thread is running, so we can enable
' the 'go' button if this file is valid
CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
IF DIR$ (sText) > "" THEN
CONTROL ENABLE CBHNDL, %ID_START
ELSE
CONTROL DISABLE CBHNDL, %ID_START
END IF
END IF
END IF
END SELECT
CASE %PWM_THREAD_FUNCTION_COMPLETED
SText = "Worker Thread Function Completed via " & IIF$(CBLPARAM, "Manual Abort", "Natural Causes")
CONTROL SET TEXT CBHNDL, %ID_PROGRESS, Stext
' diasable abort
CONTROL DISABLE CBHNDL, %ID_ABORT
' close the open Thread handle
DIALOG GET USER CBHNDL, %DSU_HTHREAD TO hThread
THREAD CLOSE hThread TO hThread
DIALOG SET USER CBHNDL, %DSU_HTHREAD, %NULL ' set to %NULL so we know no worker thread
' function is currently exectuting.
' enable the start button if we have a valid file in the control
CONTROL GET TEXT CBHNDL, %ID_FILENAME TO sText
IF DIR$ (sText) > "" THEN
CONTROL ENABLE CBHNDL, %ID_START
END IF
' -------------------------------------------------------------------
' HERE IS THE POINT WHERE YOU WOULD DISABLE/ENABLE *ALL* CONTROLS
' WHOSE ENABLE STATUS DEPENDS IF A WORKER THREAD IS RUNNING OR NOT.
' (HERE THREAD FUNCTION IS *NOT* RUNNING).
' -------------------------------------------------------------------
END SELECT
END FUNCTION
' ----------------------------------------------------------
' Worker thread function. Processes the current file by reading it
' %NUMBER_CYCLES times or until manually aborted, then exits after
' posting a private message to the calling Window/Dialog (passed parameter).
' ----------------------------------------------------------
FUNCTION WorkerThreadFunction (BYVAL hDlg AS LONG) AS LONG
LOCAL sFile AS STRING, hFile AS LONG, nRecord AS LONG, Z AS LONG, W AS STRING, S AS STRING
LOCAL sTExt AS STRING, iRecord AS LONG
LOCAL pFilename AS STRING PTR
' ------Wait Variables ------
LOCAL heventReady AS LONG
LOCAL bWaitAll AS LONG
LOCAL iWait AS LONG
'----- event variables ------
LOCAL szEventAbort AS ASCIIZ * 64, hEvent() AS LONG
LOCAL lpSecurity AS SECURITY_ATTRIBUTES PTR
LOCAL bManualReset AS LONG, bInitialState AS LONG
LOCAL bAbort AS LONG
LOCAL SE AS LONG
' ---------------------------------------------------------------
' Get our thread parameters into LOCAL variables before allowing
' the calling thread to continue.
' ----------------------------------------------------------------
DIALOG GET USER hDlg, %DSU_HEVENTREADY TO hEventReady
DIALOG GET USER hDlg, %DSU_FILENAME_PTR TO pFileName
' -----------------------------------------------------------------------------------------------------
' I had to use a string ptr here instead of CONTROL GET TEXT because the calling thread was in a wait
' state (WaitForSingleObject) and apparently (undocumented but not reasonably) CONTROL GET TEXT does
' "something" which must execute in the context of the same thread (suspended) as the dialog.
' Apparently (that means also not documented), DIALOG GET USER does not need to execute anything in the
' context of the thread in which the dialog was created.
' -----------------------------------------------------------------------------------------------------
sFile = @pFileName
' signal the calling thread we have copied our parameters and it may continue
SetEvent hEventReady
' ------------Set up processing events -------------------------------------------------
' We will be looking for two events: an 'abort' event and a 'continue' event.
' WaitForMultipleObjects will suspend this thread until EITHER event is signalled.
' The 'continue' event is created in a signalled state and remains in that state;
' the abort event is created unsignalled, and is signalled by calling SetEvent() at the
' appropriate times.
' We want the abort event to be first (in the array assed to WaitForMultipleObjects), since
' WFMO returns the LOWEST (first) event which is signalled when more than one
' event is signalled.
REDIM hEvent(1) ' we need to monitor two events in total
' Create our abort event as first event in the array
' We use a named event so other parts of the program have access to it.
szEventAbort = $EVENT_ABORT
bManualReset = %TRUE ' The only choice for control freaks. Actually it's immaterial in this program.
lpSecurity = %NULL ' null pointer ==> Default security
bInitialSTate = %FALSe ' create unsignalled.
hEvent(0) = CreateEvent (BYVAL lpSecurity, bManualreset, bInitialState, szEventAbort)
' Create an unnamed event in signalled state as event #2, so worker thread processes forever -
' or at least processes until it completes the task or is manually aborted.
bManualReset = %TRUE ' Do not allow system to reset this to unsignalled
' which it will do if not manual reset type!
bInitialState = %TRUE ' Create this event signalled so wait will be satisfied.
' This event does not need a name: no other functions need access to it!
hEvent(1) = CreateEvent ( BYVAL lpSecurity, bManualReset, bInitialState, BYVAL %NULL)
' set parameter for the wait:
bWaitAll = %FALSE ' we want WFMO to return when EITHER event is signalled (or both).
' --------------------------------------------
' PROCESS THE FILE %NUMBER_CYCLE TIMES
' --------------------------------------------
FOR Z = 1 TO %NUMBER_CYCLES
hFile = FREEFILE
OPEN sFile FOR INPUT AS hFile
FILESCAN hFile, RECORDS TO nRecord
w = USING$ ("Scanned #, Records for cycle # of # ", nRecord, Z, %NUMBER_CYCLES)
CONTROL SET TEXT hDlg, %ID_PROGRESS, W
iRecord = 0& ' record counter for each cycle
' now process each record of the file
DO
' Wait until either the abort event (object 1) or the continue event (object 2) is signalled.
' Since 'continue' is ALWAYS signalled, this function will always return immediately
' and it's just a matter of deciding if Abort was signalled or not.
' iWait will be the LOWEST of the the signalled events when more than one event is signalled.
iWait = WaitForMultipleObjects (BYVAL 2&, BYVAL VARPTR(hEvent(0)), bWaitAll, %INFINITE)
SE = GetLastError
SELECT CASE AS LONG iWait
CASE %WAIT_OBJECT_0 ' first event, the abort, satisfied the waut
bAbort = %TRUE
EXIT DO
CASE %WAIT_OBJECT_0 + 1 ' second event, the "please continue" , satisfied the wait.
IF NOT EOF(hFile) THEN
LINE INPUT #hFile, S
INCR iRecord
IF iRecord MOD %PROGRESS_MODULO = 0 THEN
sText = USING$ ("Processed #, of #, Records in Cycle # of #", iRecord, nrecord, Z, %NUMBER_CYCLES)
CONTROL SET TEXT hDlg, %ID_PROGRESS, sText
END IF
' way too fast to demo unless I code a delay in here (with small file)
SLEEP 5
ELSE ' end of file
' set cool message
sText = USING$ ("All #, records processed in Cycle #", nRecord, Z)
CONTROL SET TEXT hDlg, %ID_PROGRESS, sText
EXIT DO
END IF
CASE ELSE
' needless to say, you should not get here. Ever.
MSGBOX "Oops!" & SystemErrorMessageText (SE)
EXIT DO
END SELECT
LOOP
CLOSE hFile ' done with this cycle
' Go again? or all done?
IF bAbort THEN
EXIT FOR
END IF
NEXT Z ' repeat file processing
' Close our handles to both events since we are done with them
' Since we acquired the handles in this procedure, we should close them here. No, that's not
' any kind of "rule" but it is IMNSHO a "Best Programming Practice"
CloseHandle hEvent(0)
CloseHandle hEvent(1)
' post message to calling window with results; set lparam = the abort status
DIALOG POST hDlg, %PWM_THREAD_FUNCTION_COMPLETED, %NULL, bAbort
END FUNCTION
'/// END OF FILE