More Multithread capabilities: interthread synchronization, error checking
In a prior post: Create multiple threads from within your application, there is a sample Thread Class that can be used to create multiple threads that can execute VFP code.
Today’s sample presents code that demonstrates how a thread can send messages to another thread, such as “I’m almost done” or “Please abort what you’re doing”. Other inter-thread communication techniques can be used, such as placing work items into a shared table.
To construct today’s sample, save the code below to THREADS.PRG. It will be reused later in future samples. Much of the code is in the prior post as class ThreadClass, but with minor modifications.
The sample creates 3 threads: each thread is given the task of gathering file information from 3 different directories and placing it into a table.
oThreads=CREATEOBJECT("ThreadManager")
oThreads.CreateThread("MyThreadFunc","c:\","ThreadDone(1)")
oThreads.CreateThread("MyThreadFunc","c:\Windows\","ThreadDone(2)")
oThreads.CreateThread("MyThreadFunc","c:\Windows\System\","ThreadDone(3)")
As you can see, the ThreadManager class has made it even easier to create threads in VFP. Just pass the name of a function, a parameter to pass to that function, and any code to execute once the thread has finished executing. There is a call to BindEvent to bind the VFP window handle to the message WM_USER. When a thread is almost finished, it will use PostMessage to send a message to _screen.hWnd. I say “almost” because the thread must still be active to post a message. The main thread then figures out which thread is almost finished, waits for it to completely finish, then executes the user specified Done command. I had to modify the base class ThreadClass to store the Thread IDs because the API GetThreadId isn’t available on Windows XP (Only on Windows Server 2003 or Vista<sigh>.)
The code uses a Critical Section to synchronize thread access to a shared resource. It surrounds the creation of the file “FILES.DBF” with a critical section via SYS(2336). Try running the code without the CritSects and see what happens!
ThreadManager has a method SendMsgToStopThreads which uses CreateEvent to create a named event, which can be queried in the thread code which can then exit gracefully. Notice that all threads use the same named event, so setting it once will stop all threads.
The base class ThreadClass calls a method called GenCodeAtPoint, which does nothing but return an empty string. The ThreadClassEx subclass overrides that method and generates some code for error checking. If there is an error, it puts up a MessageBox.
Try running the code multiple times. Try with and without the SendMsgToStopThreads call after various time intervals, and including/excluding the DesiredDuration Sleep to make the thread take longer. Try making it take a long time and then start something in the VFP main window. I tried running Task Manager and a Query Wizard while the background threads were still going!
Be careful when modifying the code: it’s easy to create a race condition. For example, if the allocated memory gets freed (ThreadClass.Destroy) before the thread terminates, then Crash!.
In a near future post, I’ll show a web crawler that runs on a background thread.
oThreads=0 && just in case some threads still alive, fire destructor before anything else gets released
CLEAR ALL
CLEAR
#define WAIT_TIMEOUT 258
#define WM_USER 0x400
SET EXCLUSIVE OFF
SET SAFETY OFF
SET ASSERTS ON
CREATE TABLE ThreadLog (threadid i, timestamp t,misc c(80)) && A table into which each thread will insert results
USE ThreadLog && open shared
TEXT TO cstrVFPCode TEXTMERGE NOSHOW && generate the task to run: MyThreadFunc
PROCEDURE MyThreadFunc(p2) && p2 is the 2nd param to MyDoCmd
TRY && use exception handling
DECLARE integer GetCurrentThreadId in WIN32API
DECLARE integer PostMessage IN WIN32API integer hWnd, integer nMsg, integer wParam, integer lParam
cPath=SUBSTR(p2,AT(",",p2)+1)
hWnd=INT(VAL(p2))
CREATEOBJECT("SearchDisk",cPath)
PostMessage(hWnd, WM_USER, 0, GetCurrentThreadId()) && Tell main thread we're just about done!
CATCH TO oex
INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),p2+" Error: "+oex.message+" "+oex.details+" "+TRANSFORM(oex.lineno))
ENDTRY
DEFINE CLASS SearchDisk as Session
hAbortEvent=0
PROCEDURE init(cPath)
DECLARE integer CreateEvent IN WIN32API integer lpEventAttributes, integer bManualReset, integer bInitialState, string lpName
DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds
DECLARE integer GetLastError IN WIN32API
this.hAbortEvent = CreateEvent(0,0,0,"VFPAbortThreadEvent") && Get the existing event
IF this.hAbortEvent = 0
THROW "Creating event error:"+TRANSFORM(GetLastError())
ENDIF
DECLARE integer Sleep in WIN32API integer
DECLARE integer CloseHandle IN WIN32API integer
nStart=SECONDS()
fUseCritSects=.t. && try with .f.
IF fUseCritSects
SYS(2336,1) && Enter a critical section. First thread in wins
ENDIF
IF !FILE("files.dbf")
IF !fUseCritSects
Sleep(1000) && give a chance for other threads to come in here!
ENDIF
CREATE TABLE files (path c(100), size n(10))
ENDIF
USE files SHARED && reopen shared
IF fUseCritSects
SYS(2336,2) && Exit the critical section
ENDIF
cResult = TRANSFORM(this.RecurPath(cPath)) && search disk to gather files into table. Returns file count
nDuration = SECONDS()-nStart
nDesiredDuration=5 && # secs
IF nDuration < nDesiredDuration && let's make the thread proc last longer: OS caches disk results
* Sleep((nDesiredDuration - nDuration)*1000)
ENDIF
IF this.IsThreadAborted() && if main thread said to abort
cResult=cResult+ " Aborted"
ENDIF
INSERT INTO <<DBF()>> VALUES (GetCurrentThreadId(), DATETIME(),TRANSFORM(cPath)+":"+cResult)
PROCEDURE IsThreadAborted as Boolean
IF WaitForSingleObject(this.hAbortEvent,0) = WAIT_TIMEOUT
RETURN .f.
ENDIF
RETURN .t.
PROCEDURE RecurPath(cPath as String) as Integer
LOCAL n,i,aa[1],nRetval
nRetval=0
n = ADIR(aa,cPath+"*.*","D")
FOR i = 1 TO n
IF "D"$aa[i,5] && if it's a dir
IF aa[i,1] != '.'
* nRetval=nRetval + this.RecurPath(cPath+aa[i,1]+"\") && be careful!
ENDIF
ELSE
INSERT INTO files VALUES (cPath+aa[i,1], aa[i,2])
nRetval=nRetval+1
IF this.IsThreadAborted() && Did main thread request abort
EXIT
ENDIF
ENDIF
ENDFOR
RETURN nRetval
PROCEDURE Destroy
CloseHandle(this.hAbortEvent)
ENDDEFINE
ENDTEXT
STRTOFILE(cstrVFPCode,"MyThreadFunc.prg")
COMPILE MyThreadFunc.prg
ERASE files.dbf && reinit
?"Starting Threads",SECONDS()
PUBLIC nThreadsAlive && Track # of threads still around
nThreadsAlive=3
PUBLIC oThreads
oThreads=CREATEOBJECT("ThreadManager")
oThreads.CreateThread("MyThreadFunc","c:\","ThreadDone(1)")
oThreads.CreateThread("MyThreadFunc","c:\Windows\","ThreadDone(2)")
oThreads.CreateThread("MyThreadFunc","c:\Windows\System\","ThreadDone(3)")
INKEY(.1) && idle a bit: lets see how many files we get, before we stop the threads
TRY
oThreads.SendMsgToStopThreads() && might have already been released
CATCH TO oEx
?oEx.message
ENDTRY
RETURN
PROCEDURE ThreadDone(nThread)
nThreadsAlive=nThreadsAlive-1
IF nThreadsAlive=0 && If all threads done
ACTIVATE screen && in case user activated a form
?"All threads done",SECONDS()
nDatasession =SET("Datasession")
SET DATASESSION TO 1
SELECT ThreadLog
FLOCK() && make sure we refresh results from other threads
LIST
SELECT 0
USE files
?TRANSFORM(RECCOUNT())+" files found "
SET DATASESSION TO (nDataSession)
RELEASE oThreads
ENDIF
RETURN
#define CREATE_SUSPENDED 0x00000004
#define INFINITE 0xFFFFFFFF
#define WAIT_TIMEOUT 258
#define ERROR_ALREADY_EXISTS 183
#define CLSCTX_INPROC_SERVER 1
#define CLSCTX_LOCAL_SERVER 4
#define VT_BSTR 8
DEFINE CLASS ThreadClass as session
hProcHeap =0
nThreads=0
DIMENSION hThreads[1] && Handle to each thread
DIMENSION hThreadIds[1] && ID for each thread
cThreadHandles="" && Handle to each thread as a string rep of an int array
PROCEDURE Init
DECLARE integer LoadLibrary IN WIN32API string
DECLARE integer FreeLibrary IN WIN32API integer
DECLARE integer GetProcAddress IN WIN32API integer hModule, string procname
DECLARE integer CreateThread IN WIN32API integer lpThreadAttributes, ;
integer dwStackSize, integer lpStartAddress, integer lpParameter,