Google
 
Web undim.blogspot.com
Visual Basic developer's world

Saturday, August 19, 2006
Simulate multithreading with WaitForMultipleObjects (eg. How ICQ monitors connection state)

I have used extensivly the event driven mechanism that Windows provide in manydifferent programming aspects(RDO, ADO, ODBC, Windows Sockets, Winlogon, mutexes, semaphores etc) and usedWaitForSingleObject when i was in need of an event monitor API command.

The WaitForSingleObject is located in kernel32.dll and waits until a specific event object 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.

Hereis 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 AsLong, ByVal dwMilliseconds AsLong) 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.

'Isaw many programmers use the INFINITE constant as forthe dwMilliseconds field.

'IfdwMilliseconds is INFINITE, the function's time-out interval neverelapses.

'That'swrong 'cause the program won't refresh thus giving the impression that is a hungapplication.

'InWindows 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 soinform user and get out of the loop
MsgBox "The shelled application has ended"
Exit Do

End Select
Loop


CallCloseHandle(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,
ultithreading 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 AsLong) 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 timer,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 :

hrasconnas the handle to a RAS connection

hEvent as the handle to an event object

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

Nowwe 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 AsSECURITY_ATTRIBUTES, ByVal bManualReset AsLong, ByVal bInitialState AsLong, ByVal lpName AsString) As Long
Public Declare Function RasConnectionNotification Lib "rasapi32.dll" Alias "RasConnectionNotificationA" (hRasConn AsLong, ByVal hEvent AsLong, 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 AsLong) 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 sowe 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 toRasConnectionNotification

'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 assignan event handle": Exit Sub

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

'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

'whenany 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_ABANDONEDOr 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 nosignal 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

CallCloseHandle(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)


I twill appear that you program is multithreading but the truth behind that, is that you will be taking advantage of WaitForMultipleObjects internal multithreading mechanism.


Labels: , ,


posted by Admin @ 8:24 AM   12 comments
DoEvents evolution; the API approach.

Many of us have used several times DoEvents, to supply a bit of air to our App, on heavy-duty times such as loops for updates or inserts on recordsets etc. As we most know, DoEvents processes Windows messages currently in the message queue. But what if we wanted to execute DoEvents only in times, when we want to allow user (Keyboard and Mouse) input?

If there was such a function to inspect the message queue for user input, we would have a main benefit:

We would speed up our loops ‘cause we would process all the messages in
the queue (with DoEvents) only on user input. It’s faster to check for
a message than to process all messages every time.

API provides us with such a function: It’s called GetInputState and you can locate it in user32 library.

Here is the declaration:

Public Declare Function GetInputState Lib"user32" () As Long

The GetInputState function determines whether there are mouse-button or keyboard messages in the calling thread's message queue. If the queue contains one or more new mouse-button or
keyboard messages, the return value is nonzero else if there are no new mouse-button or keyboard messages in the queue, the return value is zero.

So we can create an improved DoEvents with a Subroutine
like this :

Public Sub newDoEvents()
If GetInputState() <> 0 then DoEvents
End Sub


You can use GetInputState() with many variations for example :


uCancelMode = False

Do until rs.Eof

Rs.AddNew

(..your source here)

Rs.Update

Rs.MoveNext

If GetInputState() <> 0 then

DoEvents

If uCancelMode Then Exit Do

End If

Loop

Msgbox “Finished.”


…or

we could use it in a ScreenSaver e.t.c.

Let’s go a little further now and see what exactly is behind GetInputState().

It is another API function located in User32 as well; GetQueueStatus()
The GetQueueStatus function indicates the type of messages found in the calling thread's message queue. Here are the flags that GetQueueStatus uses :

QS_ALLEVENTS An input, WM_TIMER, WM_PAINT, WM_HOTKEY, or posted message is in the queue.

QS_ALLINPUT Any message is in the queue.

QS_ALLPOSTMESSAGE A posted message (other than those listed here) is in the queue.

QS_HOTKEY A WM_HOTKEY message is in the queue.

QS_INPUT An input message is in the queue.

QS_KEY A WM_KEYUP, WM_KEYDOWN, WM_SYSKEYUP, or WM_SYSKEYDOWN
message is in the queue.

QS_MOUSE A WM_MOUSEMOVE message or mouse-button message (WM_LBUTTONUP, M_RBUTTONDOWN, and so on).

QS_MOUSEBUTTON A mouse-button message (WM_LBUTTONUP, WM_RBUTTONDOWN, and so on).

QS_MOUSEMOVE A WM_MOUSEMOVE message is in the queue.

QS_PAINT A WM_PAINT message is in the queue.

QS_POSTMESSAGE A posted message (other than those listed here) is in the queue.

QS_SENDMESSAGE A message sent by another thread or application is in the queue.

QS_TIMER A WM_TIMER message is in the queue.

(I believe that GetInputState() is a GetQueueStatus(QS_HOTKEY Or QS_KEY Or QS_MOUSEBUTTON))

With these constants you can create your own GetInputState function that fits your needs. For example you can create a custom function that issues DoEvents when it’ll detects not only a Keyboard or Mouse Key input, but also a WM_PAINT signal.
Why’s that? ‘cause in your loop you might need to update the screen so you must let your custom function process the specific signal.


Look at this :


Public Const QS_HOTKEY = &H80
Public Const QS_KEY = &H1
Public Const QS_MOUSEBUTTON = &H4
Public Const QS_MOUSEMOVE = &H2
Public Const QS_PAINT = &H20
Public Const QS_POSTMESSAGE = &H8
Public Const QS_SENDMESSAGE = &H40
Public Const QS_TIMER = &H10
Public Const QS_ALLINPUT = (QS_SENDMESSAGE Or QS_PAINT Or _
QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or _
QS_HOTKEY Or QS_KEY)
Public Const QS_MOUSE = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Public Const QS_INPUT = (QS_MOUSE Or QS_KEY)
Public Const QS_ALLEVENTS = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or QS_PAINT Or QS_HOTKEY)

Public Declare Function GetQueueStatus Lib "user32" (ByVal qsFlags As Long) As Long

Public Function cGetInputState()

Dim qsRet As Long
qsRet = GetQueueStatus(QS_HOTKEY Or QS_KEY Or QS_MOUSEBUTTON Or QS_PAINT)
cGetInputState = qsRet
End Function


With this function you can trigger the DoEvents to be executed only when the message queue contains Key input, Mouse button or a WM_PAINT signal.

Call it like this….


. . if cGetInputState() <> 0
then DoEvents

Labels: , ,


posted by Admin @ 6:50 AM   1 comments
Hello to all of you inspired coders.
You have just landed to planet Visual Basic :-)

This is an attempt for source code tips in Visual Basic, a language most favourite for most of the coders worldwide for it's easy to use and develop concept.

Well, some times it can be rough. Real rough! (e.g. multithreading? windows services? errrr...) but in general, a coder can produce a really nice and easy solution.

My first programming language was BASIC. I remember the early 80's having my first ZX81 by Sinclair with a memory expansion chip that upgraded it's memory to 64k (whoaaaa!!!)
I wrote huge listings of BASIC just to play Centipede or Owlhunter (really cool games at that time). My storage media was a one hour cassette being played at my cassette player (Sinclair released some time later the ZX Spectrum having it's own cassette player) that took half an hour to load a decent game.... What a romantic decade of coding... (Macho finger muscles, i tell you)

Then from Visual Basic 3 ( Windows 3.1), to Visual Basic 5 with component development to Visual Basic 6. Loads of options for the developer but still a huge gap in programming options.

Microsoft did a large step in moving Visual Basic to a java-like form but still has lot to do regarding it's supported platforms, it's compiler and garbage collector etc etc etc....!

Anyway, please welcome this effort and post your thoughts and opinions or your coding tips freely. Help us grow in inspiration :-)

posted by Admin @ 6:50 AM   5 comments

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 
About Me

Name: Admin
Home: The NeverLands
About Me: A source code wonderer since the early 80s with my first ZX81 by Sinclair, home computer.
See my complete profile
Previous Post
Archives
Must-See Places
ΣΚΛΗΡΥΝΣΗ ΚΑΤΑ ΠΛΑΚΑΣ - ΕΓΚΕΦΑΛΟΣ - ΕΓΚΕΦΑΛΟΓΡΑΦΗΜΑ - ΑΝΟΙΑ - ΝΕΥΡΟΛΟΓΟΣ - ΨΥΧΙΑΤΡΟΣ - ΛΟΙΜΩΔΗΣ ΜΟΝΟΠΥΡΗΝΩΣΗ - ΠΑΡΚΙΝΣΟΝ - ΑΓΧΟΣ - ΚΑΤΑΘΛΙΨΗ - ALZHEIMER - EPSTEIN BARR eurolife
e-LaUgHs :-)
Template By
Free Blogger templates