Асинхронное ожидание множества событий файловых операций (пример для класса от The Trick) - VB

Формулировка задачи:

Написал пример для использования vbWaitForMultipleObjects для мониторинга множества папок с помощью этого класса. Видимо неправильно передаю указатель на массив хендлов событий, ибо начинает сыпатся куча уведомлений с пустым именем файлов. The Trick, можешь, пожалуйста, как освободишься, посмотреть? И еще, как в Callback процедуре получить код возврата WaitForMultipleObjects, чтобы узнать от которого из событий пришло уведомление?

                    Листинг программы
                
 
                            
                        
Option Explicit
 
Private Const MAX_PATH As Long = 260&
 
Private Type OVERLAPPED
    Internal        As Long
    InternalHigh    As Long
    offset          As Long
    OffsetHigh      As Long
    hEvent          As Long
End Type
 
Private Type FILE_NOTIFY_INFORMATION
    dwNextEntryOffset           As Long
    dwAction                    As Long
    dwFileNameLength            As Long
    wcFileName(MAX_PATH * 2)    As Byte
End Type
 
Private Type bufEvents_TYPE
    bufEvent() As Long   ' Буфер уведомлений для мониторинга файлов
End Type
 
Private Declare Function ReadDirectoryChanges Lib "kernel32.dll" Alias "ReadDirectoryChangesW" (ByVal hDirectory As Long, lpBuffer As Any, ByVal nBufferLength As Long, ByVal bWatchSubTree As Long, ByVal dwNotifyFilter As Long, ByVal lpBytesReturned As Long, lpOverlapped As Any, ByVal lpCompletionRoutine As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CancelIo Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventW" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As Long) As Long
Private Declare Function ResetEvent Lib "kernel32" (ByVal hEvent As Long) As Long
Private Declare Function memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (pArr() As Any) As Long
 
Private Const SYNCHRONIZE                   As Long = &H100000
Private Const INFINITE                      As Long = -1
Private Const WAIT_OBJECT_0                 As Long = 0
Private Const FILE_LIST_DIRECTORY           As Long = &H1
Private Const FILE_SHARE_DELETE             As Long = &H4
Private Const FILE_SHARE_READ               As Long = &H1
Private Const FILE_SHARE_WRITE              As Long = &H2
Private Const FILE_FLAG_BACKUP_SEMANTICS    As Long = &H2000000
Private Const FILE_FLAG_OVERLAPPED          As Long = &H40000000
Private Const OPEN_EXISTING                 As Long = &H3
Private Const INVALID_HANDLE_VALUE          As Long = -1
Private Const FILE_NOTIFY_CHANGE_FILE_NAME  As Long = 1
Private Const FILE_ACTION_ADDED             As Long = &H1
Private Const FILE_ACTION_REMOVED           As Long = &H2
Private Const FILE_ACTION_RENAMED_OLD_NAME  As Long = &H4
Private Const FILE_ACTION_RENAMED_NEW_NAME  As Long = &H5
 
Dim WithEvents mon  As clsTrickWait ' Объект событий мониторинга файлов
 
Dim hDirectory() As Long     ' Описатель мониторящейся директории
Dim hEvent()     As Long     ' Описатель события для мониторящейся директории
Dim EventIDs     As Long     ' Кол-во успешно созданных событий
Dim ovr()        As OVERLAPPED
Dim Events()     As bufEvents_TYPE
 
Private Sub Command1_Click()
    Unload Me
End Sub
 
Private Sub Form_Load()
    Dim Folders(0) As String
      
    Folders(0) = "c:\rsit"
    Folders(1) = "c:\windows"
    
    BeginMonitor Folders()
End Sub
 
Private Sub BeginMonitor(Folders() As String)
    Dim i        As Long
    Dim FCnt     As Long
    
    ' Создаем объект для уведомлений
    Set mon = New clsTrickWait
    
    FCnt = UBound(Folders)
    
    ReDim hDirectory(FCnt)
    ReDim hEvent(FCnt)
    ReDim Events(FCnt)
    ReDim ovr(FCnt)
    
    For i = 0 To FCnt
        ' Открываем директорию для мониторинга
        hDirectory(EventIDs) = CreateFile(StrPtr(Folders(i)), FILE_LIST_DIRECTORY, FILE_SHARE_READ Or FILE_SHARE_WRITE Or FILE_SHARE_DELETE, _
                        ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OVERLAPPED, 0)
                        
        ' При ошибке уведомляем и выходим
        If hDirectory(EventIDs) = INVALID_HANDLE_VALUE Then
            Debug.Print "Cannot get a handle of directory: " & Folders(i)
        Else
            ' Создаем событие для уведомления
            hEvent(EventIDs) = CreateEvent(0, True, True, 0)
            ' При ошибке уведомляем и выходим
            If hEvent(EventIDs) = 0 Then
                CloseHandle hDirectory(EventIDs):   hDirectory(EventIDs) = 0
                Debug.Print "Error create notify event for: " & Folders(i)
            Else
                ' Заполняем структуру OVERLAPPED для асинхронного вызова
                ovr(EventIDs).hEvent = hEvent(EventIDs)
                
                ReDim Events(EventIDs).bufEvent(16383) As Long
                
                ' начинаем мониторить в асинхронном режиме
                If ReadDirectoryChanges(hDirectory(EventIDs), Events(EventIDs).bufEvent(0), UBound(Events(i).bufEvent) + 1, False, FILE_NOTIFY_CHANGE_FILE_NAME, 0&, ovr(EventIDs), 0&) = 0 Then
                    ' При ошибке  уведомляем и выходим
                    Debug.Print "Error start monitor of: " & Folders(i)
                    CloseHandle hEvent(EventIDs):     hEvent(EventIDs) = 0
                    CloseHandle hDirectory(EventIDs): hDirectory(EventIDs) = 0
                Else
                    ' увеличиваем счетчик успешно созданных событий
                    EventIDs = EventIDs + 1
                End If
            End If
        End If
    Next
    ' урезаем массив событий до кол-ва успешно созданных
    ReDim Preserve hEvent(EventIDs - 1)
    
    ' Если хоть одно событие было успешно создано
    If hEvent(0) Then
        ' Запускаем асинхронное уведомление для всех созданных событий
        mon.vbWaitForMultipleObjects UBound(hEvent) + 1, ArrPtr(hEvent), 0&, INFINITE
    End If
    
End Sub
 
' // Событие возникает при изменениях в директории на которые мы подписаны
Private Sub mon_OnWait(ByVal Handle As Long, ByVal Result As Long)
    Dim notify  As FILE_NOTIFY_INFORMATION
    Dim OBJ_idx As Long
    Dim idx     As Long
    Dim name    As String
    
    OBJ_idx = WAIT_OBJECT_0 'Result ' !!! <--- Должен быть индекс отслеживаемого события
    
    ' Проход по буферу уведомлений
    Do
        ' Копируем во временную структуру уведомление
        ' Здесь правильнее сделать через указатели, но для примера я оставил так (более понятно)
        memcpy notify, Events(OBJ_idx).bufEvent(idx), Len(notify)
        ' Узнаем имя файла
        name = Chr$(34) & Left$(notify.wcFileName, notify.dwFileNameLength \ 2) & Chr$(34)
        ' Проверяем тип уведомления
        Select Case notify.dwAction
        Case FILE_ACTION_ADDED:             name = "ADDED: " & name                 ' Файл добавлен
        Case FILE_ACTION_REMOVED:           name = "REMOVED: " & name               ' Файл удален
        Case FILE_ACTION_RENAMED_OLD_NAME:  name = "RENAMED (old name): " & name    ' Файл переименован - это старое имя
        Case FILE_ACTION_RENAMED_NEW_NAME:  name = "RENAMED (new name): " & name    ' Файл переименован - это новое имя
        End Select
        ' Добавить в список
        Debug.Print name
        ' Переход к следующему уведомлению
        idx = idx + notify.dwNextEntryOffset
        ' Пока есть уведомления в буфере повторяем
    Loop While notify.dwNextEntryOffset
    ' Сбрасываем событие
    ResetEvent Handle
    ' Заполняем структуру OVERLAPPED
    ovr(OBJ_idx).hEvent = Handle
    ' Запускаем мониторинг
    Call ReadDirectoryChanges(hDirectory(OBJ_idx), Events(OBJ_idx).bufEvent(0), UBound(Events(OBJ_idx).bufEvent) + 1, False, FILE_NOTIFY_CHANGE_FILE_NAME, 0&, ovr(OBJ_idx), 0&)
    ' Снимаем старое уведомление
    mon.Abort
    ' Запускаем новое
    ' !!! - handle ???
    mon.vbWaitForMultipleObjects UBound(hEvent) + 1, Handle, 0&, INFINITE
End Sub
 
Public Sub EndMonitoring()
    Dim i As Long
    ' Проверяем если директория открыта, то значит останавливаем
    If hDirectory(0) Then
        ' Завершаем ожидание
        mon.Abort
        ' Закрываем описатели события и директории
        For i = 0 To EventIDs - 1
            CloseHandle hEvent(i):     hEvent(i) = 0
            CloseHandle hDirectory(i): hDirectory(i) = 0
        Next
    End If
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Dim i As Long
    ' Прервывание ожиданий
    mon.Abort
    ' Если мониторинг
    If hDirectory(0) Then
        For i = 0 To EventIDs - 1
            ' Остановка ожидания мониторинга
            CancelIo hDirectory(i)
            ' Закрываем описатели
            CloseHandle hDirectory(i)
            CloseHandle hEvent(i)
        Next
    End If
End Sub

Решение задачи: «Асинхронное ожидание множества событий файловых операций (пример для класса от The Trick)»

textual
                            Листинг программы 
                        
 
                            
                        
' // Г‘Г®ГЎГ»ГІГЁГҐ ГўГ®Г§Г*ГЁГЄГ*ГҐГІ ГЇГ°ГЁ ГЁГ§Г¬ГҐГ*ГҐГ*ГЁГїГµ Гў Г¤ГЁГ°ГҐГЄГІГ®Г°ГЁГЁ Г*Г* ГЄГ®ГІГ®Г°Г»ГҐ Г¬Г» ГЇГ®Г¤ГЇГЁГ±Г*Г*Г»
Private Sub mon_OnWait(ByVal Handle As Long, ByVal Result As Long)
    Dim notify  As FILE_NOTIFY_INFORMATION
    Dim OBJ_idx As Long
    Dim idx     As Long
    Dim name    As String
    
    OBJ_idx = Result ' !!! <--- Г„Г®Г«Г¦ГҐГ* ГЎГ»ГІГј ГЁГ*Г¤ГҐГЄГ± Г®ГІГ±Г«ГҐГ¦ГЁГўГ*ГҐГ¬Г®ГЈГ® Г±Г®ГЎГ»ГІГЁГї
    
    If OBJ_idx >= 0 Then
        ' ГЏГ°Г®ГµГ®Г¤ ГЇГ® ГЎГіГґГҐГ°Гі ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГ©
        Do
            ' ГЉГ®ГЇГЁГ°ГіГҐГ¬ ГўГ® ГўГ°ГҐГ¬ГҐГ*Г*ГіГѕ Г±ГІГ°ГіГЄГІГіГ°Гі ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГҐ
            ' Г‡Г¤ГҐГ±Гј ГЇГ°Г*ГўГЁГ«ГјГ*ГҐГҐ Г±Г¤ГҐГ«Г*ГІГј Г·ГҐГ°ГҐГ§ ГіГЄГ*Г§Г*ГІГҐГ«ГЁ, Г*Г® Г¤Г«Гї ГЇГ°ГЁГ¬ГҐГ°Г* Гї Г®Г±ГІГ*ГўГЁГ« ГІГ*ГЄ (ГЎГ®Г«ГҐГҐ ГЇГ®Г*ГїГІГ*Г®)
            memcpy notify, Events(OBJ_idx).bufEvent(idx), Len(notify)
            ' Г“Г§Г*Г*ГҐГ¬ ГЁГ¬Гї ГґГ*Г©Г«Г*
            name = Chr$(34) & Left$(notify.wcFileName, notify.dwFileNameLength \ 2) & Chr$(34)
            ' ГЏГ°Г®ГўГҐГ°ГїГҐГ¬ ГІГЁГЇ ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГї
            Select Case notify.dwAction
            Case FILE_ACTION_ADDED:             name = "ADDED: " & name                 ' Г”Г*Г©Г« Г¤Г®ГЎГ*ГўГ«ГҐГ*
            Case FILE_ACTION_REMOVED:           name = "REMOVED: " & name               ' Г”Г*Г©Г« ГіГ¤Г*Г«ГҐГ*
            Case FILE_ACTION_RENAMED_OLD_NAME:  name = "RENAMED (old name): " & name    ' Г”Г*Г©Г« ГЇГҐГ°ГҐГЁГ¬ГҐГ*Г®ГўГ*Г* - ГЅГІГ® Г±ГІГ*Г°Г®ГҐ ГЁГ¬Гї
            Case FILE_ACTION_RENAMED_NEW_NAME:  name = "RENAMED (new name): " & name    ' Г”Г*Г©Г« ГЇГҐГ°ГҐГЁГ¬ГҐГ*Г®ГўГ*Г* - ГЅГІГ® Г*Г®ГўГ®ГҐ ГЁГ¬Гї
            End Select
            ' Г„Г®ГЎГ*ГўГЁГІГј Гў Г±ГЇГЁГ±Г®ГЄ
            Debug.Print name
            ' ГЏГҐГ°ГҐГµГ®Г¤ ГЄ Г±Г«ГҐГ¤ГіГѕГ№ГҐГ¬Гі ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГѕ
            idx = idx + notify.dwNextEntryOffset
            ' ГЏГ®ГЄГ* ГҐГ±ГІГј ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГї Гў ГЎГіГґГҐГ°ГҐ ГЇГ®ГўГІГ®Г°ГїГҐГ¬
        Loop While notify.dwNextEntryOffset
        ' Г‘ГЎГ°Г*Г±Г»ГўГ*ГҐГ¬ Г±Г®ГЎГ»ГІГЁГҐ
        ResetEvent hEvent(OBJ_idx)
        ' Г‡Г*ГЇГ®Г«Г*ГїГҐГ¬ Г±ГІГ°ГіГЄГІГіГ°Гі OVERLAPPED
        ovr(OBJ_idx).hEvent = hEvent(OBJ_idx)
        ' Г‡Г*ГЇГіГ±ГЄГ*ГҐГ¬ Г¬Г®Г*ГЁГІГ®Г°ГЁГ*ГЈ
        Call ReadDirectoryChanges(hDirectory(OBJ_idx), Events(OBJ_idx).bufEvent(0), UBound(Events(OBJ_idx).bufEvent) + 1, False, FILE_NOTIFY_CHANGE_FILE_NAME, 0&, ovr(OBJ_idx), 0&)
    End If
    ' Г‘Г*ГЁГ¬Г*ГҐГ¬ Г±ГІГ*Г°Г®ГҐ ГіГўГҐГ¤Г®Г¬Г«ГҐГ*ГЁГҐ
    mon.Abort
    ' Г‡Г*ГЇГіГ±ГЄГ*ГҐГ¬ Г*Г®ГўГ®ГҐ
    ' !!! - handle ???
    mon.vbWaitForMultipleObjects UBound(hEvent) + 1, VarPtr(hEvent(0)), 0&, INFINITE
End Sub