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 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
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 removedAnonymous
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 ClaudeAnonymous
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. ThanksAnonymous
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.comAnonymous
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 IAnonymous
April 17, 2008
The comment has been removedAnonymous
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 shortAnonymous
January 17, 2009
PingBack from http://www.hilpers-esp.com/666919-hacer-una-aplicacion-multi-hiloAnonymous
January 20, 2009
PingBack from http://www.hilpers.com/1068350-echtes-multitasking-in-form/2Anonymous
January 20, 2009
PingBack from http://www.hilpers-esp.com/324759-proximamente-en-portalfox-multithreading-enAnonymous
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