2021-07-09 13:42:13 +02:00

221 lines
8.3 KiB
VB.net

Imports System.ComponentModel
Imports System.IO
Imports System.Timers
Imports System.Xml.XPath
Imports DigitalData.Modules.Config
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 _config As ConfigManager(Of Config)
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 _attachmentDirectory As String
Private _zugferd As ZUGFeRDInterface
Private _jobArguments As WorkerArgs
Private _mssql As MSSQLServer
Public Sub New(LogConfig As LogConfig, ConfigManager As ConfigManager(Of Config), Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_firebird = Firebird
_config = ConfigManager
_mssql = MSSQL
Try
Dim directory As New IO.DirectoryInfo(_logConfig.LogDirectory)
For Each file As IO.FileInfo In directory.GetFiles
If (Now - file.CreationTime).Days > 29 Then
file.Delete()
Else
Exit For
End If
Next
Catch ex As Exception
End Try
Dim oArgs As New WorkerArgs With {
.ExceptionEmailAddress = _config.Config.ExceptionEmailAddress
}
oArgs = LoadFolderConfig(oArgs)
oArgs = LoadPropertyMapFor(oArgs, "DEFAULT")
' Use MSSQL Server if available
If Not IsNothing(_mssql) Then
_logger.Debug("Data will also be inserted into MSSQL Server.")
oArgs.InsertIntoSQLServer = True
End If
_jobArguments = oArgs
_logger.Debug("Checking SuccessDirectory {0}", oArgs.SuccessDirectory)
If Not Directory.Exists(oArgs.SuccessDirectory) Then
_logger.Warn("SuccessDirectory {0} does not exist!", oArgs.SuccessDirectory)
End If
_logger.Debug("Checking ErrorDirectory {0}", oArgs.ErrorDirectory)
If Not Directory.Exists(oArgs.ErrorDirectory) Then
_logger.Warn("ErrorDirectory {0} does not exist!", oArgs.ErrorDirectory)
End If
_logger.Debug("Checking Original Email Directory {0}", oArgs.OriginalEmailDirectory)
If Not Directory.Exists(oArgs.OriginalEmailDirectory) Then
_logger.Warn("OriginalEmailDirectory {0} does not exist!", oArgs.OriginalEmailDirectory)
End If
_logger.Debug("Checking Rejected Email Directory {0}", oArgs.RejectedEmailDirectory)
If Not Directory.Exists(oArgs.RejectedEmailDirectory) Then
_logger.Warn("RejectedEmailDirectory {0} does not exist!", oArgs.RejectedEmailDirectory)
End If
_logger.Debug("Checking Exception Email Adress {0}", oArgs.ExceptionEmailAddress)
If oArgs.ExceptionEmailAddress = String.Empty Then
_logger.Warn("ExceptionEmailAddress {0} is not set!", oArgs.ExceptionEmailAddress)
End If
For Each oDirectory In oArgs.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.Info("Worker is busy, skipping execution.")
End If
End Sub
Private Sub DoWork(sender As Object, e As DoWorkEventArgs) Handles _workerThread.DoWork
Try
Try
Dim oSQL = "SELECT [EMAIL_MSGID] FROM TBEMLP_HISTORY WHERE STATUS = 'REJECTED' and REJECTED = false and DATEDIFF(DAY,CHANGED_WHEN,GETDATE()) <= 5 order by guid desc"
Dim oDT As DataTable = _mssql.GetDatatable(oSQL)
If Not IsNothing(oDT) Then
For Each oROW As DataRow In oDT.Rows
Dim oUpdate = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET REJECTED = True WHERE MESSAGE_ID = '{oROW.Item(0)}'"
_firebird.ExecuteNonQuery(oUpdate)
Next
End If
Catch ex As Exception
_logger.Warn("Error while Updating REJECTED State: " & ex.Message)
End Try
Dim args As WorkerArgs = e.Argument
_logger.Debug("Background worker running..")
Dim job As New ImportZUGFeRDFiles(_logConfig, _firebird, _config.Config.MSSQLEmailOutAccountID, _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(pArgs As WorkerArgs) 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
pArgs.WatchDirectories.Add(row.Item("FOLDER_PATH"))
Case ZUGFERD_SUCCESS
pArgs.SuccessDirectory = row.Item("FOLDER_PATH")
Case ZUGFERD_ERROR
pArgs.ErrorDirectory = row.Item("FOLDER_PATH")
Case ZUGFERD_EML
pArgs.OriginalEmailDirectory = row.Item("FOLDER_PATH")
Case ZUGFERD_REJECTED_EML
pArgs.RejectedEmailDirectory = row.Item("FOLDER_PATH")
Case ZUGFERD_ATTACHMENTS
pArgs.AttachmentsSubDirectory = row.Item("FOLDER_PATH")
End Select
Next
Return pArgs
End Function
Private Function LoadPropertyMapFor(pArgs As WorkerArgs, pSpecification As String) As WorkerArgs
Dim oSQL As String = $"SELECT * FROM TBEDM_XML_ITEMS WHERE SPECIFICATION = '{pSpecification}' AND ACTIVE = True ORDER BY XML_PATH"
Dim oResult As DataTable = _firebird.GetDatatable(oSQL)
For Each row As DataRow In oResult.Rows
Dim oXmlPath = row.Item("XML_PATH")
Dim oTableName = row.Item("TABLE_NAME")
Dim oTableColumn = row.Item("TABLE_COLUMN")
Dim oDescription = row.Item("DESCRIPTION")
Dim oIsRequired = row.Item("IS_REQUIRED")
Dim oIsGrouped = row.Item("IS_GROUPED")
Dim oGroupScope = row.Item("GROUP_SCOPE")
pArgs.PropertyMap.Add(oXmlPath, New XmlItemProperty() With {
.Description = oDescription,
.TableName = oTableName,
.TableColumn = oTableColumn,
.IsRequired = oIsRequired,
.IsGrouped = oIsGrouped,
.GroupScope = oGroupScope
})
Next
Return pArgs
End Function
End Class