You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

115 lines
3.5 KiB

Imports System.IO
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Public Class clsfilewatcher
Public WithEvents filetimer As New Timer
Public Filecollection As New Collection
Dim FiletimerStoped As Boolean = True
Public Sub AddFile(ByVal Filenr As Integer, ByVal filename As String, ByVal filedate As DateTime, ByVal indb As Boolean)
Dim fi As New System.IO.FileInfo(filename)
Filecollection.Add(New FileToWatch(Filenr, filename, fi.LastWriteTime, indb))
If FiletimerStoped Then
filetimer.Start()
filetimer.Enabled = True
FiletimerStoped = False
End If
End Sub
Sub New()
filetimer.Interval = 1000
End Sub
Private Sub filetimer_Tick(sender As Object, e As EventArgs) Handles filetimer.Tick
If Filecollection.Count = 0 Then
filetimer.Enabled = False
filetimer.Stop()
FiletimerStoped = True
End If
For i = 1 To Filecollection.Count
Dim ftw As FileToWatch = Filecollection(i)
Dim fi As New System.IO.FileInfo(ftw.Filename)
If IsFileOpen(fi) Then Exit Sub
Dim finew As New System.IO.FileInfo(ftw.Filename)
If finew.LastWriteTime > ftw.Filedate Then
If ftw.InDB = True Then
Dim d As New clsDok
If d.Save_Document(ftw.FileNr, ftw.Filename) = False Then Exit Sub
End If
End If
Filecollection.Remove(i)
Next
End Sub
Private Function IsFileOpen(ByVal file As FileInfo) As Boolean
Dim stream As FileStream = Nothing
Try
stream = file.Open(FileMode.Open, FileAccess.ReadWrite, FileShare.None)
stream.Close()
Return False
Catch ex As Exception
Return True
If TypeOf ex Is IOException AndAlso IsFileLocked(ex) Then
' do something here, either close the file if you have a handle, show a msgbox, retry or as a last resort terminate the process - which could cause corruption and lose data
End If
End Try
End Function
Private Shared Function IsFileLocked(exception As Exception) As Boolean
Dim errorCode As Integer = Marshal.GetHRForException(exception) And ((1 << 16) - 1)
Return errorCode = 32 OrElse errorCode = 33
End Function
End Class
Public Class FileToWatch
Dim m_filenr As Integer
Property FileNr As Integer
Get
Return m_filenr
End Get
Set(value As Integer)
m_filenr = value
End Set
End Property
Dim m_filename As String
Property Filename As String
Get
Return m_filename
End Get
Set(value As String)
m_filename = value
End Set
End Property
Dim m_filedate As DateTime
Property Filedate As DateTime
Get
Return m_filedate
End Get
Set(value As DateTime)
m_filedate = value
End Set
End Property
Dim m_indb As Boolean
Property InDB As Boolean
Get
Return m_indb
End Get
Set(value As Boolean)
m_indb = value
End Set
End Property
Sub New(ByVal Filenr As Integer, ByVal Filename As String, ByVal filedate As DateTime, ByVal indb As Boolean)
Me.FileNr = Filenr
Me.Filename = Filename
Me.Filedate = filedate
Me.InDB = indb
End Sub
End Class