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

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

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

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

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

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

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

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

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

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

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

Option Explicit
'********************************************
'*    (c) 1999-2000 Сергей Мерзликин        *
'********************************************

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
        If T > 0& Then
            T = ((T + &H80000000) _
            + Interval) + &H80000000
        Else
            T = ((T - &H80000000) _
            + Interval) - &H80000000
        End If
    End If
    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
            If T > 0& Then
                T1 = ((T + &H80000000) _
                - (T1 - &H80000000))
            Else
                T1 = ((T - &H80000000) _
                - (T1 + &H80000000))
            End If
        End If
        On Error GoTo 0
        ' В переменной T1 - оставшаяся часть интервала
        If IIf((T1 Xor Interval) > 0&, _
            T1 > Interval, 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, но это не так. Когда тип числовой константы не описан, считается, что ее тип - Byte, Integer, Long, Single или Double, если соответствующее число помещается в область допустимых значений этого типа. &HFFFF помещается в тип Integer. Но для Integer &HFFFF = -1, и именно это число, преобразованное в тип Long, передается функции API. Поэтому во избежание недоразумений советую это определение писать так:
   

   Const INFINITE = -1&

   или:
   

   Const INFINITE = &HFFFFFFFF

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

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