|
String
If l = 0 Then
s$ = "In Thread " & App.threadid
Call MessageBox(0, s$, "", 0)
End If
l = l + 1
If l >= finalval Then
l = 0
DoTheCount = True
Call MessageBox(0, "Done with counting", "", 0)
RaiseEvent DoneCounting
End If
End Function
The class is designed so that the DoTheCount function can be called repeatedly from a continuous loop in the background thread. We could have placed the loop in the object itself, but you''''ll see shortly that there are sound reasons for designing the object as shown here. The first time the DoTheCount function is called, a MessageBox appears showing the thread identifier -- that way we can verify the thread in which the code is running. The MessageBox API is used instead of the VB MessageBox command because the API function is known to be thread safe. A second MessageBox is shown when the counting is complete, and an event is raised to indicate that the operation is finished.
The background thread is launched using the following code in the frmMTDemo3 form:
Private Sub cmdCreateFree_Click()
Set c = New clsBackground
StartBackgroundThreadFree c
End Sub
The StartBackgroundThreadFree function is defined in modMTBack
module as follows:
Declare Function CreateThread Lib "kernel32" (ByVal _
lpSecurityAttributes As Long, ByVal dwStackSize As Long, _
ByVal lpStartAddress As Long, ByVal lpParameter As Long, _
ByVal dwCreationFlags As Long, _lpThreadId As Long) _
As Long
Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
'''' Start the background thread for this object
'''' using the invalid free threading approach.
Public Function StartBackgroundThreadFree(ByVal qobj As _
clsBackground)
Dim threadid As Long
Dim hnd&
Dim threadparam As Long
'''' Free threaded approach
threadparam = ObjPtr(qobj)
hnd = CreateThread(0, 2000, AddressOf BackgroundFuncFree, _
threadparam, 0, threadid)
If hnd = 0 Then
'''' Return with zero (error)
Exit Function
End If
'''' We don''''t need the thread handle
CloseHandle hnd
StartBackgroundThreadFree = threadid
End Function
The CreateThread function takes six parameters:
-
lpSecurityAttributes is typically set to zero to use the default security attributes.
-
dwStackSize is the size of the stack. Each thread has its own stack.
-
lpStartAddress is the memory address where the thread starts. This must be an address of a function in a standard module obtained using the AddressOf operator.
-
lpParameter is a long 32 bit parameter that is passed to the function that starts the new thread.
-
dwCreationFlags is a 32 bit flag variable that lets you control the start of the thread (whether it is active, suspended, etc.). Details on these flags can be found in Microsoft''''s online 32 bit reference.
-
lpThreadId is a variable that is loaded with the unique thread identifier of the new thread.
The function returns a handle to the thread.
In this case we pass a pointer to the clsBackground object that we wish to use in the new thread. ObjPtr retrieves the value of the interface pointer in the qobj variable. After the thread is created, the handle is closed using the CloseHandle function. This does NOT terminate the thread -- the thread continues to run until the BackgroundFuncFree function exits. However, if we did not close the handle, the thread object would continue to exist even after the BackgroundFuncFree function exits. All handles to a thread must be closed and the thread terminated in order for the system to free up the resources allocated to the thread.
The BackgroundFuncFree function is as follows:
'''' A free threaded callback.
'''' This is an invalid approach, though it works
'''' in this case.
Public Function BackgroundFuncFree(ByVal param As _
IUnknown) As Long
Dim qobj As clsBackground
Dim res&
'''' Free threaded approach
Set qobj = param
Do While Not qobj.DoTheCount(100000)
Loop
'''' qobj.ShowAForm '''' Crashes!
'''' Thread ends on return
End Function
The parameter to this function is a pointer to an interface (ByVal param As IUnknown). We can get away with this because under COM, every interface is based on IUnknown -- so this parameter type is valid regardless of the type of interface originally passed to the function. We must, however, immediately set the param to a specific object type in order to use it. In this case qobj is set to the original clsBackground object that was passed to the StartBackgroundThreadFree object.
The function then enters an infinite loop during which it performs any desired operation, in this case a repetitive count. A similar approach here might be to perform a wait operation that suspends the thread until a system event (such as a process termination) occurs. The thread could then call a method in the class to signal to the application that the event has occurred.
Accessing the qobj object is extremely fast because of the free threading nature of this approach -- no marshalling is used.
You''''ll notice, however, that if you try to have the clsBackground object show a form, the application crashes. You''''ll also notice that the completion event is never raised in the client form. In fact, even the Microsoft Systems Journal that describes this approach includes a great many warnings that there are some things that do not work when you attempt this approach.
Is this a flaw in Visual Basic?
Some people who tried deploying applications using this type of threading have found that their applications fail after upgrading to VB5 service pack 2.
Does this mean that Microsoft has failed to correctly provide backwards compatibility?
The answer to both questions is: No.
The problem is not with Microsoft or Visual Basic.
The problem is that the above code is garbage.
The problem is simple -- Visual Basic supports objects in both single threaded and apartment models. Let me rephrase this: Visual Basic objects are COM objects that make a statement under the COM contract that they will work correctly as single threaded or apartment model objects. That means that each object expects any method calls to take place on the same thread that created the object.
The example shown above violates this rule.
It violates the COM contract.
What does this mean?
|