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, integer dwCreationFlags, integer @ lpThreadId

            DECLARE integer ResumeThread IN WIN32API integer thrdHandle

            DECLARE integer CloseHandle IN WIN32API integer Handle

            DECLARE integer GetProcessHeap IN WIN32API

            DECLARE integer HeapAlloc IN WIN32API integer hHeap, integer dwFlags, integer dwBytes

            DECLARE integer HeapFree IN WIN32API integer hHeap, integer dwFlags, integer lpMem

            DECLARE integer WaitForSingleObject IN WIN32API integer hHandle, integer dwMilliseconds

            DECLARE integer WaitForMultipleObjects IN WIN32API integer nCount, string pHandles, integer bWaitAll, integer dwMsecs

            DECLARE integer CLSIDFromProgID IN ole32 string lpszProgID, string @ strClSID

            DECLARE integer CLSIDFromString IN ole32 string lpszProgID, string @ strClSID

            DECLARE integer SysAllocString IN oleaut32 string wstr

            DECLARE integer SysFreeString IN oleaut32 integer bstr

            CREATE CURSOR memAllocs (memPtr i, AllocType c(1))    && track mem allocs that need to be freed: H=Heap,B=BSTR,L=Library

            this.hProcHeap = GetProcessHeap()

      PROCEDURE StartThreads(nThreads as Integer, ThreadCmd as String, ThreadProcParam as String,cStrIid as String )

            this.nThreads = nThreads

            cClsId=SPACE(16)

            IF CLSIDFromProgID(STRCONV("t1.c1"+CHR(0),5),@cClsId)!= 0   && dual interface

                  ?"Error: class not found"

                  RETURN

            ENDIF

            cIid=SPACE(16)

            CLSIDFromString(STRCONV(cStrIid+CHR(0),5),@cIid)

            nLocals = 30      && sufficiently large for local vars

            sCode=""          && generate machine code for thread procedure into a string

*           sCode = sCode + CHR(0xcc)     && int 3    DebugBreak() to attach a debugger

            sCode = sCode + CHR(0x55)                                                                 && push ebp

            sCode = sCode + CHR(0x8b) + CHR(0xec)                                               && mov ebp, esp

            sCode = sCode + CHR(0x81) + CHR(0xec)+BINTOC(nLocals * 4, "4rs") && sub esp, nLocals

 

            sCode = sCode + CHR(0x6a) + CHR(0x00)     && push 0

            sCode = sCode + this.CallDllFunction("CoInitialize", "ole32")

     

            sCode = sCode + this.GenCodeAtPoint("BeforeStart")

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xf0) && lea eax, [ebp-10h]   && addr to put COM ptr

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cIid),"4rs")      && mov eax, str

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0xb8) + BINTOC(CLSCTX_INPROC_SERVER+CLSCTX_LOCAL_SERVER,"4rs")      && mov eax, val

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0x6a) + CHR(0x00)     && push 0

            sCode = sCode + CHR(0xb8) + BINTOC(this.MakeStr(cClsId),"4rs")    && mov eax, str

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + this.CallDllFunction("CoCreateInstance", "ole32")

            sCode = sCode + this.GenCodeAtPoint("AfterCreating")

 

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h]   && local var to get the vtResult of the COM call

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + this.CallDllFunction("VariantInit", "oleaut32")   && Initialize the vtResult

 

            *call MyDoCmd via early binding. First push the parms

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h]   && pass the address of vtResult for return value

            sCode = sCode + CHR(0x50)     && push eax

            *Now we need to push 3 empty variants, each of which is 4 DWORDS

            sCode = sCode + CHR(0x33) + CHR(0xc0)     && xor eax,eax

            sCode = sCode + REPLICATE(CHR(0x50),12)   && push eax 12 times

           

            *2nd param is P2:

            sCode = sCode + CHR(0x33) + CHR(0xc0)     && xor eax,eax

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0x8)      && mov eax,[ebp+8]      && Form the P2 param as a Variant from the BSTR arg from the parent thread

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0x33) + CHR(0xc0)     && xor eax,eax

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0xb8) + BINTOC(VT_BSTR,"4rs")     && mov eax, VT_BSTR

            sCode = sCode + CHR(0x50)     && push eax

           

            *1st param is the expr for VFP to Exec.

            sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(ThreadCmd,.t.,.t.),"4rs") && mov eax, cExpr (p2 is 2nd param to MyDoCmd)

            sCode = sCode + CHR(0x50)     && push eax

 

            *Now make the call

            sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0)     && mov eax, [ebp-10h]   && the COM ptr

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0x8b) + CHR(0)  && mov eax, [eax] && et the vTable

            sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x1c)     && call  [eax+1ch] && call indirect the function at 1ch in the vTable

            sCode = sCode + this.GenCodeAtPoint("AfterCalling")

 

            *Free the return value with VariantClear because it's ignored

            sCode = sCode + CHR(0x8d) + CHR(0x45)+CHR(0xe0) && lea eax, [ebp-20h]

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + this.CallDllFunction("VariantClear", "oleaut32")

 

            sCode = sCode + this.GenEndCode(.t.)

 

            AdrCode=this.memAlloc(LEN(sCode),sCode)   && allocate memory for the code

            DIMENSION this.hThreads[nThreads]

            this.cThreadHandles=""

            FOR i = 1 TO nThreads

                  bstrArg=this.MakeStr(STRTRAN(ThreadProcParam,"%threadnum",TRANSFORM(i)),.t.,.t.)

                  dwThreadId=0

                  this.hThreads[i] = CreateThread(0,8192, AdrCode, bstrArg, CREATE_SUSPENDED, @dwThreadId)      && create suspended

                  this.hThreadIds[i]=dwThreadId

                  this.cThreadHandles = this.cThreadHandles+BINTOC(this.hThreads[i],"4rs")      && put the handles into a string rep of an int array

                  ResumeThread(this.hThreads[i])      && now start thread once all data is stored so no race condition

            ENDFOR

      PROCEDURE GenCodeAtPoint(nPoint as String) as String  && derived classes can override to gen code to exec at various points

            RETURN ""

      PROCEDURE GenEndCode(fRelease as Boolean) as String   && generate code to end thread

            LOCAL sCode

            sCode=""

            IF fRelease && do we also release COM obj?

                  *ptr->Release()

                  sCode = sCode + CHR(0x8b) + CHR(0x45) + CHR(0xf0)     && mov eax, [ebp-10h]

                  sCode = sCode + CHR(0x50)     && push eax             && push the THIS ptr

                  sCode = sCode + CHR(0x8b) + CHR(0)  && mov eax, [eax] && get the vTable

                  sCode = sCode + CHR(0xff) + CHR(0x50) + CHR(0x8)      && call  [eax+8h]

            ENDIF

           

            sCode = sCode + this.GenCodeAtPoint("BeforeEnd")

            sCode = sCode + this.CallDllFunction("CoUninitialize", "ole32")

 

            sCode = sCode + CHR(0x33) + CHR(0xc0)     && xor eax,eax    && make ExitCodeThread= 0

            sCode = sCode + CHR(0x8b) + CHR(0xe5)     && mov esp, ebp

            sCode = sCode + CHR(0x5d)                       && pop ebp       

            sCode = sCode + CHR(0xc2)+CHR(0x04)+CHR(0x00)   && ret 4

            RETURN sCode

 

      PROCEDURE WaitForThreads(cExpr as String)

            DO WHILE WaitForMultipleObjects(this.nThreads, this.cThreadHandles, 1, 500) = WAIT_TIMEOUT      && wait msecs for the threads to finish

                  &cExpr      && execute any passed in param while waiting

            ENDDO

      PROCEDURE MemAlloc(nSize as Integer, cStr as String) as Integer

            LOCAL nAddr

            nAddr = HeapAlloc(this.hProcHeap, 0, nSize)     && allocate memory

            ASSERT nAddr != 0 MESSAGE "Out of memory"

            INSERT INTO memAllocs VALUES (nAddr,"H") && track them for freeing later

            SYS(2600,nAddr, LEN(cStr),cStr)           && copy the string into the mem

            RETURN nAddr

      PROCEDURE CallDllFunction(strExport as String, strDllName as String) as String

            *Create a string of machine code that calls a function in a DLL. Parms should already be pushed

            LOCAL nAddr as Integer, hModule as Integer

            hModule = LoadLibrary(strDllName)

            INSERT INTO memAllocs VALUES (hModule,"L")      && track loads for freeing later

            nAddr=GetProcAddress(hModule,strExport)

            ASSERT nAddr != 0 MESSAGE "Error: Export not found "+ strExport+" "+ strDllName

            RETURN CHR(0xb8)+BINTOC(nAddr,"4rs") + CHR(0xff) + CHR(0xd0)      && mov eax, addr; call eax

      PROCEDURE MakeStr(str as String, fConvertToUnicode as Logical, fMakeBstr as Logical) as Integer

            * converts a string into a memory allocation and returns a pointer

            LOCAL nRetval as Integer

            IF fConvertToUnicode

                  str=STRCONV(str+CHR(0),5)

            ELSE

                  str = str + CHR(0)      && null terminate

            ENDIF

            IF fMakeBstr

                  nRetval= SysAllocString(str)

                  ASSERT nRetval != 0 MESSAGE "Out of memory"

                  INSERT INTO memAllocs VALUES (nRetval,"B")      && track them for freeing later

            ELSE

                  nRetval= this.MemAlloc(LEN(str),str)

            ENDIF

            RETURN nRetval

      PROCEDURE Destroy

            LOCAL i

*           ?PROGRAM()

            SELECT memAllocs

            SCAN

                  DO CASE

                  CASE AllocType="B"      && BSTR

                        SysFreeString(memPtr)

                  CASE AllocType="H"      && Heap

                        HeapFree(this.hProcHeap,0,memPtr)

                  CASE AllocType="L"      && LoadLibrary

                        FreeLibrary(memPtr)

                  ENDCASE

            ENDSCAN

            FOR i = 1 TO this.nThreads

                  CloseHandle(this.hThreads[i])

            ENDFOR

ENDDEFINE

 

DEFINE CLASS ThreadClassEx as ThreadClass

      cDoneCmd =""

      PROCEDURE GenCodeAtPoint(sPoint as String) as String

            LOCAL sCode,nPatch

            sCode=""

            DO CASE

            CASE sPoint = "BeforeStart"

*                 sCode = sCode + CHR(0x6a) + CHR(0x00)     && push 0

*                 sCode = sCode + this.CallDllFunction("MessageBeep", "user32")     && MessageBeep(0)

            CASE sPoint = "BeforeEnd"

*                 sCode = sCode + this.GenMessageBox("BeforeThreadEnd","Thread Proc")

            CASE sPoint = "AfterCreating"

*           sCode = sCode + CHR(0xcc)     && int 3    DebugBreak() to attach a debugger

                  sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00)     && cmp eax, 0     && check return value

                  sCode = sCode + CHR(0x74)+CHR(0x00) && je nBytes && nBytes calc'd below. je= Jump if Equal

                  nPatch = LEN(sCode)     && track the byte that needs patching

                  sCode = sCode + this.GenMessageBox("Error "+sPoint+" COM object","Thread Proc")

                  sCode = sCode + this.GenEndCode(.f.)      && generate end thread code, without release

                  sCode=LEFT(sCode,nPatch-1) + CHR(LEN(sCode)-nPatch)+ SUBSTR(sCode,nPatch+1)      && now fix up the jump location to jump around GenEndcode

            CASE sPoint = "AfterCalling"

*           sCode = sCode + CHR(0xcc)     && int 3    DebugBreak() to attach a debugger

                  sCode = sCode + CHR(0x83) + CHR(0xf8) + CHR(0x00)     && cmp eax, 0     && check return value

                  sCode = sCode + CHR(0x74)+CHR(0x00) && je nBytes && nBytes calc'd below. je= Jump if Equal

                  nPatch = LEN(sCode)     && track the byte that needs patching

                  sCode = sCode + this.GenMessageBox("Error "+sPoint+" COM object","Thread Proc")

                  sCode = sCode + this.GenEndCode(.t.)      && generate end thread code, with release

                  sCode=LEFT(sCode,nPatch-1) + CHR(LEN(sCode)-nPatch)+ SUBSTR(sCode,nPatch+1)      && now fix up the jump location to jump around GenEndcode

            OTHERWISE

                  ASSERT .f. MESSAGE "Unknown GenCodeCase "+sPoint

            ENDCASE

      RETURN sCode

      PROCEDURE GenMessageBox(strMessage as String, strCaption as String) as String

            LOCAL sCode

            * MessageBox: call the Unicode (Wide char) version

            sCode = CHR(0x6a) + CHR(0x00) && push 0

            sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(strCaption,.t.),"4rs")    && mov eax, str

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0xb8)+BINTOC(this.MakeStr(strMessage,.t.),"4rs")    && mov eax, str

            sCode = sCode + CHR(0x50)     && push eax

            sCode = sCode + CHR(0x6a) + CHR(0x00)     && push 0

            sCode = sCode + this.CallDllFunction("MessageBoxW", "user32")

      RETURN sCode

ENDDEFINE

 

DEFINE CLASS ThreadManager AS Session

      nThreads = 0

      nLiveThreads=0

      hAbortEvent=0

      DIMENSION aoThread[1]

      PROCEDURE init

            DECLARE integer CreateEvent IN WIN32API integer lpEventAttributes, integer bManualReset, integer bInitialState, string lpName

            DECLARE integer GetLastError IN WIN32API

            DECLARE integer SetEvent IN WIN32API integer

            DECLARE integer ResetEvent IN WIN32API integer

            DECLARE integer Sleep in WIN32API integer

            this.hAbortEvent = CreateEvent(0,1,0,"VFPAbortThreadEvent")

            IF this.hAbortEvent = 0

                  ?"Creating event error:",GetLastError()

            ELSE

                  IF GetLastError()=ERROR_ALREADY_EXISTS

                        ResetEvent(this.hAbortEvent)

                  ENDIF

            ENDIF

      PROCEDURE CreateThread(ThreadProc as String, ThreadProcParam as String,cDoneCmd as string)

            IF VARTYPE(ThreadProc)='C'    && with parms on constructor, create a single thread per class instance

                  DIMENSION this.aoThread[this.nThreads+1]

                  oThread=CREATEOBJECT("ThreadClassEx")

                  this.aoThread[this.nThreads+1]=oThread

                  cStrIid="{00020400-0000-0000-C000-000000000046}"      && IID_IDispatch

                  IF VARTYPE(cDoneCmd)='C'      && user specified a cmd to exec after thread done

                        oThread.cDoneCmd = cDoneCmd

                        BINDEVENT(_screen.HWnd, WM_USER, this,"ThreadAlmostFinishedEvent")

                  ENDIF

                  oThread.StartThreads(1, "do "+SYS(5)+CURDIR()+ThreadProc+" WITH p2",TRANSFORM(_screen.hWnd)+","+ThreadProcParam,cStrIid)

                  this.nLiveThreads=this.nLiveThreads+1

                  this.nThreads = this.nThreads+1     && increment as last step after threads created

            ENDIF

      PROCEDURE SendMsgToStopThreads

            SetEvent(this.hAbortEvent)

      PROCEDURE ThreadAlmostFinishedEvent(hWnd as Integer, Msg as Integer, wParam as Integer, lParam as Integer)

            LOCAL i,hThread  

            FOR i = 1 TO this.nThreads    && Which thread is almost finished?

                  IF TYPE("this.aoThread[i]")='O' AND lParam = this.aoThread[i].hThreadIds[1]

                        hThread = this.aoThread[i].hThreads[1]

                        cDoneCmd =this.aoThread[i].cDoneCmd

                        EXIT

                  ENDIF

            ENDFOR

            DO WHILE  WaitForSingleObject(hThread,0)=WAIT_TIMEOUT && wait til it's totally done

                  Sleep(100)

            ENDDO 

            this.aoThread[i]=0      && release the thread object

            &cDoneCmd   && Execute caller's done command

            this.nLiveThreads=this.nLiveThreads-1

      PROCEDURE destroy

            *Danger: don't release threads if still alive! Watch out for race condition waiting for them to finish               

            DO WHILE this.nLiveThreads>0

                  ?"Waiting for threads in destroy"        

                  Sleep(1000)

            ENDDO

            UNBINDEVENTS(_screen.HWnd,WM_USER)

            IF this.hAbortEvent>0

                  CloseHandle(this.hAbortEvent)

            ENDIF

ENDDEFINE