More Multithread capabilities: interthread synchronization, error checking

Article
05/23/2006

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

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

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

Anonymous
May 23, 2006
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???
Anonymous
May 24, 2006
Way cool! Thanks!
Anonymous
May 24, 2006
The comment has been removed
Anonymous
May 24, 2006
Tracy, did you create T1 and compile as an mtdll. It sounds like your T1 vfp mtdll is not there...
Anonymous
May 24, 2006
That was my problem. Thanks Claude
Anonymous
May 24, 2006
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.
Anonymous
May 24, 2006
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.
Anonymous
May 24, 2006
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)
Anonymous
May 24, 2006
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
Anonymous
May 25, 2006
Today’s sample shows how to create a web crawler in the background. This crawler starts with a web page,...
Anonymous
August 24, 2006
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?
Anonymous
February 10, 2007
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
Anonymous
February 28, 2007
Hi Calvin: Is there any way to pass an object reference to the thread insted of a string? Amazing work, thank you very much!
Anonymous
March 13, 2007
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!
Anonymous
July 05, 2007
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... :(
Anonymous
September 27, 2007
A customer asks: I read your article "Intentionally crash your program". I have some questions that I
Anonymous
April 17, 2008
The comment has been removed
Anonymous
April 17, 2008
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.
Anonymous
May 15, 2008
I received a question: Simply, is there a way of interrupting a vfp sql query once it has started short
Anonymous
January 17, 2009
PingBack from http://www.hilpers-esp.com/666919-hacer-una-aplicacion-multi-hilo
Anonymous
January 20, 2009
PingBack from http://www.hilpers.com/1068350-echtes-multitasking-in-form/2
Anonymous
January 20, 2009
PingBack from http://www.hilpers-esp.com/324759-proximamente-en-portalfox-multithreading-en
Anonymous
May 18, 2009
PingBack from http://blog.todmeansfox.com/2009/05/18/etl-subsystem-31-paralleling-and-pipelining/
Anonymous
June 13, 2009
PingBack from http://firepitidea.info/story.php?id=497

Partager via

More Multithread capabilities: interthread synchronization, error checking

Comments

Ressources supplémentaires