Useful Way to Watching File in VB6 without Function of Timer

Useful Way to Watching File in VB6 without Function of Timer

This application is useful to watching the file, generally programmer use the function of timer to watch the file or to do looping command. sometime with timer function we can get the miss data it may caused the interval of timer is too fast or too slow.


Let me let you know the other useful way to watching file.

Click Here to complete download


Add module
---------------------------------------------------------------------------------------------------------------------
Declare Function FindCloseChangeNotification Lib "Kernel32" (ByVal hChangeHandle As Long) As Long
Declare Function WaitForSingleObject Lib "Kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function FindFirstChangeNotification Lib "Kernel32" Alias "FindFirstChangeNotificationA" (ByVal lpPathName As String, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long) As Long
Declare Function FindNextChangeNotification Lib "Kernel32" (ByVal hChangeHandle As Long) As Long
Public Const FILE_NOTIFY_FLAGS = &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20 Or &H100 Or &H40


Public Function FileExists(Filename As String) As Boolean
Dim FileNumber As Integer
On Error Resume Next
FileNumber = FreeFile
Open Filename For Input As #FileNumber
Close #FileNumber


If Err Then
'Set FileExists on False and resume the error
FileExists = False
Else
'Set FileExists on True
FileExists = True
End If
End Function


Public Sub Delay(HowLong As Date)
Dim TempTime
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents 'Allows windows to handle other stuff
Wend
End Sub



Form1
---------------------------------------------------------------------------------------------------------------------
Dim hWatched As Long

Private Sub Form_Load()
Form1.Visible = True 'note: without this tags, form1 not opportunity to load the window
Call WatchStart
End Sub


Private Function WatchCreate(lpPathName As String, flags As Long) As Long
WatchCreate = FindFirstChangeNotification(lpPathName, False, flags)
End Function


Private Sub WatchDelete(hWatched As Long)
Dim r As Long
terminateFlag = True
DoEvents
r = FindCloseChangeNotification(hWatched)
End Sub


Private Function WatchDirectory(hWatched As Long, interval As Long) As Long
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 WatchStart()
Dim r As Long
Dim watchPath As String
Dim watchStatus As Long
watchPath = App.Path
terminateFlag = False
WatchChangeAction watchPath
hWatched = WatchCreate(watchPath, FILE_NOTIFY_FLAGS)
watchStatus = WatchDirectory(hWatched, 100)

If watchStatus = 0 Then
WatchChangeAction watchPath
Do
watchStatus = WatchResume(hWatched, 100)
If watchStatus = -1 Then
Else: WatchChangeAction watchPath
End If
Loop While watchStatus = 0
Else
MsgBox "Watching has been terminated for " & watchPath
End If
End Sub


Private Sub WatchChangeAction(fPath As String)
If FileExists(App.Path & "\try.txt") = True Then
DoEvents
Delay 1
Text1.Text = "found"
Call Resetdata
Else
Text1.Text = "watching"
End If
End Sub


Private Sub Resetdata()
If FileExists(App.Path & "\try.txt") = True Then
Kill (App.Path & "\try.txt")
Delay 1
End If
End Sub

Click Here to complete download