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, 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


 

Comments (24)

  1. SednaY says:

    I’ve got it working pretty smoothly now with MsgWaitforMultipleObjects.  The main VFP thread stays totally responsive.  The only problem now is that the CreateMessage does not work on Windows 2000 Server for some reason. Any ideas???

  2. a-jeffle says:

    Way cool!  Thanks!

  3. Tracy.P says:

    I’m having problems getting this running.

    XP Home SP 2, VFP 9 SP 1, the following line returns !=0 giving me problems.

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

  4. claudefox says:

    Tracy, did you create T1 and compile as an mtdll.  It sounds like your T1 vfp mtdll is not there…

  5. Tracy.P says:

    That was my problem. Thanks Claude

  6. Calvin_Hsia says:

    SednaY: I don’t see CreateMessage anywhere in the code. Do you mean CreateEvent? or PostMessage? I also don’t see MsgWaitForMultipleObjects anywhere.

    Are you able to run the code with no changes? the main thread is free to do other things like start the Task Pane in this sample.

  7. SednaY says:

    Sorry for not being a little clearer.  I meant CreateThread, not CreateMessage.  It’s working on XP Pro but the same code is not working on Win2k Server.

    Yes, I got it working.  As a possible improvement, you could use MsgWaitForMultipleObjects instead of WaitForMultipleObjects – that leaves the main VFP thread responsive.

  8. Calvin_Hsia says:

    SednaY: it works fine for me unmodified in Win2003 server. What are the symptoms of failure on Win2k Server? Can you get the simplest example working? (the one from http://blogs.msdn.com/calvin_hsia/archive/2006/05/11/595562.aspx)

  9. SednaY says:

    I started from scratch and both examples do work on Win2K server.  Looks like I messed up the code I was originally experimenting with.  Thanks  

  10. Today’s sample shows how to create a web crawler in the background. This crawler starts with a web page,…

  11. Groggy says:

    Hi, I’ve just come across your code.  This will be really useful and I’m already planning to implement it.

    However, I was looking at the code, and can’t quite work out what the purpose of the nThreads parameter in the StartThreads on the Thread Class is.  It looks like it is always 1.

    was this just some legacy code?

  12. Yothinin says:

    I has a problem when I try to run example code, Do you have a source code files and how I can download it, Thanks advances.

    yothinin@sombattour.com

  13. Fernando D. Bozzo says:

    Hi Calvin:

    Is there any way to pass an object reference to the thread insted of a string?

    Amazing work, thank you very much!

  14. Fernando D. Bozzo says:

    Hi Calvin:

    Just to say that I’ve solved the problem with the callback without passing an object reference, using File Mappings, Postmessage and Bindings.

    My derivative work based on yours is here:

    http://www.portalfox.com/articulos/archivos/bozzo/Test_Threads.zip

    Regards!

  15. tibisan says:

    Hi Calvin. I wonder if you can help me with this… I’m using WinXPSP2+VFP9SP1. I’ve built the dll (t1), registered it, executed the above code in IDE, and after ResumeThread it pops up the message ‘Error AfterCalling COM object’. Any advice? Did I do something wrong? I couldn’t figure out much upon debugging. Please help… 🙁

  16. A customer asks: I read your article "Intentionally crash your program". I have some questions that I

  17. Eduard says:

    Hi Calvin, i ecountered the same problem as tibisan, even with the example from Fernando D. Bozo.

    What’s wrong ?! I have WinxP Home SP2, VFP9 SP1 and nothing else out of the ordinary ..

  18. Eduard says:

    It works, but it beats me why i haven’t changed anything 😐

    Anyway, i’ve created a new function and started a new thread on it .. i’ve copied the code that semed relevant in SearchDisk’ s methods and this is what i’ve come up with:

    *!* Function msg_date(p1)

    Lparameters p2

    Declare Integer GetCurrentThreadId In WIN32API

    Declare Integer PostMessage In WIN32API Integer HWnd, Integer nMsg, Integer wParam, Integer Lparam

    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

    Declare Integer Sleep In WIN32API Integer

    Declare Integer CloseHandle In WIN32API Integer

    hAbortEvent = CreateEvent(0,0,0,"VFPAbortThreadEvent") && Get the existing event

    HWnd = Int(Val(p2))

    *- pre thread

    Try   && use exception handling

    If hAbortEvent = 0

    Throw "Creating event error:"+Transform(GetLastError())

    Endif

    cText=Substr(p2,At(",",p2)+1)

    Messagebox(Transform(Date())+" "+cText)

    Insert Into ThreadLog Values (GetCurrentThreadId(), Datetime(),p2)

    Catch To oex

    Insert Into ThreadLog Values (GetCurrentThreadId(), Datetime(),p2+" Error: "+oex.Message+" "+oex.Details+" "+Transform(oex.Lineno))

    Finally

    Insert Into ThreadLog Values (GetCurrentThreadId(), Datetime(),"finally section")

    Endtry

    Insert Into ThreadLog Values (GetCurrentThreadId(), Datetime(),"after try / endtry")

    *- post thread

    CloseHandle(hAbortEvent)

    PostMessage(HWnd, WM_USER, 0, GetCurrentThreadId())   && Tell main thread we’re just about done!

    It gives an error as expected (UI elements noy alowed) but the thread terminates and doesn’t decrement oTrhreads.nLiveThreads, so vfp hangs. Do you have any ideeas why?

    And please tell me, can i use this to run a prg included in the exe file instead of a generated one? I’m trying to create a routine that retrives new data from a SQL Server at specified intervals and have it run on a separate thread and the routine could be in a class or in prg included in the exe.

  19. I received a question: Simply, is there a way of interrupting a vfp sql query once it has started short

Skip to main content