| 1 |
Attribute VB_Name = "KernelWatchDirectory" |
| 2 |
' |
| 3 |
' 2002-10-01 |
| 4 |
' |
| 5 |
' -------------------------------------------------------------------------------- |
| 6 |
' |
| 7 |
' Visual Basic File API Routines - Creating a Watched Folder with FindChangeNotification |
| 8 |
' |
| 9 |
' from: http://www.mvps.org/vbnet/index.html?code/fileapi/watchedfolder.htm |
| 10 |
' |
| 11 |
' -------------------------------------------------------------------------------- |
| 12 |
' |
| 13 |
' Posted: Saturday November 22, 1997 |
| 14 |
' Updated: Monday August 05, 2002 |
| 15 |
' |
| 16 |
' Applies to: VB4-32, VB5, VB6 |
| 17 |
' Developed with: VB4-32, Windows 95 |
| 18 |
' OS restrictions: None |
| 19 |
' Author: VBnet - Randy Birch |
| 20 |
' |
| 21 |
' Related |
| 22 |
' How to Receive Shell Change Notifications |
| 23 |
' |
| 24 |
' Prerequisites |
| 25 |
' A folder you can add and delete files from. |
| 26 |
' |
| 27 |
' -------------------------------------------------------------------------------- |
| 28 |
' |
| 29 |
' Some applications need to know when the contents of a folder have changed. While polling the folder using a timer can provide the desired results, the Windows API exposes three functions to deal with this directly. |
| 30 |
' I was first directly exposed to 'watched directories' with PageMaker 6, which included a 'lite' version of the Adobe Distiller used to turn PageMaker documents into Adobe PDF files. The premise was simple ... the distiller ran as a background task, watching for files added to a specified folder. When the folder changed, the Distiller app became active and created the PDF file. This was the premise on which this code sample was designed. |
| 31 |
' The code presented here is coded to react only to the first file in the watched folder (via the WatchChangeAction sub. I leave it to the developer to add the full functionality that their app may require. |
| 32 |
' |
| 33 |
' BAS Module Code |
| 34 |
' Place the following code into the general declarations area of a bas module: |
| 35 |
' |
| 36 |
' -------------------------------------------------------------------------------- |
| 37 |
|
| 38 |
|
| 39 |
Option Explicit |
| 40 |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| 41 |
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved. |
| 42 |
' Some pages may also contain other copyrights by the author. |
| 43 |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| 44 |
' Distribution: You can freely use this code in your own |
| 45 |
' applications, but you may not reproduce |
| 46 |
' or publish this code on any web site, |
| 47 |
' online service, or distribute as source |
| 48 |
' on any media without express permission. |
| 49 |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
| 50 |
Public Const INFINITE As Long = &HFFFFFFFF |
| 51 |
Public Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1 |
| 52 |
Public Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2 |
| 53 |
Public Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4 |
| 54 |
Public Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8 |
| 55 |
Public Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10 |
| 56 |
Public Const FILE_NOTIFY_CHANGE_LAST_ACCESS As Long = &H20 |
| 57 |
Public Const FILE_NOTIFY_CHANGE_CREATION As Long = &H40 |
| 58 |
Public Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100 |
| 59 |
Public Const FILE_NOTIFY_FLAGS = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _ |
| 60 |
FILE_NOTIFY_CHANGE_FILE_NAME Or _ |
| 61 |
FILE_NOTIFY_CHANGE_LAST_WRITE |
| 62 |
|
| 63 |
Public Declare Function FindFirstChangeNotification Lib "kernel32" _ |
| 64 |
Alias "FindFirstChangeNotificationA" _ |
| 65 |
(ByVal lpPathName As String, _ |
| 66 |
ByVal bWatchSubtree As Long, _ |
| 67 |
ByVal dwNotifyFilter As Long) As Long |
| 68 |
|
| 69 |
Public Declare Function FindCloseChangeNotification Lib "kernel32" _ |
| 70 |
(ByVal hChangeHandle As Long) As Long |
| 71 |
|
| 72 |
Public Declare Function FindNextChangeNotification Lib "kernel32" _ |
| 73 |
(ByVal hChangeHandle As Long) As Long |
| 74 |
|
| 75 |
Public Declare Function WaitForSingleObject Lib "kernel32" _ |
| 76 |
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long |
| 77 |
|
| 78 |
Public Const WAIT_OBJECT_0 As Long = &H0 |
| 79 |
Public Const WAIT_ABANDONED As Long = &H80 |
| 80 |
Public Const WAIT_IO_COMPLETION As Long = &HC0 |
| 81 |
Public Const WAIT_TIMEOUT As Long = &H102 |
| 82 |
Public Const STATUS_PENDING As Long = &H103 |
| 83 |
'--end block--' |
| 84 |
|
| 85 |
|
| 86 |
' >>>>>> Form Code |
| 87 |
|
| 88 |
' Start a new project, and to the form add three command buttons (Command1, Command2 and Command3), a Listbox control (List1), and two labels (Label1 and Label2). Label1 is just the header above the listbox and can be entered as indicated in the illustration. Label2 is set during program run. Add the following code to the form: |
| 89 |
|
| 90 |
' -------------------------------------------------------------------------------- |
| 91 |
|
| 92 |
Option Explicit |
| 93 |
|
| 94 |
Dim hChangeHandle As Long |
| 95 |
Dim hWatched As Long |
| 96 |
Dim terminateFlag As Long |
| 97 |
|
| 98 |
Private Sub Form_Load() |
| 99 |
|
| 100 |
Label2.Caption = "Press 'Begin Watch'" |
| 101 |
|
| 102 |
End Sub |
| 103 |
|
| 104 |
|
| 105 |
Private Sub Command3_Click() |
| 106 |
|
| 107 |
If hWatched > 0 Then Call WatchDelete(hWatched) |
| 108 |
Unload Me |
| 109 |
|
| 110 |
End Sub |
| 111 |
|
| 112 |
|
| 113 |
Private Sub Command2_Click() |
| 114 |
|
| 115 |
'clean up by deleting the handle to the watched directory |
| 116 |
Call WatchDelete(hWatched) |
| 117 |
hWatched = 0 |
| 118 |
|
| 119 |
Command1.Enabled = True |
| 120 |
Label2.Caption = "Press 'Begin Watch'" |
| 121 |
|
| 122 |
End Sub |
| 123 |
|
| 124 |
|
| 125 |
Private Sub Command1_Click() |
| 126 |
|
| 127 |
Dim r As Long |
| 128 |
Dim watchPath As String |
| 129 |
Dim watchStatus As Long |
| 130 |
|
| 131 |
watchPath = "d:\dummy" |
| 132 |
terminateFlag = False |
| 133 |
Command1.Enabled = False |
| 134 |
|
| 135 |
Label2.Caption = _ |
| 136 |
"Using Explorer and Notepad, create, modify, rename, delete or " & _ |
| 137 |
"change the attributes of a text file in the watched directory.""" |
| 138 |
|
| 139 |
'get the first file text attributes to the listbox (if any) |
| 140 |
WatchChangeAction watchPath |
| 141 |
|
| 142 |
'show a msgbox to indicate the watch is starting |
| 143 |
MsgBox "Beginning watching of folder " & watchPath & " .. press OK" |
| 144 |
|
| 145 |
'create a watched directory |
| 146 |
hWatched = WatchCreate(watchPath, FILE_NOTIFY_FLAGS) |
| 147 |
|
| 148 |
'poll the watched folder |
| 149 |
watchStatus = WatchDirectory(hWatched, 100) |
| 150 |
|
| 151 |
'if WatchDirectory exited with watchStatus = 0, |
| 152 |
'then there was a change in the folder. |
| 153 |
If watchStatus = 0 Then |
| 154 |
|
| 155 |
'update the listbox for the first file found in the |
| 156 |
'folder and indicate a change took place. |
| 157 |
WatchChangeAction watchPath |
| 158 |
|
| 159 |
MsgBox "The watched directory has been changed. Resuming watch..." |
| 160 |
|
| 161 |
'(perform actions) |
| 162 |
'this is where you'd actually put code to perform a |
| 163 |
'task based on the folder changing. |
| 164 |
|
| 165 |
'now go into a second loop, this time calling the |
| 166 |
'FindNextChangeNotification API, again exiting if |
| 167 |
'watchStatus indicates the terminate flag was set |
| 168 |
Do |
| 169 |
watchStatus = WatchResume(hWatched, 100) |
| 170 |
|
| 171 |
If watchStatus = -1 Then |
| 172 |
'watchStatus must have exited with the terminate flag |
| 173 |
MsgBox "Watching has been terminated for " & watchPath |
| 174 |
|
| 175 |
Else: WatchChangeAction watchPath |
| 176 |
MsgBox "The watched directory has been changed again." |
| 177 |
|
| 178 |
'(perform actions) |
| 179 |
'this is where you'd actually put code to perform a |
| 180 |
'task based on the folder changing. |
| 181 |
|
| 182 |
End If |
| 183 |
|
| 184 |
Loop While watchStatus = 0 |
| 185 |
|
| 186 |
|
| 187 |
Else |
| 188 |
'watchStatus must have exited with the terminate flag |
| 189 |
MsgBox "Watching has been terminated for " & watchPath |
| 190 |
|
| 191 |
End If |
| 192 |
|
| 193 |
End Sub |
| 194 |
|
| 195 |
|
| 196 |
Private Function WatchCreate(lpPathName As String, flags As Long) As Long |
| 197 |
|
| 198 |
'FindFirstChangeNotification members: |
| 199 |
' |
| 200 |
' lpPathName: folder to watch |
| 201 |
' bWatchSubtree: |
| 202 |
' True = watch specified folder and its sub folders |
| 203 |
' False = watch the specified folder only |
| 204 |
' flags: OR'd combination of the FILE_NOTIFY_ flags to apply |
| 205 |
|
| 206 |
WatchCreate = FindFirstChangeNotification(lpPathName, False, flags) |
| 207 |
|
| 208 |
End Function |
| 209 |
|
| 210 |
|
| 211 |
Private Sub WatchDelete(hWatched As Long) |
| 212 |
|
| 213 |
terminateFlag = True |
| 214 |
DoEvents |
| 215 |
|
| 216 |
Call FindCloseChangeNotification(hWatched) |
| 217 |
|
| 218 |
End Sub |
| 219 |
|
| 220 |
|
| 221 |
Private Function WatchDirectory(hWatched As Long, interval As Long) As Long |
| 222 |
|
| 223 |
'Poll the watched folder. |
| 224 |
'The Do..Loop will exit when: |
| 225 |
' r = 0, indicating a change has occurred |
| 226 |
' terminateFlag = True, set by the WatchDelete routine |
| 227 |
|
| 228 |
Dim r As Long |
| 229 |
|
| 230 |
Do |
| 231 |
|
| 232 |
r = WaitForSingleObject(hWatched, interval) |
| 233 |
DoEvents |
| 234 |
|
| 235 |
Loop While r <> 0 And terminateFlag = False |
| 236 |
|
| 237 |
WatchDirectory = r |
| 238 |
|
| 239 |
End Function |
| 240 |
|
| 241 |
|
| 242 |
Private Function WatchResume(hWatched As Long, interval) As Boolean |
| 243 |
|
| 244 |
Dim r As Long |
| 245 |
|
| 246 |
r = FindNextChangeNotification(hWatched) |
| 247 |
|
| 248 |
Do |
| 249 |
|
| 250 |
r = WaitForSingleObject(hWatched, interval) |
| 251 |
DoEvents |
| 252 |
|
| 253 |
Loop While r <> 0 And terminateFlag = False |
| 254 |
|
| 255 |
WatchResume = r |
| 256 |
|
| 257 |
End Function |
| 258 |
|
| 259 |
|
| 260 |
Private Sub WatchChangeAction(fPath As String) |
| 261 |
|
| 262 |
Dim fName As String |
| 263 |
|
| 264 |
List1.Clear |
| 265 |
|
| 266 |
fName = Dir(fPath & "\" & "*.txt") |
| 267 |
|
| 268 |
If fName > "" Then |
| 269 |
|
| 270 |
List1.AddItem "path: " & vbTab & fPath |
| 271 |
List1.AddItem "file: " & vbTab & fName |
| 272 |
List1.AddItem "size: " & vbTab & FileLen(fPath & "\" & fName) |
| 273 |
List1.AddItem "attr: " & vbTab & GetAttr(fPath & "\" & fName) |
| 274 |
|
| 275 |
End If |
| 276 |
|
| 277 |
End Sub |
| 278 |
'--end block--' |
| 279 |
|
| 280 |
|
| 281 |
' Comments |
| 282 |
' Run the app, and press 'Begin'. After closing the MsgBox, launch notepad and create a file in the folder you specified as the watched directory. As soon as the file is saved, the 'changed' MsgBox should appear, and the file specs form the WatchChangeAction sub will populate the listbox. Make modifications to the file or its attributes, and save again. Each change will fire the API. |
| 283 |
' As mentioned above, this demo is coded only to take the first file returned by the Dir() function in WatchChangeAction .. you will need to customize this routine to achieve the effect you desire. |
| 284 |
' -------------------------------------------------------------------------------- |
| 285 |
' |
| 286 |
' -------------------------------------------------------------------------------- |
| 287 |
' |
| 288 |
' Copyright ©1996-2002 ebirch ltd/VBnet and Randy Birch. All Rights Reserved. Terms of Use |
| 289 |
' |
| 290 |
' -------------------------------------------------------------------------------- |
| 291 |
' |
| 292 |
|
Parent Directory
| 
Revision Log
