Re: FileSystemWatcher advice required please


Here's a complete VB 2005 application that monitors a directory tree and
processes files that are ready to process. I defined ready to process as a
non-zero byte size file that hasn't had a change in file size for at least
one minute. I think I have indented the correctly - to verify the indents,
copy into a VB 2005 project and use the IDE's indenter.

Mike.

'============================================================

Option Compare Text
Option Explicit On
Option Strict On

Imports System.IO
Imports System.Threading

Module ArchiveImportLoader
Private ArchiveImport As String
Private FilesToProcess As ProcessFiles
Private fsw As FileSystemWatcher
Private Declare Function GetConsoleWindow Lib "kernel32.dll" () As IntPtr
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As IntPtr,
ByVal nCmdShow As Int32) As Int32
Private Const SW_SHOWMINNOACTIVE As Int32 = 7

Public Sub Main()
Dim NoVersion As New Collection
logs.WriteLog(My.Application.Info.Title & " Starting")
Console.Title = AppName()
Thread.CurrentThread.Name = "MAIN"
' Read environment
ArchiveImport = OSInterface.iniWrapper.ReadString("ArchiveManager",
"ImportRoot", "wakefield.ini")
Dim ArchiveRoot As String =
OSInterface.iniWrapper.ReadString("ArchiveManager", "Root", "wakefield.ini")
For Each v As String In
Split(OSInterface.iniWrapper.ReadString("ArchiveManager", "NoVersion",
"wakefield.ini"), "|")
NoVersion.Add("*" & v)
Next
' Ensure the import directory exists
WriteLog("Creating File System Watcher on '" & ArchiveImport & "'")
My.Computer.FileSystem.CreateDirectory(ArchiveImport)
' Start the worker thread and configure the FSW subsystem
FilesToProcess = New ProcessFiles(ArchiveImport, ArchiveRoot, NoVersion)
ConfigureFSW()
' Configuration done; Minimize the window
WriteLog("Initialization Complete")
Thread.Sleep(New TimeSpan(0, 0, 5))
ShowWindow(GetConsoleWindow(), SW_SHOWMINNOACTIVE)
' Go to sleep, but periodically wakeup and check for missed files
Dim SleepPeriod As TimeSpan = New TimeSpan(0, 15, 0)
Do While True
Console.WriteLine(Now.ToString & vbTab & Thread.CurrentThread.Name & ":
Checking for Missed Files")
ProcessTree()
Thread.Sleep(SleepPeriod)
Loop
End Sub

Private Sub ProcessTree()
Try
My.Computer.FileSystem.CreateDirectory(ArchiveImport)
For Each fName As String In
My.Computer.FileSystem.GetFiles(ArchiveImport,
FileIO.SearchOption.SearchAllSubDirectories)
FilesToProcess.Add(fName)
Next
Catch ex As Exception
WriteLog(ex.ToString)
End Try
End Sub

Private Sub ConfigureFSW()
WriteLog("ConfigureFSW: Configure File System Watcher on '" &
ArchiveImport & "'")
My.Computer.FileSystem.CreateDirectory(ArchiveImport)
If Not fsw Is Nothing Then
WriteLog(vbTab & "Lost Previous File System Watcher system context,
removing from application")
With fsw
.EnableRaisingEvents = False
RemoveHandler .Changed, AddressOf OnFSWChanged
RemoveHandler .Error, AddressOf OnFSWError
End With
fsw = Nothing
End If
WriteLog(vbTab & "Create New File System Watcher on '" & ArchiveImport &
"'")
fsw = New FileSystemWatcher(ArchiveImport, "*")
With fsw
.NotifyFilter = NotifyFilters.Size
.IncludeSubdirectories = True
AddHandler .Changed, AddressOf OnFSWChanged
AddHandler .Error, AddressOf OnFSWError
.EnableRaisingEvents = True
End With
End Sub

Private Sub OnFSWChanged(ByVal sender As Object, ByVal e As
FileSystemEventArgs)
' Specify what is done when a file is changed, created, or deleted.
On Error Resume Next
Thread.CurrentThread.Name = "FSWChanged"
FilesToProcess.Add(e.FullPath)
End Sub

Private Sub OnFSWError(ByVal sender As Object, ByVal e As ErrorEventArgs)
On Error Resume Next
Thread.CurrentThread.Name = "FSWError"
WriteLog(TypeName(sender) & vbNewLine & e.ToString)
ConfigureFSW()
ProcessTree()
End Sub

Public Sub WriteLog(ByVal msg As String)
On Error Resume Next
Dim tName As String = Thread.CurrentThread.Name
If tName <> "" Then msg = tName & ": " & msg
Console.WriteLine(Now.ToString & vbTab & msg)
logs.WriteLog(msg)
End Sub
End Module

Public Class ProcessFiles
Inherits Collections.ObjectModel.KeyedCollection(Of String, FileToMove)

Private ThreadLock As New SynchronizationContext
Private NewFile As New AutoResetEvent(False)
' Set up the WorkerThread last as the sync objects need to exist
Private WorkerThread As New Thread(AddressOf Worker)

' One object can be passed to a new worker thread when it starts; the
FileControl class is that object
Private Class FileControl
Public ImportRoot As String
Public ArchiveRoot As String
Public NoVersion As New Collection
End Class

Protected Overrides Function GetKeyForItem(ByVal item As FileToMove) As
String
Return item.Key
End Function

Public Sub New(ByVal CopyFrom As String, ByVal CopyTo As String, ByVal
cNoVersions As Collection)
Dim fc As New FileControl
WriteLog("Creating new ProcessFiles container.")
With fc
.ImportRoot = CopyFrom
.ArchiveRoot = CopyTo
For Each str As String In cNoVersions
.NoVersion.Add(str, str)
Next
End With
WorkerThread.IsBackground = True ' Allow the program to exit at any time
WorkerThread.Name = "Mover" ' Used to track log entries
WorkerThread.Start(fc)
End Sub

Public Shadows Sub Add(ByVal File As String)
Try
Dim fm As New FileToMove(File)
SyncLock ThreadLock
If Not Contains(fm.Key) Then
MyBase.Add(fm)
WriteLog("Found '" & File & "'")
End If
End SyncLock
Catch ex As Exception
WriteLog(ex.ToString)
End Try
' Always trigger this just in case there are files waiting for movement
NewFile.Set()
End Sub

Private Sub Worker(ByVal obj As Object)
Dim fc As FileControl = CType(obj, FileControl)
Dim FilesRemaining As String
Dim LocalServer As String = My.Computer.Name
' The target file names will always be in UNC format. Local Server will be
used to replace the actual targ
' for the local copy that will get backed up to tape during incremental
backups.
Do While Left$(LocalServer, 1) = "\"
LocalServer = Mid$(LocalServer, 2)
Loop
LocalServer = "\\" & TrailSlash(LocalServer) ' Format is now
"\\<servername>\"
' This thread never exits
Do While True
' Wait for a file to be added to the list
NewFile.WaitOne()
Do While Count > 0
FilesRemaining = ""
Dim WaitTime As TimeSpan = FileToMove.OneMinute
Dim index As Integer = Count - 1
Try
Do While index >= 0
Dim f As FileToMove = Item(index)
Dim msg As String = ""
Try
If f.SizeStable Then
Dim FileBase As String = Mid$(f.FileName, InStrRev(f.FileName,
"\") + 1)
Dim DestFile As String = Replace(f.FileName, fc.ImportRoot &
"\", fc.ArchiveRoot & "\")
Dim UseVersioning As Boolean = True
For Each template As String In fc.NoVersion
If FileBase Like template Then
UseVersioning = False
Exit For
End If
Next
If UseVersioning AndAlso File.Exists(DestFile) Then
Dim i As Integer = InStrRev(DestFile, ".")
Dim FileExt As String = ""
If i > 0 Then
FileBase = Left$(DestFile, i - 1)
FileExt = Mid$(DestFile, i)
Else
FileBase = DestFile
End If
i = 0
Do
i += 1
DestFile = FileBase & "_" & i.ToString & FileExt
Loop While File.Exists(DestFile)
End If
' Move the source file
Try
' Copy to the local archives first; always override the
destination
Dim LocalDest As String = Replace(DestFile, "\\hermes\",
LocalServer)
Try
My.Computer.FileSystem.CopyFile(f.FileName, LocalDest)
Catch ex As Exception
logs.WriteLog("Unable to copy '" & f.FileName & "' to '" &
LocalDest & "'")
End Try
My.Computer.FileSystem.MoveFile(f.FileName, DestFile, True)
msg &= vbNewLine & "Moving '" & f.FileName & "' => '" &
DestFile
SyncLock ThreadLock
Remove(f.Key)
End SyncLock
Catch ex As Exception
msg &= vbNewLine & "Exception Processing: " & f.FileName &
vbNewLine & ex.ToString
If FilesRemaining <> "" Then FilesRemaining &= vbNewLine
FilesRemaining &= f.FileName
End Try
Else
If FilesRemaining <> "" Then FilesRemaining &= vbNewLine
FilesRemaining &= f.FileName
End If
Catch ex As FileNotFoundException
SyncLock ThreadLock
Remove(f.FileName)
End SyncLock
Catch ex As Exception
If FilesRemaining <> "" Then FilesRemaining &= vbNewLine
FilesRemaining &= f.FileName
msg &= vbNewLine & "Exception Processing: " & f.FileName &
vbNewLine & ex.ToString
Finally
If f.NextCheck < WaitTime Then WaitTime = f.NextCheck
End Try
If msg <> "" Then WriteLog(msg)
' Decrement index to get the next item. This always works as deleting
an item will leave the bottom index the same
index -= 1
Loop
Catch ex As Exception
WriteLog(ex.ToString)
End Try
If Count > 0 Then
WriteLog("Files Left: " & Count.ToString & vbNewLine & FilesRemaining)
WriteLog("Sleep Until: " & (Now + WaitTime).ToString)
Thread.Sleep(WaitTime)
WriteLog("Sleep Done: " & Now.ToString)
End If
Loop
Loop
End Sub
End Class

Public Class FileToMove
Private mFileName As String
Private utcLastChecked As Date
Private mLastSize As Long = 0
Public Shared ReadOnly OneMinute As TimeSpan = New TimeSpan(0, 1, 0)
Private Shared ReadOnly OneHour As TimeSpan = New TimeSpan(1, 0, 0)

Public Sub New(ByVal FileName As String)
mFileName = FileName
UpdateSize()
utcLastChecked =
My.Computer.FileSystem.GetFileInfo(mFileName).LastWriteTime.ToUniversalTime
End Sub

Public ReadOnly Property Key() As String
Get
Return mFileName
End Get
End Property

Public ReadOnly Property FileName() As String
Get
Return mFileName
End Get
End Property

Private Shared ReadOnly Property utcNow() As Date
Get
Return Now.ToUniversalTime
End Get
End Property

Private Sub UpdateSize()
UpdateSize(My.Computer.FileSystem.GetFileInfo(mFileName).Length)
End Sub

Private Sub UpdateSize(ByVal NewSize As Long)
mLastSize = NewSize
utcLastChecked = utcNow
End Sub

Public ReadOnly Property SizeStable() As Boolean
Get
If mLastSize = 0 Then
If utcNow -
My.Computer.FileSystem.GetFileInfo(mFileName).CreationTime.ToUniversalTime >
OneHour Then
My.Computer.FileSystem.DeleteFile(mFileName)
Throw New FileNotFoundException("File still empty after one hour")
End If
UpdateSize()
Return False
End If
Dim CurrentSize As Long =
My.Computer.FileSystem.GetFileInfo(mFileName).Length
If mLastSize = CurrentSize AndAlso _
(utcNow - utcLastChecked) > OneMinute AndAlso _
(utcNow -
My.Computer.FileSystem.GetFileInfo(mFileName).LastWriteTime.ToUniversalTime)
OneMinute Then

Return True
Else
UpdateSize(CurrentSize)
Return False
End If
End Get
End Property

Public ReadOnly Property NextCheck() As TimeSpan
Get
Dim ts As TimeSpan = utcNow - utcLastChecked
Debug.Print(ts.ToString)
If ts > OneMinute Then Return New TimeSpan(0)
Debug.Print((OneMinute - ts).ToString)
Return OneMinute - ts
End Get
End Property
End Class

'===================================================================
<jimmyfishbean@xxxxxxxxxxx> wrote in message
news:1139920893.901524.19210@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Hi Kevin,

I am monitoring just for the OnCreated event as you have suggested:

fsw.IncludeSubdirectories = False
fsw.NotifyFilter = System.IO.NotifyFilters.LastWrite
fsw.NotifyFilter = System.IO.NotifyFilters.FileName
fsw.NotifyFilter = System.IO.NotifyFilters.LastAccess

AddHandler fsw.Changed, AddressOf OnCreated
AddHandler fsw.Created, AddressOf OnCreated 'not recommended see the
link at top this while loop

In my OnCreated sub, I try to move all files that have been dropped
into the DROP folder to a different folder where they will be
processed. I would expect all files to be moved:

If Not Directory.Exists(strDir & "\Temp") Then
Directory.CreateDirectory(strDir & "\Temp")
End If

If File.Exists(strDir & "\Temp\" & e.Name) Then
File.Delete(strDir & "\Temp\" & e.Name)
End If

'now move the file(s)
For Each oFile In fso.GetFolder(strDir).Files
oFile.Move(strDir & "\Temp\" & e.Name)
bFileMoved = True
Next

However, only one file gets moved to the Temp folder. It seems as if
the OnCreated event gets called when the first file is identified as
being created, and when I try to move all files in the folder, the
filesystem thinks there is only the one file (i.e. the one that
triggered the event). Therefore, I have had to implement a timer that
will read the DROP folder, and move the remaining files periodically.
To me this is defeating the objective of the FileSystemWatcher.

To make matters worse ;P, the memory/no of handles used by my
application is forever increasing. I am closing objects and setting
them to nothing, as well as calling GC.Collect() in each sub.

Is this really how the FileSystemWatcher works? Can you please suggest
a more elegant/efficient way of achieving my aim? Much appreciated.

Jimmy





.

Relevant Pages

  • Whats wrong with the combobox in grid
    ... Private _cboColumn As ComboBox ... Private _strMember As String ... Public Sub New(ByVal objSource As DataSet, ByVal strMember As String, ByVal ... Dim index As Integer ...
    (microsoft.public.dotnet.languages.vb)
  • Service OnStart method
    ... Protected Overloads Overrides Sub Dispose ... Dim ServicesToRun() As System.ServiceProcess.ServiceBase ... Private components As System.ComponentModel.IContainer ... Private mstrZebraPrinterPath As String = vbNullString ...
    (microsoft.public.vsnet.general)
  • Re: FTP CD command
    ... Public Property UriAs String ... Private _UserName As String ... End Sub ... Dim listRequest As FtpWebRequest = CType, ...
    (microsoft.public.dotnet.languages.vb)
  • RE: Access and automated *.bmp insertion?
    ... Private Sub cmdAddImage_Click ... Dim OpenDlg As New BrowseForFileClass ... Dim strAdditionalTypes As String, strFileList As String ... Private Sub cmdDeleteImage_Click ...
    (microsoft.public.access.gettingstarted)
  • Re: Databases, Typed Datasets, and Flat Files oh my!
    ... Private m_DBFileName As String ... Public Sub New(ByVal Ordinal As Integer, ByVal ColumnName As String, ... Dim aCols() As Column ...
    (microsoft.public.dotnet.languages.vb)