Important alert: (current site time 12/19/2014 6:50:03 PM EDT)
 

article

Easy, Safe Multithreading in Vb6 with Low Overhead - Part 2

Email
Submitted on: 7/5/2001 12:42:02 PM
By: Robert Thaggard 
Level: Advanced
User Rating: By 10 Users
Compatibility: VB 6.0
Views: 47871
(About the author)
 
     Use the ThreadingAPI type library to safely CreateProcess in vb6. by Matthew Curland

This article has accompanying files
 
 
Terms of Agreement:   
By using this article, you agree to the following terms...   
  1. You may use this article in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this article (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this article from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the article or article's description.
				

Easy, Stable VB6 Multithreading with Low Overhead - Part 2
Calling CreateThread Safely Within a DLL

I found some better, straight vb code for the tutorial I was going to do for this part so I thought it would be better than using c++. The code does the same thing.

Part 2 of thesse tutorials is based off Matthew Curland's "Apartment Threading in VB6, Safely and Externally". This uses a precompiled type library to easily call CreateThread from a global name space (no declaration required).  While this might be use activex, it still isn't using nearly as many system resources as Srideep's solution.

In addition to safely calling CreateThread from vb there are some thread classes that are used for doing the work with class ids rather than function addresses. (Launch, Worker, ThreadControl, ThreadData, and ThreadLaunch)

I will list all the classes below. I also decide4d not to add syntax highlighting because that took too long. Also please realize that I did not write these. Matthew Curland did. So vote for him, not me.

ThreadControl.cls
Option Explicit
Private m_RunningThreads As Collection'Collection to hold ThreadData objects for each thread
Private m_fStoppingWorkers As Boolean'Currently tearing down, so don't start anything new
Private m_EventHandle As Long'Synchronization handle
Private m_CS As CRITICAL_SECTION 'Critical section to avoid conflicts when signalling threads
Private m_pCS As Long'Pointer to m_CS structure
'Called to create a new thread worker thread.
'CLSID can be obtained from a ProgID via CLSIDFromProgID
'Data contains the data for the new thread
'fStealData should be True if the data is large. If this
' is set, then Data will be Empty on return. If Data
' contains an object reference, then the object should
' be created on this thread.
'fReturnThreadHandle must explicitly be set to True to
' return the created thread handle. This handle can be
' used for calls like SetThreadPriority and must be
' closed with CloseHandle.
Friend Function CreateWorkerThread(CLSID As CLSID, Data As Variant, Optional ByVal fStealData As Boolean = False, Optional ByVal fReturnThreadHandle As Boolean = False) As Long
Dim TPD As ThreadProcData
Dim IID_IUnknown As VBGUID
Dim ThreadID As Long
Dim ThreadHandle As Long
Dim pStream As IUnknown
Dim ThreadData As ThreadData
Dim fCleanUpOnFailure As Boolean
Dim hProcess As Long
Dim pUnk As IUnknown
If m_fStoppingWorkers Then Err.Raise 5, , "Can't create new worker while shutting down"
CleanCompletedThreads 'We need to clean up sometime, this is as good a time as any
With TPD
Set ThreadData = New ThreadData
.CLSID = CLSID
.EventHandle = m_EventHandle
With IID_IUnknown
.Data4(0) = &HC0
.Data4(7) = &H46
End With
.pMarshalStream = CoMarshalInterThreadInterfaceInStream(IID_IUnknown, Me)
.ThreadDonePointer = ThreadData.ThreadDonePointer
.ThreadDataCookie = ObjPtr(ThreadData)
.pCritSect = m_pCS
ThreadData.SetData Data, fStealData
Set ThreadData.Controller = Me
m_RunningThreads.Add ThreadData, CStr(.ThreadDataCookie)
End With
ThreadHandle = CreateThread(0, 0, AddressOf ThreadProc.ThreadStart, VarPtr(TPD), 0, ThreadID)
If ThreadHandle = 0 Then
fCleanUpOnFailure = True
Else
'Turn ownership of the thread handle over to
'the ThreadData object
ThreadData.ThreadHandle = ThreadHandle
'Make sure we've been notified by ThreadProc before continuing to
'guarantee that the new thread has gotten the data they need out
'of the ThreadProcData structure
WaitForSingleObject m_EventHandle, INFINITE
If TPD.hr Then
fCleanUpOnFailure = True
ElseIf fReturnThreadHandle Then
hProcess = GetCurrentProcess
DuplicateHandle hProcess, ThreadHandle, hProcess, CreateWorkerThread
End If
End If
If fCleanUpOnFailure Then
'Failure, clean up stream by making a reference and releasing it
CopyMemory pStream, TPD.pMarshalStream, 4
Set pStream = Nothing
'Tell the thread its done using the normal mechanism
InterlockedIncrement TPD.ThreadDonePointer
'There's no reason to keep the new thread data
CleanCompletedThreads
End If
If TPD.hr Then Err.Raise TPD.hr
End Function
'Called after a thread is created to provide a mechanism
'to stop execution and retrieve initial data for running
'the thread. Should be called in ThreadLaunch_Go with:
'Controller.RegisterNewThread ThreadDataCookie, VarPtr(m_Notify), Controller, Data
Public Sub RegisterNewThread(ByVal ThreadDataCookie As Long, ByVal ThreadSignalPointer As Long, ByRef ThreadControl As ThreadControl, Optional Data As Variant)
Dim ThreadData As ThreadData
Dim fInCriticalSection As Boolean
Set ThreadData = m_RunningThreads(CStr(ThreadDataCookie))
ThreadData.ThreadSignalPointer = ThreadSignalPointer
ThreadData.GetData Data
'The new thread should not own the controlling thread because
'the controlling thread has to teardown after all of the worker
'threads are done running code, which can't happen if we happen
'to release the last reference to ThreadControl in a worker
'thread. ThreadData is already holding an extra reference on
'this object, so it is guaranteed to remain alive until
'ThreadData is signalled.
Set ThreadControl = Nothing
If m_fStoppingWorkers Then
'This will only happen when StopWorkerThreads is called
'almost immediately after CreateWorkerThread. We could
'just let this signal happen in the StopWorkerThreads loop,
'but this allows a worker thread to be signalled immediately.
'See note in SignalThread about CriticalSection usage.
ThreadData.SignalThread m_pCS, fInCriticalSection
If fInCriticalSection Then LeaveCriticalSection m_pCS
End If
End Sub
'Call StopWorkerThreads to signal all worker threads
'and spin until they terminate. Any calls to an object
'passed via the Data parameter in CreateWorkerThread
'will succeed.
Friend Sub StopWorkerThreads()
Dim ThreadData As ThreadData
Dim fInCriticalSection As Boolean
Dim fSignal As Boolean
Dim fHaveOleThreadhWnd As Boolean
Dim OleThreadhWnd As Long
If m_fStoppingWorkers Then Exit Sub
m_fStoppingWorkers = True
fSignal = True
Do
For Each ThreadData In m_RunningThreads
If ThreadData.ThreadCompleted Then
m_RunningThreads.Remove CStr(ObjPtr(ThreadData))
ElseIf fSignal Then
'See note in SignalThread about CriticalSection usage.
ThreadData.SignalThread m_pCS, fInCriticalSection
End If
Next
If fInCriticalSection Then
LeaveCriticalSection m_pCS
fInCriticalSection = False
Else
'We can turn this off indefinitely because new threads
'which arrive at RegisterNewThread while stopping workers
'are signalled immediately
fSignal = False
End If
If m_RunningThreads.Count = 0 Then Exit Do
'We need to clear the message queue here in order to allow
'any pending RegisterNewThread messages to come through.
If Not fHaveOleThreadhWnd Then
OleThreadhWnd = FindOLEhWnd
fHaveOleThreadhWnd = True
End If
SpinOlehWnd OleThreadhWnd, False
Sleep 0
Loop
m_fStoppingWorkers = False
End Sub
'Releases ThreadData objects for all threads
'that are completed. Cleaning happens automatically
'when you call SignalWorkerThreads, StopWorkerThreads,
'and RegisterNewThread.
Friend Sub CleanCompletedThreads()
Dim ThreadData As ThreadData
For Each ThreadData In m_RunningThreads
If ThreadData.ThreadCompleted Then
m_RunningThreads.Remove CStr(ObjPtr(ThreadData))
End If
Next
End Sub
'Call to tell all running worker threads to
'terminated. If the thread has not yet called
'RegisterNewThread, then it will not be signalled.
'Unlike StopWorkerThreads, this does not block
'while the workers actually terminate.
'SignalWorkerThreads must be called by the owner
'of this class before the ThreadControl instance
'is released.
Friend Sub SignalWorkerThreads()
Dim ThreadData As ThreadData
Dim fInCriticalSection As Boolean
For Each ThreadData In m_RunningThreads
If ThreadData.ThreadCompleted Then
m_RunningThreads.Remove CStr(ObjPtr(ThreadData))
Else
'See note in SignalThread about CriticalSection usage.
ThreadData.SignalThread m_pCS, fInCriticalSection
End If
Next
If fInCriticalSection Then LeaveCriticalSection m_pCS
End Sub
Private Sub Class_Initialize()
Set m_RunningThreads = New Collection
m_EventHandle = CreateEvent(0, 0, 0, vbNullString)
m_pCS = VarPtr(m_CS)
InitializeCriticalSection m_pCS
End Sub
Private Sub Class_Terminate()
CleanCompletedThreads'Just in case, this generally does nothing.
Debug.Assert m_RunningThreads.Count = 0 'Each worker should have a reference to this class
CloseHandle m_EventHandle
DeleteCriticalSection m_pCS
End Sub

 

Launch.cls
Option Explicit
Private Controller As ThreadControl
Public Sub LaunchThreads()
Dim CLSID As CLSID
CLSID = CLSIDFromProgID("DllThreads.Worker")
Controller.CreateWorkerThread CLSID, 3000, True
Controller.CreateWorkerThread CLSID, 5000, True
Controller.CreateWorkerThread CLSID, 7000
End Sub
Public Sub FinishThreads()
Controller.StopWorkerThreads
End Sub
Public Sub CleanCompletedThreads()
Controller.CleanCompletedThreads
End Sub
Private Sub Class_Initialize()
Set Controller = New ThreadControl
End Sub
Private Sub Class_Terminate()
Controller.StopWorkerThreads
Set Controller = Nothing
End Sub

ThreadLaunch.cls
Option Explicit
'Just an interface definition
Public Function Go(Controller As ThreadControl, ByVal ThreadDataCookie As Long) As Long
End Function
'The rest of this is a comment
#If False Then
'A worker thread should include the following code.
'The Instancing for a worker should be set to 5 - MultiUse
Implements ThreadLaunch
Private m_Notify As Long
Public Function ThreadLaunch_Go(Controller As ThreadControl, ByVal ThreadDataCookie As Long) As Long
Dim Data As Variant
Controller.RegisterNewThread ThreadDataCookie, VarPtr(m_Notify), Controller, Data
'TODO: Process Data while
'regularly calling HaveBeenNotified to
'see if the thread should terminate.
If HaveBeenNotified Then
'Clean up and return
End If
End Function
Private Function HaveBeenNotified() As Boolean
HaveBeenNotified = m_Notify
End Function
#End If

Worker.cls
Option Explicit
Implements ThreadLaunch
Private m_Notify As Long
Public Function ThreadLaunch_Go(Controller As ThreadControl, ByVal ThreadDataCookie As Long) As Long
Dim Data As Variant
Dim SleepTime As Long
Controller.RegisterNewThread ThreadDataCookie, VarPtr(m_Notify), Controller, Data
ThreadLaunch_Go = Data
SleepTime = Data
While SleepTime > 0
Sleep 100
SleepTime = SleepTime - 100
If HaveBeenNotified Then
MsgBox "Notified"
Exit Function
End If
Wend
MsgBox "Done Sleeping: " & Data
End Function
Private Function HaveBeenNotified() As Boolean
HaveBeenNotified = m_Notify
End Function

 

ThreadData.cls
Option Explicit
Private m_ThreadDone As Long
Private m_ThreadSignal As Long
Private m_ThreadHandle As Long
Private m_Data As Variant
Private m_Controller As ThreadControl
Friend Function ThreadCompleted() As Boolean
Dim ExitCode As Long
ThreadCompleted = m_ThreadDone
If ThreadCompleted Then
'Since code runs on the worker thread after the
'ThreadDone pointer is incremented, there is a chance
'that we are signalled, but the thread hasn't yet
'terminated. In this case, just claim we aren't done
'yet to make sure that code on all worker threads is
'actually completed before ThreadControl terminates.
If m_ThreadHandle Then
If GetExitCodeThread(m_ThreadHandle, ExitCode) Then
If ExitCode = STILL_ACTIVE Then
ThreadCompleted = False
Exit Function
End If
End If
CloseHandle m_ThreadHandle
m_ThreadHandle = 0
End If
End If
End Function
Friend Property Get ThreadDonePointer() As Long
ThreadDonePointer = VarPtr(m_ThreadDone)
End Property
Friend Property Let ThreadSignalPointer(ByVal RHS As Long)
m_ThreadSignal = RHS
End Property
Friend Property Let ThreadHandle(ByVal RHS As Long)
'This takes over ownership of the ThreadHandle
m_ThreadHandle = RHS
End Property
Friend Sub SignalThread(ByVal pCritSect As Long, ByRef fInCriticalSection As Boolean)
'm_ThreadDone and m_ThreadSignal must be checked/modified inside
'a critical section because m_ThreadDone could change on some
'threads while we are signalling, causing m_ThreadSignal to point
'to invalid memory, as well as other problems. The parameters to this
'function are provided to ensure that the critical section is entered
'only when necessary. If fInCriticalSection is set, then the caller
'must call LeaveCriticalSection on pCritSect. This is left up to the
'caller since this function is designed to be called on multiple instances
'in a tight loop. There is no point in repeatedly entering/leaving the
'critical section.
If m_ThreadSignal Then
If Not fInCriticalSection Then
EnterCriticalSection pCritSect
fInCriticalSection = True
End If
If m_ThreadDone = 0 Then
InterlockedIncrement m_ThreadSignal
End If
'No point in signalling twice
m_ThreadSignal = 0
End If
End Sub
Friend Property Set Controller(ByVal RHS As ThreadControl)
Set m_Controller = RHS
End Property
Friend Sub SetData(Data As Variant, ByVal fStealData As Boolean)
If IsEmpty(Data) Or IsMissing(Data) Then Exit Sub
If fStealData Then
CopyMemory ByVal VarPtr(m_Data), ByVal VarPtr(Data), 16
CopyMemory ByVal VarPtr(Data), 0, 2
ElseIf IsObject(Data) Then
Set m_Data = Data
Else
m_Data = Data
End If
End Sub
Friend Sub GetData(Data As Variant)
'This is called only once. Always steal.
'Before stealing, make sure there's
'nothing lurking in Data
Data = Empty
CopyMemory ByVal VarPtr(Data), ByVal VarPtr(m_Data), 16
CopyMemory ByVal VarPtr(m_Data), 0, 2
End Sub
Private Sub Class_Terminate()
'This shouldn't happen, but just in case
If m_ThreadHandle Then CloseHandle m_ThreadHandle
End Sub

The type library (ThreadAPI) used to call CreateThread safely is in the zip.

winzip iconDownload article

Note: Due to the size or complexity of this submission, the author has submitted it as a .zip file to shorten your download time. Afterdownloading it, you will need a program like Winzip to decompress it.Virus note:All files are scanned once-a-day by Planet Source Code for viruses, but new viruses come out every day, so no prevention program can catch 100% of them. For your own safety, please:
  1. Re-scan downloaded files using your personal virus checker before using it.
  2. NEVER, EVER run compiled files (.exe's, .ocx's, .dll's etc.)--only run source code.
  3. Scan the source code with Minnow's Project Scanner

If you don't have a virus scanner, you can get one at many places on the net including:McAfee.com

 
Terms of Agreement:   
By using this article, you agree to the following terms...   
  1. You may use this article in your own programs (and may compile it into a program and distribute it in compiled format for languages that allow it) freely and with no charge.
  2. You MAY NOT redistribute this article (for example to a web site) without written permission from the original author. Failure to do so is a violation of copyright laws.   
  3. You may link to this article from another website, but ONLY if it is not wrapped in a frame. 
  4. You will abide by any additional copyright restrictions which the author may have placed in the article or article's description.


Other 1 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this article (in the Advanced category)?
(The article with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments

7/24/2001 1:09:47 PMUltimatum

Great code. Even compatible with VB.Net =) 5 globes =)
(If this comment was disrespectful, please report it.)

 
7/26/2001 12:28:52 PMmobius

Where can I get the source for ThreadAPI type library? Also, in summary, which is the better Thaggard
solution? He submitted 2.
(If this comment was disrespectful, please report it.)

 
1/30/2002 3:07:25 PMcarlino

I am having difficulty.
I press the first button (LaunchThreads) and it hangs.
Upon further review, I notice it is listening for an event.
However, the event that was declared was vbNullString.
Where, if ever, will this event be set?
And in the meantime, is the rest of the buttons in the sample responsive?
When I do it, they all freeze, as well.
And ideas of what's going on?
How are others being able to use it? Dar...Confused Much. :)
(If this comment was disrespectful, please report it.)

 
12/12/2002 1:55:26 PM

Hi,
Im sorry but ive been trying to figure out how to use this. Could you include a sample project, or tell me what functions i need to call? thanks in advance
(If this comment was disrespectful, please report it.)

 
9/11/2003 7:21:52 AMNorm Cook

Do you have his permission to publish this? From the original material:
Quote: You are entitled to license free distribution of any application
that uses this file if you own a copy of the book, or if you have obtained the file from a source approved by the author. You may redistribute this file only with express written permission
of the author. Unquote.
(If this comment was disrespectful, please report it.)

 
9/11/2003 7:53:09 AM

From a book? Have an ISBN or link?
(If this comment was disrespectful, please report it.)

 
9/14/2003 11:05:37 AMAndrew M. Goncharov

For Mobius: let me email, I`ll send threadapi.tlb
(If this comment was disrespectful, please report it.)

 
8/1/2007 11:10:50 AM1074

Anybody can tell me how work with a outside DLL, or some Documentation about this DLL, i dont know a lot of VB and I´ve a lot of problems,Thanks
(If this comment was disrespectful, please report it.)

 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular article, please click here instead.)
 

To post feedback, first please login.