Source code for Issue Number 131

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new class module and paste this code into it. Call the module cFileNotify

If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cFileNotify
'   Written By:     C&D Programming Corp.
'   Create Date:    10/2000
'   Copyright:      Copyright 2000 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private Const INFINITE = &HFFFF

Public Enum FileNotifyFlags
    FileNotifyFileName = 1&
    FileNotifyDirName = 2&
    FileNotifyAttributes = 4&
    FileNotifySize = 8&
    FileNotifyLastWrite = &H10&
    FileNotifyLastAccess = &H20&
    FileNotifyCreation = &H40&
    FileNotifySecurity = &H100&
    FileNotifyDefault = 21&
End Enum
'   FileNotifyDefault is equal to:
'       FileNotifyChangeAttributes Or FileNotifyChangeFileName Or _
                                FileNotifyChangeLastWrite

Public Enum WaitReturnValues
    WaitObject = 0&
    WaitAbandoned = &H80&
    WaitIOCompletion = &HC0&
    WaitTimeout = &H102&
    WaitStatusPending = &H103&
End Enum


'
'   overall details about these functions are available at:
'
'   http://msdn.microsoft.com/library/psdk/winbase/filesio_21f7.htm
'

Private Declare Function FindFirstChangeNotification Lib "kernel32" _
                                 Alias "FindFirstChangeNotificationA" _
                                (ByVal sPathName As String, _
                                 ByVal lWatchSubtree As Long, _
                                 ByVal lNotifyFilter As Long) As Long

Private Declare Function FindCloseChangeNotification Lib "kernel32" _
                                (ByVal lChangeHandle As Long) As Long

Private Declare Function FindNextChangeNotification Lib "kernel32" _
                                (ByVal lChangeHandle As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
                                (ByVal lHandle As Long, _
                                 ByVal lMilliseconds As Long) As Long

' flag to determine if the wait process has been aborted
Private mbAbortFlag As Boolean

' handle to the notify object to wait for
Private mlFileNotifyHandle As Long

' flags that have been set for monitoring
Private meNotifyFlags As FileNotifyFlags

' full path of the folder to watch for changes in
Public FolderToWatch As String

' event that is raised when an error occurs
Public Event FolderChanged(sFolder As String, eFlags As FileNotifyFlags)

'
'   Creates the handle necessary to monitor a directory specified by FolderToWatch
'
Private Sub Create(eFlags As FileNotifyFlags)

  ' sPathName is the folder to watch
  ' eFlags are the options for watching as specified in the FileNotifyFlags enum

   mlFileNotifyHandle = FindFirstChangeNotification(FolderToWatch, False, eFlags)

   ' save for later
   meNotifyFlags = eFlags
End Sub

'
'   Can be called by your application to abort the monitoring process
'
Public Sub Abort()
   Dim lRet As Long

   mbAbortFlag = True
   Remove
End Sub

'
'   remove the monitoring process. Should not be called from outside this
'   class.
'
Private Sub Remove()
   Dim lRet As Long

   DoEvents

   lRet = FindCloseChangeNotification(mlFileNotifyHandle)
End Sub

'
'   lInterval is in milliseconds.  This is how often the system will check
'   for changes.
'
Private Function PollChanges(lInterval As Long) As Long
   Dim lRet As Long

   ' lRet <> 0 while notification has not found a file to warn caller about.
   Do

      lRet = WaitForSingleObject(mlFileNotifyHandle, lInterval)
      DoEvents

   Loop While lRet <> 0 And mbAbortFlag = False

   PollChanges = lRet

End Function


Private Function PollChanges2(lInterval As Long) As Boolean
   Dim lNotified As Long

   lNotified = FindNextChangeNotification(mlFileNotifyHandle)

   Do
      lNotified = WaitForSingleObject(mlFileNotifyHandle, lInterval)
      DoEvents
   Loop While lNotified <> 0 And Not mbAbortFlag

   PollChanges2 = lNotified
End Function

'
'   This is the place where all the work occurs.
'
Public Sub Monitor(Optional eFlags As FileNotifyFlags = FileNotifyDefault)
    Dim lStatus As Long

    mbAbortFlag = False

    Call Create(eFlags)

    ' watch for changes
    lStatus = PollChanges(100)  ' check every 100 milliseconds for changes

    If mbAbortFlag Then
        Exit Sub
    End If

    ' zero means that we found something that has been changed.
    If lStatus = 0 Then
        ' notify the caller that the folder being monitored has
        ' changed
        RaiseEvent FolderChanged(FolderToWatch, meNotifyFlags)

        Do
            lStatus = PollChanges2(100) ' poll every 100 milliseconds

            If lStatus = 0 Then
               RaiseEvent FolderChanged(FolderToWatch, meNotifyFlags)
            End If

            ' keep monitoring until we are unsuccessful in finding a
            ' change.
        Loop While lStatus = 0
   End If

   Remove   ' remove the monitoring handle
End Sub