177 lines
6.2 KiB
VB.net
177 lines
6.2 KiB
VB.net
Imports System.ComponentModel
|
|
Imports System.IO
|
|
Imports System.Timers
|
|
Imports System.Xml.XPath
|
|
Imports DigitalData.Modules.Database
|
|
Imports DigitalData.Modules.Interfaces
|
|
Imports DigitalData.Modules.Jobs
|
|
Imports DigitalData.Modules.Jobs.ImportZUGFeRDFiles
|
|
Imports DigitalData.Modules.Logging
|
|
|
|
Public Class ThreadRunner
|
|
|
|
Private WithEvents _workerThread As BackgroundWorker
|
|
Private WithEvents _workerTimer As Timer
|
|
|
|
Private _logConfig As LogConfig
|
|
Private _logger As Logger
|
|
Private _firebird As Firebird
|
|
Private _watchDirectories As List(Of String)
|
|
Private _successDirectory As String
|
|
Private _errorDirectory As String
|
|
Private _originalEmailDirectory As String
|
|
Private _zugferd As ZUGFeRDInterface
|
|
Private _jobArguments As WorkerArgs
|
|
Private _mssql As MSSQLServer
|
|
|
|
Private Const TIMER_INTERVAL_MS = 10_000
|
|
|
|
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
|
|
_logConfig = LogConfig
|
|
_logger = _logConfig.GetLogger()
|
|
_firebird = Firebird
|
|
_zugferd = New ZUGFeRDInterface(_logConfig)
|
|
_mssql = MSSQL
|
|
|
|
Dim args As New WorkerArgs()
|
|
args = LoadFolderConfig(args)
|
|
args = LoadPropertyMapFor(args, "DEFAULT")
|
|
|
|
' Use MSSQL Server if available
|
|
If _mssql IsNot Nothing Then
|
|
_logger.Debug("Data will be inserted into MSSQL Server.")
|
|
args.InsertIntoSQLServer = True
|
|
End If
|
|
|
|
_jobArguments = args
|
|
|
|
_logger.Debug("Checking SuccessDirectory {0}", args.SuccessDirectory)
|
|
If Not Directory.Exists(args.SuccessDirectory) Then
|
|
_logger.Warn("SuccessDirectory {0} does not exist!", args.SuccessDirectory)
|
|
End If
|
|
|
|
_logger.Debug("Checking ErrorDirectory {0}", args.ErrorDirectory)
|
|
If Not Directory.Exists(args.ErrorDirectory) Then
|
|
_logger.Warn("ErrorDirectory {0} does not exist!", args.ErrorDirectory)
|
|
End If
|
|
|
|
_logger.Debug("Checking Original Email Directory {0}", args.OriginalEmailDirectory)
|
|
If Not Directory.Exists(args.OriginalEmailDirectory) Then
|
|
_logger.Warn("OriginalEmailDirectory {0} does not exist!", args.OriginalEmailDirectory)
|
|
End If
|
|
|
|
_logger.Debug("Checking Rejected Email Directory {0}", args.RejectedEmailDirectory)
|
|
If Not Directory.Exists(args.RejectedEmailDirectory) Then
|
|
_logger.Warn("RejectedEmailDirectory {0} does not exist!", args.RejectedEmailDirectory)
|
|
End If
|
|
|
|
For Each oDirectory In args.WatchDirectories
|
|
_logger.Debug("Checking WatchDirectory {0}", oDirectory)
|
|
If Not Directory.Exists(oDirectory) Then
|
|
_logger.Warn("WatchDirectory {0} does not exist!", oDirectory)
|
|
End If
|
|
Next
|
|
|
|
_workerThread = New BackgroundWorker() With {
|
|
.WorkerReportsProgress = False,
|
|
.WorkerSupportsCancellation = True
|
|
}
|
|
|
|
_workerTimer = New Timer()
|
|
End Sub
|
|
|
|
Public Sub Start(Interval As Integer)
|
|
_workerTimer.Interval = Interval * 1000
|
|
_workerTimer.Start()
|
|
_logger.Debug("ThreadRunner started with {0}s Interval.", Interval)
|
|
End Sub
|
|
|
|
Public Sub [Stop]()
|
|
Try
|
|
If _workerThread.IsBusy Then
|
|
_workerThread.CancelAsync()
|
|
_logger.Debug("Worker cancelled.")
|
|
End If
|
|
_workerTimer.Stop()
|
|
_logger.Debug("ThreadRunner stopped.")
|
|
Catch ex As Exception
|
|
_logger.Error(ex)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub TimerElapsed(sender As Object, e As ElapsedEventArgs) Handles _workerTimer.Elapsed
|
|
If Not _workerThread.IsBusy Then
|
|
_workerThread.RunWorkerAsync(_jobArguments)
|
|
Else
|
|
_logger.Warn("Worker is busy")
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub DoWork(sender As Object, e As DoWorkEventArgs) Handles _workerThread.DoWork
|
|
Try
|
|
Dim args As WorkerArgs = e.Argument
|
|
|
|
_logger.Debug("Background worker running..")
|
|
|
|
Dim job As New ImportZUGFeRDFiles(_logConfig, _firebird, _mssql)
|
|
job.Start(args)
|
|
Catch ex As Exception
|
|
_logger.Warn("Background worker failed!")
|
|
_logger.Error(ex)
|
|
End Try
|
|
End Sub
|
|
|
|
Private Sub WorkCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles _workerThread.RunWorkerCompleted
|
|
_logger.Debug("Background worker completed!")
|
|
End Sub
|
|
|
|
Private Function LoadFolderConfig(args As WorkerArgs)
|
|
Dim oSQL As String = "SELECT T1.FOLDER_TYPE, T.FOLDER_PATH FROM TBEDM_FOLDER T, TBEDM_FOLDER_TYPE T1 WHERE T.FOLDER_TYPE_ID = T1.GUID AND T1.""ACTIVE"" = True AND T.""ACTIVE"" = True"
|
|
Dim oResult As DataTable = _firebird.GetDatatable(oSQL)
|
|
|
|
For Each row As DataRow In oResult.Rows
|
|
Dim oFolderType = row.Item("FOLDER_TYPE")
|
|
|
|
Select Case oFolderType
|
|
Case ZUGFERD_IN
|
|
args.WatchDirectories.Add(row.Item("FOLDER_PATH"))
|
|
|
|
Case ZUGFERD_SUCCESS
|
|
args.SuccessDirectory = row.Item("FOLDER_PATH")
|
|
|
|
Case ZUGFERD_ERROR
|
|
args.ErrorDirectory = row.Item("FOLDER_PATH")
|
|
|
|
Case ZUGFERD_EML
|
|
args.OriginalEmailDirectory = row.Item("FOLDER_PATH")
|
|
|
|
Case ZUGFERD_REJECTED_EML
|
|
args.RejectedEmailDirectory = row.Item("FOLDER_PATH")
|
|
|
|
End Select
|
|
Next
|
|
|
|
Return args
|
|
End Function
|
|
|
|
Private Function LoadPropertyMapFor(args As WorkerArgs, specification As String)
|
|
Dim oSQL As String = $"SELECT * FROM TBEDM_XML_ITEMS WHERE SPECIFICATION = '{specification}' AND ACTIVE = True"
|
|
Dim oResult As DataTable = _firebird.GetDatatable(oSQL)
|
|
|
|
For Each row As DataRow In oResult.Rows
|
|
Dim xmlPath = row.Item("XML_PATH")
|
|
Dim tableName = row.Item("TABLE_NAME")
|
|
Dim description = row.Item("DESCRIPTION")
|
|
Dim isRequired = row.Item("IS_REQUIRED")
|
|
|
|
args.PropertyMap.Add(xmlPath, New XmlItemProperty() With {
|
|
.Description = description,
|
|
.TableName = tableName,
|
|
.IsRequired = isRequired
|
|
})
|
|
Next
|
|
|
|
Return args
|
|
End Function
|
|
End Class
|