Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

GUI + Worker Thread + Abort Demo

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • GUI + Worker Thread + Abort Demo

    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
    Last edited by Michael Mattias; 9 Dec 2014, 10:33 AM. Reason: added link to discussion thread
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com
Working...
X