vb/WatchedFolder/KernelWatchDirectory.bas

Attribute VB_Name = "KernelWatchDirectory"
'
'    2002-10-01
'
'    --------------------------------------------------------------------------------
'
'      Visual Basic File API Routines  -  Creating a Watched Folder with FindChangeNotification
'
'      from: http://www.mvps.org/vbnet/index.html?code/fileapi/watchedfolder.htm
'
'    --------------------------------------------------------------------------------
'
'    Posted:   Saturday November 22, 1997
'    Updated:   Monday August 05, 2002
'
'    Applies to:   VB4-32, VB5, VB6
'    Developed with:   VB4-32, Windows 95
'    OS restrictions:   None
'    Author:   VBnet - Randy Birch
'
'   Related
'       How to Receive Shell Change Notifications
'
'   Prerequisites
'       A folder you can add and delete files from.
'
'    --------------------------------------------------------------------------------
'
'    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.
'    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.
'    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.
'
'   BAS Module Code
'    Place the following code into the general declarations area of a bas module:
'
'    --------------------------------------------------------------------------------
 

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Const INFINITE As Long = &HFFFFFFFF
Public Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1
Public Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Public Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Public Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8
Public Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10
Public Const FILE_NOTIFY_CHANGE_LAST_ACCESS As Long = &H20
Public Const FILE_NOTIFY_CHANGE_CREATION As Long = &H40
Public Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100
Public Const FILE_NOTIFY_FLAGS = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                 FILE_NOTIFY_CHANGE_FILE_NAME Or _
                                 FILE_NOTIFY_CHANGE_LAST_WRITE

Public Declare Function FindFirstChangeNotification Lib "kernel32" _
    Alias "FindFirstChangeNotificationA" _
   (ByVal lpPathName As String, _
    ByVal bWatchSubtree As Long, _
    ByVal dwNotifyFilter As Long) As Long

Public Declare Function FindCloseChangeNotification Lib "kernel32" _
   (ByVal hChangeHandle As Long) As Long

Public Declare Function FindNextChangeNotification Lib "kernel32" _
   (ByVal hChangeHandle As Long) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" _
   (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Const WAIT_OBJECT_0 As Long = &H0
Public Const WAIT_ABANDONED As Long = &H80
Public Const WAIT_IO_COMPLETION As Long = &HC0
Public Const WAIT_TIMEOUT As Long = &H102
Public Const STATUS_PENDING As Long = &H103
'--end block--'
 
 
' >>>>>> Form Code
  
'   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:

'   --------------------------------------------------------------------------------
 
Option Explicit

Dim hChangeHandle As Long
Dim hWatched As Long
Dim terminateFlag As Long

Private Sub Form_Load()

   Label2.Caption = "Press 'Begin Watch'"
   
End Sub


Private Sub Command3_Click()

   If hWatched > 0 Then Call WatchDelete(hWatched)
   Unload Me

End Sub


Private Sub Command2_Click()

  'clean up by deleting the handle to the watched directory
   Call WatchDelete(hWatched)
   hWatched = 0
      
   Command1.Enabled = True
   Label2.Caption = "Press 'Begin Watch'"

End Sub


Private Sub Command1_Click()

   Dim r As Long
   Dim watchPath As String
   Dim watchStatus As Long
   
   watchPath = "d:\dummy"
   terminateFlag = False
   Command1.Enabled = False
   
   Label2.Caption = _
        "Using Explorer and Notepad, create, modify, rename, delete or " & _
        "change the attributes of a text file in the watched directory."""

  'get the first file text attributes to the listbox (if any)
   WatchChangeAction watchPath
   
  'show a msgbox to indicate the watch is starting
   MsgBox "Beginning watching of folder " & watchPath & " .. press OK"
   
  'create a watched directory
   hWatched = WatchCreate(watchPath, FILE_NOTIFY_FLAGS)
   
  'poll the watched folder
   watchStatus = WatchDirectory(hWatched, 100)
   
  'if WatchDirectory exited with watchStatus = 0,
  'then there was a change in the folder.
   If watchStatus = 0 Then
   
      'update the listbox for the first file found in the
      'folder and indicate a change took place.
       WatchChangeAction watchPath
       
       MsgBox "The watched directory has been changed.  Resuming watch..."
       
      '(perform actions)
      'this is where you'd actually put code to perform a
      'task based on the folder changing.
       
      'now go into a second loop, this time calling the
      'FindNextChangeNotification API, again exiting if
      'watchStatus indicates the terminate flag was set
       Do
         watchStatus = WatchResume(hWatched, 100)
         
         If watchStatus = -1 Then
              'watchStatus must have exited with the terminate flag
               MsgBox "Watching has been terminated for " & watchPath
         
         Else: WatchChangeAction watchPath
               MsgBox "The watched directory has been changed again."
              
              '(perform actions)
              'this is where you'd actually put code to perform a
              'task based on the folder changing.
               
         End If
         
       Loop While watchStatus = 0
   
   
   Else
     'watchStatus must have exited with the terminate flag
      MsgBox "Watching has been terminated for " & watchPath
   
   End If
   
End Sub


Private Function WatchCreate(lpPathName As String, flags As Long) As Long

  'FindFirstChangeNotification members:
  '
  '  lpPathName: folder to watch
  '  bWatchSubtree:
  '     True = watch specified folder and its sub folders
  '     False = watch the specified folder only
  '  flags: OR'd combination of the FILE_NOTIFY_ flags to apply
  
   WatchCreate = FindFirstChangeNotification(lpPathName, False, flags)

End Function


Private Sub WatchDelete(hWatched As Long)
    
   terminateFlag = True
   DoEvents

   Call FindCloseChangeNotification(hWatched)
 
End Sub


Private Function WatchDirectory(hWatched As Long, interval As Long) As Long

  'Poll the watched folder.
  'The Do..Loop will exit when:
  '   r = 0, indicating a change has occurred
  '   terminateFlag = True, set by the WatchDelete routine
  
   Dim r As Long
   
   Do
   
      r = WaitForSingleObject(hWatched, interval)
      DoEvents
   
   Loop While r <> 0 And terminateFlag = False
   
   WatchDirectory = r
   
End Function


Private Function WatchResume(hWatched As Long, interval) As Boolean

   Dim r As Long
   
   r = FindNextChangeNotification(hWatched)
   
   Do
      
      r = WaitForSingleObject(hWatched, interval)
      DoEvents
   
   Loop While r <> 0 And terminateFlag = False
   
   WatchResume = r
   
End Function


Private Sub WatchChangeAction(fPath As String)

   Dim fName As String
   
   List1.Clear

   fName = Dir(fPath & "\" & "*.txt")
   
   If fName > "" Then
   
      List1.AddItem "path: " & vbTab & fPath
      List1.AddItem "file: " & vbTab & fName
      List1.AddItem "size: " & vbTab & FileLen(fPath & "\" & fName)
      List1.AddItem "attr: " & vbTab & GetAttr(fPath & "\" & fName)
   
   End If

End Sub
'--end block--'
 
 
'   Comments
'    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.
'    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.
'    --------------------------------------------------------------------------------
'
'    --------------------------------------------------------------------------------
'
'    Copyright ©1996-2002 ebirch ltd/VBnet and Randy Birch. All Rights Reserved.  Terms of Use
'
'    --------------------------------------------------------------------------------
'

1	joko	1.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
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26