Опять отслеживаем директорию с файлами

[ZlydenGL]

Добрый день, уважаемые!

Есть проблема, набившая оскомину: в директории надо отслеживать новые файлы. Если таковые есть (или если поменялся старый файл) - нужно выполнять некие рутины.

На данный момент действую банальным перебором файлов через инструкцию Dir(), сравнивая файлы с неким массивом. Что не совсем удобно, бо ресурсов отжирается до черта (да и список файликов уже за 3 тысячи зашкалил - только на базовые процедуры проверки уходит до 3х минут).

Попытался сам разобраться с APIшными функцией ReadDirectoryChangesW, но видать что-то не то курю. Может у кого-нить найдется время сделать порт кода http://www.codeproject.com/file/directo ... atcher.asp (ссылку взял на MSDN'е)? Или может быть у кого-то уже есть исполняемый код под это дело на VBA (критично, не могу перейти пока на "нормальный" язык)?

Заранее спасибо ответимшим

Добавлено чуть позже.

Единственное более-менее похожее решение нашел здесь. Впрочем, не без недостатков, как например не реализован анализ того, ЧТО именно поменялось.

[ZlydenGL]

Собственно, спасение утопающих - как известно, дело самих утопающих

В результате поисков нашел вот такой код.

Слегка модифицировал под себя и получил следующее:

Код: Выделить всё

Option Explicit

' Declaration for async version of ReadDirectoryChangesW
Private Declare Function ReadAsync Lib "kernel32" Alias "ReadDirectoryChangesW" (ByVal hHandle As Long, lpBuffer As Any, ByVal nBufferLen As Long, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED, ByVal lpCompletionRoutine As Long) As Long

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long

Public Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function WaitForSingleObjectEx Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long

Public Type OVERLAPPED
        Internal As Long
        InternalHigh As Long
        Offset As Long
        OffsetHigh As Long
        hEvent As Long
End Type

Public Enum WaitState
    WAIT_FAILED = -1
    WAIT_OBJECT_0 = 0
    WAIT_ABANDONED = &H80
    WAIT_IO_COMPLETION = &HC0
    WAIT_TIMEOUT = &H102
End Enum

Public Enum FileAction
    FILE_ACTION_ADDED = &H1
    FILE_ACTION_REMOVED = &H2
    FILE_ACTION_MODIFIED = &H3
    FILE_ACTION_RENAMED_OLD_NAME = &H4
    FILE_ACTION_RENAMED_NEW_NAME = &H5
End Enum

Public Enum NotificationFilters
    FILE_NOTIFY_CHANGE_FILE_NAME = 1
    FILE_NOTIFY_CHANGE_DIR_NAME = &H2
    FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
    FILE_NOTIFY_CHANGE_SIZE = &H8
    FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
    FILE_NOTIFY_CHANGE_LAST_ACCESS = &H20
    FILE_NOTIFY_CHANGE_CREATION = &H40
    FILE_NOTIFY_CHANGE_SECURITY = &H100
End Enum

Public Type FILE_NOTIFY_INFORMATION
    NextEntryOffset As Long
    Action As Long
    FileNameLength As Long
    Filename(255) As Byte
End Type

Const FILE_LIST_DIRECTORY = 1
Const GENERIC_WRITE = &H40000000
Const GENERIC_READ = &H80000000
Const FILE_SHARE_DELETE = 4
Const FILE_SHARE_READ = 1
Const OPEN_EXISTING = 3
Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Const FILE_FLAG_OVERLAPPED = &H40000000

Public cBuffer(1024) As Byte
Public Cancelled As Boolean
Public hEvent As Long
Public OL As OVERLAPPED
Public hFolder As Long
Public FolderToWatch As String

Public Sub SendMeMes(Str As String)
Sheet40.Cells(Sheet40.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1) = Str
Sheet40.Cells(Sheet40.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1).Activate
DoEvents
End Sub

Public Sub FileIOCompletionRoutine(ByVal dwErrorCode As Long, ByVal dwNumberofBytes As Long, lpOverlapped As OVERLAPPED)
    Dim wombat As FILE_NOTIFY_INFORMATION ' the infamous wombat!
    Dim strFilename As String
   
    If dwNumberofBytes Then  ' did we get anything?
        CopyMemory wombat, cBuffer(0), dwNumberofBytes
        strFilename = Left(CStr(wombat.Filename), wombat.FileNameLength / 2)
   
        Select Case wombat.Action
            Case FILE_ACTION_ADDED
                SendMeMes strFilename & " added to monitored folder"
            Case FILE_ACTION_MODIFIED
                SendMeMes strFilename & " modifyed in monitored folder"
            Case FILE_ACTION_REMOVED
                SendMeMes strFilename & " removed monitored folder"
            Case FILE_ACTION_RENAMED_NEW_NAME
                SendMeMes strFilename & " renamed in monitored folder (new name)"
            Case FILE_ACTION_RENAMED_OLD_NAME
                SendMeMes strFilename & " renamed in monitored folder (old name)"
            Case Else
                SendMeMes strFilename & " was manipulated in monitored folder"
        End Select
    End If
End Sub

Public Sub FolderWatch(ByVal cFolder As String)
    Dim nFilter As Long
    Dim nReturned As Long
    Dim WaitResult As Long
    Dim mykey As Long
    Dim ByteCount As Long

    Cancelled = False
    ' Create our own event, and stick it in the OVERLAPPED structure so that
    ' we can link it to our asynch ReadDirectoryChagesW
    hEvent = CreateEvent(0&, False, False, "vbReadAsyncEvent")
    OL.hEvent = hEvent
   
    ' Get handle to nominated folder
    hFolder = CreateFile(cFolder, FILE_LIST_DIRECTORY, FILE_SHARE_READ + FILE_SHARE_DELETE, 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS + FILE_FLAG_OVERLAPPED, 0)
    ' Filter the type of file events we want to monitor
    nFilter = FILE_NOTIFY_CHANGE_FILE_NAME + FILE_NOTIFY_CHANGE_LAST_WRITE + FILE_NOTIFY_CHANGE_CREATION
   
    ' Keep looping until user cancels
    Do
        ' set up the async call
        ReadAsync hFolder, cBuffer(0), 1024, False, nFilter, nReturned, OL, AddressOf FileIOCompletionRoutine
        Do
            ' Wait for event or timeout to occur
            WaitResult = WaitForSingleObjectEx(hEvent, 100, True)
            DoEvents ' Yield to OS
        Loop Until (WaitResult = WAIT_IO_COMPLETION) Or (Cancelled = True)
        DoEvents
    Loop Until Cancelled

    ' Clean up as we go
    CloseHandle hEvent
    CloseHandle OL.hEvent
    CloseHandle hFolder
    hFolder = 0
End Sub


Буду рад, если кому пригодится

[ZlydenGL]

Все равно не идеальный код получается. Если нужен просто список новых/измененных/удаленных файлов, то все ОК. А вот если по факту получения набора файлов надо выполнить какое-либо ТЯЖЕЛОЕ действие - обрабатывается только первый файл.

Надо думать дальше...