Modules/DDZUGFeRDService/ThreadRunner.vb
Jonathan Jenne d33624c66c jj firebird
2018-12-18 13:22:32 +01:00

153 lines
5.5 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 _zugferd As ZUGFeRDInterface
Private _jobArguments As WorkerArgs
Private Const TIMER_INTERVAL_MS = 60_000
Public Sub New(LogConfig As LogConfig, Firebird As Firebird)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_firebird = Firebird
_zugferd = New ZUGFeRDInterface(_logConfig)
Dim args As New WorkerArgs()
args = LoadFolderConfig(args)
args = LoadPropertyMapFor(args, "DEFAULT")
_jobArguments = args
_logger.Info("Checking SuccessDirectory {0}", args.SuccessDirectory)
If Not Directory.Exists(args.SuccessDirectory) Then
_logger.Warn("SuccessDirectory {0} does not exist!", args.SuccessDirectory)
'Throw New DirectoryNotFoundException("SuccessDirectory: " & args.SuccessDirectory)
End If
_logger.Info("Checking ErrorDirectory {0}", args.ErrorDirectory)
If Not Directory.Exists(args.ErrorDirectory) Then
'Throw New DirectoryNotFoundException("ErrorDirectory: " & args.ErrorDirectory)
_logger.Warn("ErrorDirectory {0} does not exist!", args.ErrorDirectory)
End If
For Each oDirectory In args.WatchDirectories
_logger.Info("Checking WatchDirectory {0}", oDirectory)
If Not Directory.Exists(oDirectory) Then
'Throw New DirectoryNotFoundException("WatchDirectory: " & oDirectory)
_logger.Warn("WatchDirectory {0} does not exist!", oDirectory)
End If
Next
_workerThread = New BackgroundWorker() With {
.WorkerReportsProgress = False,
.WorkerSupportsCancellation = True
}
_workerTimer = New Timer With {
.Interval = TIMER_INTERVAL_MS
}
End Sub
Public Sub Start()
_workerTimer.Start()
_logger.Debug("ThreadRunner started.")
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
Dim args As WorkerArgs = e.Argument
_logger.Debug("Background worker running..")
Dim job As New ImportZUGFeRDFiles(_logConfig, _firebird)
job.Start(args)
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
_logger.Debug("Setting WatchDirectory: {0}", row.Item("FOLDER_PATH"))
args.WatchDirectories.Add(row.Item("FOLDER_PATH"))
Case ZUGFERD_SUCCESS
_logger.Debug("Setting SuccessDirectory: {0}", row.Item("FOLDER_PATH"))
args.SuccessDirectory = row.Item("FOLDER_PATH")
Case ZUGFERD_ERROR
_logger.Debug("Setting ErrorDirectory: {0}", row.Item("FOLDER_PATH"))
args.ErrorDirectory = 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