Option Compare Database
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
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private 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
Private 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
Private Enum WaitState
WAIT_FAILED = -1
WAIT_OBJECT_0 = 0
WAIT_ABANDONED = &H80
WAIT_IO_COMPLETION = &HC0
WAIT_TIMEOUT = &H102
End Enum
Private 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
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
Private Cancelled As Boolean
Private hEvent As Long
Private strFileWatch As String
Private hFolder As Long
Public Property Get CancelWatcher() As Boolean
CancelWatcher = Cancelled
End Property
Public Property Let CancelWatcher(aValue As Boolean)
Cancelled = aValue
End Property
Public Property Get WatchFolder() As Long
WatchFolder = hFolder
End Property
Public Property Get sFileWatch() As String
sFileWatch = strFileWatch
End Property
Public Sub FileWatch(ByVal cFolder As String, ByVal strFile As String)
Dim nFilter As Long
Dim nReturned As Long
Dim WaitResult As Long
Dim mykey As Long
Dim ByteCount As Long
strFileWatch = strFile
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 ' 0&
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)
Loop Until Cancelled
' Clean up as we go
CloseHandle hEvent
CloseHandle OL.hEvent
CloseHandle hFolder
hFolder = 0
End Sub
![[2thumbsup]](/data/assets/smilies/2thumbsup.gif "[2thumbsup] [2thumbsup]")
1DMF