Сергей Мерзликин

Использование функций ожидания в Visual Basic

Довольно часто у программистов, пишущих свои программы на Visual Basic, возникает потребность в использовании функций Windows 32 API, задерживающих выполнение программы до наступления определенного события. Оставим пока в стороне вопрос, когда и как возникает такая потребность - это тема для отдельной статьи. Также не будем останавливаться на описании параметров и возвращаемых значений обсуждаемых функций: желающий всегда может почерпнуть эти сведения из MSDN

Вот список этих функций:

Мы будем рассматривать только функции из первого столбца таблицы. Остальные функции применяются относительно редко, и, в конечном счете, проблема их использования в программах на Visual Basic решается аналогично тому, что будет изложено ниже.

Итак, с какими же проблемами может столкнуться программист, используя вышеприведенные функции API?

К счастью, проблема всего одна, но она достаточно серьезна. Дело в том, что программы, написанные на Visual Basic, за небольшим исключением, выполняются целиком в одном потоке операционной системы, а это означает, что, когда исполняется одна из функций ожидания, "жизнь" программы полностью замирает: перестает обновляться визуальный интерфейс, перестают нажиматься кнопки на форме и т.д. Может случиться хуже: некоторые компоненты ОС взаимодействуют с пользовательскими программами в синхронном режиме, и иногда это приводит к "подвисанию" оболочки ОС на продолжительное время.

Каждая из перечисленных выше функций ожидания имеет среди своих параметров интервал времени ожидания, по истечении которого выполнение программы продолжается. В принципе, если этот интервал не превышает 1 - 2 секунд, функции ожидания можно использовать без проблем, но если период ожидания значительно больше или вообще бесконечен, требуется применение другого подхода.

К счастью, среди функций ожидания имеется функция MsgWaitForMultipleObjects , способная "просыпаться", когда в очереди потока появляется новое сообщение. А это именно то, что нужно! Вспомним, что система называется Windows, а значит, она состоит из окон, и окна взаимодействуют между собой путем посылки друг другу сообщений. Так вот, не вдаваясь в подробности, отметим, что любое событие, на которое должно отреагировать окно, представляющее программу, будь то необходимость его перерисовки после того, как с него убрали окно другой программы, или необходимость реакции на нажатие экранной кнопки, приводит к появлению в очереди потока, обслуживающего данное окно, нового сообщения. Программа на Visual Basic обработает это сообщение только при наступлении одного из двух событий:

• Программа не выполняет ни одной инструкции (то есть выполнение всех процедур и функций завершено)
• Программа выполняет функцию

Обобщая сказанное выше, можно сформулировать принципы применения функций ожидания API в программах на Visual Basic:

• При небольших интервалах функции ожидания можно применять без ограничений
• Если интервал велик или неизвестен, следует применять только функцию MsgWaitForMultipleObjects
• При появлении в очереди потока нового сообщения требуется вызывать функцию DoEvents.

Теперь самое время проиллюстрировать сказанное примером. Приводимую ниже функцию MsgWaitObj предлагается использовать в качестве неблокирующего эквивалента функций Sleep, WaitForSingleObject и WaitForMultipleObjects.

 Option Explicit
'********************************************
'*      (c) 1999 Сергей Мерзликин           *
'********************************************
Private Const STATUS_TIMEOUT = &H102&
                  Private Const INFINITE = -1& ' Бесконечный интервал
                           Private Const QS_KEY = &H1&
                       Private Const QS_MOUSEMOVE = &H2&
                      Private Const QS_MOUSEBUTTON = &H4&
                      Private Const QS_POSTMESSAGE = &H8&
                          Private Const QS_TIMER = &H10&
                          Private Const QS_PAINT = &H20&
                      Private Const QS_SENDMESSAGE = &H40&
                         Private Const QS_HOTKEY = &H80&
            Private 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)
               Private Declare Function MsgWaitForMultipleObjects Lib "user32" _
                                    (ByVal nCount As Long, pHandles As Long, _
                                   ByVal fWaitAll As Long, ByVal dwMilliseconds _
                                  As Long, ByVal dwWakeMask As Long) As Long
                   Private Declare Function GetTickCount Lib "kernel32" () 
                                    As Long

                ' Функция MsgWaitObj служит для замены функций Sleep, 
                     ' WaitForSingleObject, WaitForMultipleObjects.
                    ' В отличие от перечисленных, данная функция
                     ' не блокирует обработку сообщений потока.
                              ' Вызов вместо Sleep:
                           '    MsgWaitObj dwMilliseconds
                         ' Вызов вместо WaitForSingleObject:
                    '    retval = MsgWaitObj(dwMilliseconds, hObj, 1)
                        ' Вызов вместо WaitForMultipleObjects:
                   '    retval = MsgWaitObj(dwMilliseconds, hObj(0), n),
                          '       где n - количество объектов,
                         '       hObj() - массив их описателей.

                          Public Function MsgWaitObj(Interval 
                                   As Long, _
                                                Optional hObj As Long = 0, _
                                            Optional nObj As Long = 0) As Long
                                    Dim T 
                                  As Long, T1 
                                    As Long
                                  If Interval <> 
                                   INFINITE 
                                     Then
                                      T = GetTickCount()
                                    On Error Resume Next
                                        T = T + Interval
                                ' Предотвращение переполнения
                                         If Err <> 0 
                                   Then T = _
                                    ((T + &H80000000) + Interval) + &H80000000
                                      On Error GoTo 0
                     ' В переменной T - абсолютное время окончания интервала
                                     Else
                                       T1 = INFINITE
                                    End If
                                      Do
                                        If Interval <> 
                                   INFINITE 
                                     Then
                                            T1 = GetTickCount()
                                          On Error Resume Next
                                                T1 = T - T1
                                      ' Предотвращение переполнения
                                               If Err <> 0 
                                  Then T1 = _
                                            ((T - &H80000000) - (T1 + &H80000000))
                                            On Error GoTo 0
                                ' В переменной T1 - оставшаяся часть интервала
                                                If T1 < 0 
                                     Then
                                                ' Интервал истек, пока
                                               ' выполнялась DoEvents
                                             MsgWaitObj = STATUS_TIMEOUT
                                                    Exit Function
                                                End If
                                          End If
                            ' Ждем события, истечения интервала или
                             ' появления сообщения в очереди потока
                                        MsgWaitObj = 
                          MsgWaitForMultipleObjects(nObj, _
                                                hObj, 0, T1, QS_ALLINPUT)
                           ' Даем возможность сообщению обработаться
                                          DoEvents
                                     If MsgWaitObj <> nObj 
                                Then Exit Function
                       ' Было сообщение в очереди потока - продолжаем ждать
                                     Loop
                                  End Function

Несколько комментариев к вышеприведенному коду:

1. Зачем потребовалось предотвращение переполнения? Дело в том, что функция GetTickCount, возвращая количество миллисекунд, прошедших с момента загрузки системы, возвращает их в виде беззнакового двойного слова (DWord). Максимальное значение DWord - &HFFFFFFFF. Ближайшим эквивалентом такого типа в Бейсике является Long, но Long всегда со знаком, и его максимальное значение для положительных чисел - &H7FFFFFFF. Если значение, возвращаемое функцией GetTickCount, находится близко к этому рубежу, может произойти арифметическая ошибка переполнения в следующей строке программы.
   Вы скажете, что такого никогда не случится, поскольку компьютеры так долго (если число &H7FFFFFFF миллисекунд перевести в привычный масштаб времени, то получится чуть менее 25 суток) без перезагрузки не работают? Я с вами не согласен. Надежная программа должна учитывать и такую возможность.
   Когда же компьютер работает уже так долго, что количество миллисекунд не помещается даже в DWord,GetTickCount начинает счет с нуля. Правда, с точки зрения арифметики Visual Basic, никакой ошибки не происходит: просто за -1 следует 0.

2. Win32API.txt гласит:
   
   

   Const INFINITE = &HFFFF

   В принципе это верно, если не учитывать того, что такое определение может сбить с толку даже опытного программиста. Когда эта константа появляется в виде параметра типа Long функции API, можно подумать, что функции передается число 65535, но это не так. Когда тип числовой константы не описан, считается, что ее тип - Integer, если соответствующее число помещается в область допустимых значений этого типа. Но для Integer &HFFFF = -1, и именно это число, преобразованное в тип Long, передается функции API. Поэтому во избежание недоразумений советую это определение писать так:
   

   Const INFINITE = -1&

   или так:
   

   Const INFINITE = &HFFFFFFFF

См. также Microsoft Knowledge Base Q231298.

Вот, собственно, и все. Приведенный выше код можно скопировать прямо из браузера.