Search Tools Links Login

API - Simulate multithreading with WaitForMultipleObjects (eg. How ICQ monitors connection state)


Visual Basic 6, or VB Classic

In this article, we are going to see how to use WaitForSingleObject, WaitForMultipleObjects, RasConnectionNotification and many other commands with Visual Basic. We are also going to see how to monitor multiple events without the need of multithreading. I have included two examples : how to monitor when a shelled application has ended and how ICQ monitors connection state (that little flower that gets green when we dial-up and establish a connection). If you like it, post a comment. I ll be happy to read your thoughts or suggestions. (****** A Special "Thank you" goes to all of you who spent a few secs to rate this article :)

Original Author: John Galanopoulos

Code







Simulate multithreading with WaitForMultipleObjects


Simulate
multithreading with WaitForMultipleObjects?á


?á?á?á?á?á?á?á?á?á?á?á?á?á?á
(eg. How ICQ
monitors connection state)


I
have used extensivly the event driven mechanism that Windows provide in many
different programming aspects


(RDO,
ADO, ODBC, Windows Sockets, Winlogon, mutexes, semaphores etc) and used
WaitForSingleObject when


i
was in need of an event monitor API command.?á



The
WaitForSingleObject is located in kernel32.dll and waits until a specific event
objects gets signaled or when a time limit is


reached.
It accepts two parameters; a handle to the event object and a time-out interval.?á



**
The main benefit of this function is that it uses no processor time while waiting for the object state?á

to become signaled or the time-out interval to elapse.



Here
is the declaration :



Public Declare Function
WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" _


(ByVal
hHandle As Long, ByVal dwMilliseconds As Long) As Long


Let's
see an example of this command's usage :



In
this example we are going to run the Windows calculator.


We
will open this shelled process and we will monitor the process handle;?á


if
it gets 0 then the process was ended.



Public Const WAIT_FAILED = &HFFFFFFFF?á?á?á?á?á?á?á?á?á?á?á?á?á?á
'Our WaitForSingleObject failed to wait and returned -1

Public Const WAIT_OBJECT_0 = &H0&?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
'The waitable object got signaled


Public Const WAIT_ABANDONED = &H80&?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
'We got out of the waitable object

Public Const WAIT_TIMEOUT = &H102&?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
'the interval we used, timed out.

Public Const STANDARD_RIGHTS_ALL = &H1F0000?á
'No special user rights needed to open this process




Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess
As Long, ByVal bInheritHandle
As Long, ByVal dwProcessId
As Long) As Long

Public Declare Function WaitForSingleObject Lib
"kernel32" (ByVal hHandle As
Long
, ByVal dwMilliseconds As
Long
) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject
As Long) As Long



Public Sub ShelledAPP()

Dim
shProcID As Long

Dim
hProcess As Long

Dim
WaitRet As Long



shProcID = Shell("calc.exe", vbNormalFocus)

hProcess = OpenProcess(STANDARD_RIGHTS_ALL, False, shProcID)



'This is the proper and optimized way to use the WaitForSingleObject
function.?á


'I
saw many programmers use the INFINITE constant as
for
the dwMilliseconds field.?á


'If
dwMilliseconds is INFINITE, the function's time-out interval never
elapses.


'That's
wrong 'cause the program won't refresh thus giving the impression that is a hung
application.


'In
Windows XP specially you might see a popup screen informing you about this.


'The
problem also appears when you apply WaitForSingleObject with
INFINITE
in an application that


'uses
windows.?á


'Always
use a reasonable number of milliseconds and always use DoEvents to refresh the
program's message queue


?áDo?á?á

?á?á
WaitRet = WaitForSingleObject(hProcess, 10)?á?á '
wait for 10ms to see if the hProcess was signaled


?á?á?á?á?á?á?á?á?á?á Select Case
WaitRet

?á?á


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case
WAIT_TIMEOUT?á?á 'The first case must
always be WAIT_TIMEOUT 'cause it is the most used option


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
DoEvents?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
'until the shelled process terminates?á


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case
WAIT_FAILED or WAIT_ABANDONED

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
MsgBox "Wait failed or abandoned"

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Exit Do



?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case
WAIT_OBJECT_0 'The object got signaled so
inform user and get out of the loop


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
MsgBox "The shelled application has ended"

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Exit Do



?á?á?á?á?á?á?á?á?á End Select

?áLoop


Call
CloseHandle(hProcess)?á?á?á?á 'Close
the process handle


Call
CloseHandle(shProcID)?á?á?á 'Close
the process id handle



DoEvents?á?á?á?á?á?á
'free any pending messages from the message queue




End Sub



Now what if we had to monitor two or more shelled applications? are we
going to use multithreading?


I
haven't yet implemented multithreading api in a vb.net project of mine but as
you most know,?á


multithreading
is lethal (basically for those who will implement the CreateThread API function) when used within Visual Basic 6 (or prior).


Crashes,
unexpected terminations, exceptions
and many
other "beautifull" encounters are some of the experiences a programmer
can get.



The
answer comes from WaitForMultipleObjects API function which is also included in
kernel32.dll


Here
is the declaration :



Public Declare Function WaitForMultipleObjects
Lib "kernel32" Alias "WaitForMultipleObjects"
(ByVal nCount As Long, lpHandles
As Long, ByVal bWaitAll
As Long, ByVal dwMilliseconds As
Long
) As Long


it
accepts four values :


nCount
as the maximum number of events to monitor,


lpHandles
as the array of different event handles (not multiple copies of the same one),


bWaitAll
(True/False) True if it must return when the state of all objects is signaled,


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
False if it must return when the state of any one of these objects gets
signaled,


dwMilliseconds
as a maximum time-out interval



Like
WaitForSingleObject, WaitForMultipleObjects can accept event handles of any of
the following object types?á


in
the lpHandles : Change notification, Console input, Waitable timmer,
Event, Job, Mutex, Process, Semaphore


and Threads


In
the following example we are going to try something else than monitoring
multiple shelled apps;?á


Those
of you that have ICQ installed, have noticed that "red flower" icon,
placed on the system tray.


When
you are not connected on the internet, ICQ makes this icon look like inactive.


Now
when you connect, it suddently starts to get one by one of it's leaf green,
meaning that it tries to


connect
to it's main server and when the connection completes, the flower get's green.



How
do they do it? I mean. do they have an IsConnected() function on a timer with
some interval?


Definetly
no!


What
they do is take advantage of WaitForMultipleObjects with another function
located in rasapi32.dll; RasConnectionNotification?á



The
RasConnectionNotification function specifies an event object that the system
sets to the signaled state when?á


a
RAS connection is created or terminated.


The
function accepts three values :


hrasconn
as the handle to a RAS connection?á


hEvent
as the?á handle to an event object?á


dwFlags
as the type of event to receive notifications for (RASCN_Connection or RASCN_Disconnection)



Now
we are going to use WaitForMultipleObjects?á to monitor both events




Public Const RASCN_Connection = &H1?á?á?á?á?á?á
'Our two flags


Public Const RASCN_Disconnection = &H2


Public Const WAIT_FAILED = &HFFFFFFFF

Public Const WAIT_OBJECT_0 = &H0&

Public Const WAIT_ABANDONED = &H80&

Public Const WAIT_TIMEOUT = &H102&



Public Type SECURITY_ATTRIBUTES

?á?á?á?á?á?á?á?á?á nLength As Long

?á?á?á?á?á?á?á?á?á lpSecurityDescriptor As Long

?á?á?á?á?á?á?á?á?á bInheritHandle As Long

End Type


Public Declare Function
CreateEvent Lib "kernel32" Alias
"CreateEventA" (lpEventAttributes As
SECURITY_ATTRIBUTES, ByVal bManualReset As
Long
, ByVal bInitialState As
Long
, ByVal lpName As
String
) As Long

Public Declare Function RasConnectionNotification Lib "rasapi32.dll"
Alias "RasConnectionNotificationA" (hRasConn As
Long
, ByVal hEvent As
Long
, ByVal dwFlags As
Long
) As Long

Public Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount
As Long, lpHandles As Long,
ByVal bWaitAll As Long,
ByVal dwMilliseconds As
Long
) As Long

Public Declare Function ResetEvent Lib "kernel32"
(ByVal hEvent As Long)
As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject
As Long) As Long



Public Sub MonitorRASStatusAsync()



Dim hEvents(1) As Long?á?á?á?á?á?á?á
'Array of event handles. Since there are two events we'd like to monitor, i have
already dimention it.


Dim RasNotif As Long?á?á?á?á?á?á?á?á?á?á

Dim WaitRet As Long?á?á?á?á?á?á?á?á?á?á?á

Dim sd As SECURITY_ATTRIBUTES

Dim hRasConn As Long



hRasConn = 0



'We are going to create and register two event objects
with CreateEvent API function


'There
aren't any special treated events that need any kind of security attributes so
we just initialize the structure



With sd?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á

?á?á?á?á?á?á .nLength = Len(sd)?á?á?á?á?á
'we pass the length of sd?á


?á?á?á?á?á?á .lpSecurityDescriptor = 0

?á?á?á?á?á?á .bInheritHandle = 0

End With


'We
create the event by passing in CreateEvent any security attributes,?á


'we
want to manually reset the event after it gets signaled,


'we
also want it's initial state not signaled assuming that we don't have yet any
connection to the internet,


'last
but not least we give the event a name (RASStatusNotificationObject1)

hEvents(0) = CreateEvent(sd, True, False, "RASStatusNotificationObject1")

'If the returned value was zero, something went wrong so
exit the sub


If hEvents(0) = 0
Then MsgBox "Couldn't assign an event handle": Exit Sub


'If
we succesfully created the first event object we pass it to
RasConnectionNotification


'with
the flag RASCN_Connection so that this event will monitor for internet
connection


RasNotif = RasConnectionNotification(ByVal hRasConn, hEvents(0), RASCN_Connection)

If RasNotif <> 0 Then MsgBox "Ras Notification failure":
GoTo ras_TerminateEvent





'We create the second event object exactly like the first
one


'but
we name it
RASStatusNotificationObject2


hEvents(1) = CreateEvent(sd,
True, False, "RASStatusNotificationObject2")

If hEvents(1) = 0 Then MsgBox "Couldn't assign
an event handle": Exit Sub




'If
we succesfully created the second event object too, we pass it to
RasConnectionNotification


'with
the flag RASCN_Disconnection. This event will monitor for disconnection


RasNotif = RasConnectionNotification(ByVal hRasConn, hEvents(1), RASCN_Disconnection)

If RasNotif <> 0 Then MsgBox "Ras Notification failure":
GoTo ras_TerminateEvent




'We
then issue the loop


'Notice
that we have put hEvents array to it's first array item.


'and
we used False cause we want to get notifications


'when
any of the two events occur.

Do

?á?á?á?á?á?á WaitRet = WaitForMultipleObjects(2, hEvents(0),
False, 20)

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Select Case WaitRet

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case WAIT_TIMEOUT

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
DoEvents


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case WAIT_FAILED Or WAIT_ABANDONED
Or WAIT_ABANDONED?á + 1

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
GoTo ras_TerminateEvent



?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case WAIT_OBJECT_0

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
MsgBox "Connected"

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
ResetEvent hEvents(0) 'Reset the event to avoid a second
message box?á


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
DoEvents?á?á?á 'Free any pending messages


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
Case WAIT_OBJECT_0 + 1?á

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
MsgBox "Disconnected"

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
ResetEvent hEvents(1) 'Reset the event to place it in no
signal state (Manual reset, remember?)


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
DoEvents?á


?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á
End Select

?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á?á

Loop




ras_TerminateEvent:



'Close all event handles


'For
more than two events you could apply?á a For.. Next


Call
CloseHandle(hEvents(1))?á?á?á?á?á

Call CloseHandle(hEvents(0))


DoEvents?á?á?á
'Free any pending messages from the application message
queue




End Sub




Now imagine that you could monitor events from different objects
like


a
file or folder change, along with connection status, shelled applications,


multiple
printer objects, different processes and threads etc etc etc.


(64
maximum event objects i think)



It
will appear that you program is multithreading but the truth behind that, is


that
you will be taking advantage of WaitForMultipleObjects internal


multithreading
mechanism.



I
hope i helped with this article, people.


Feel
free to leave any comments or suggestions.


It
will help all of us.



John
Galanopoulos




About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 153 times

Categories

Visual Basic 6

Attachments

API_-_Simu102436752002.zip
Posted: 9/3/2020 3:45:00 PM
Size: 9,505 bytes


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.