Modules/DDZUGFeRDService/ThreadRunner.vb
Digital Data - Marlon Schreiber cf461c79d9 Working Rejected
2019-09-24 13:16:01 +02:00

203 lines
7.7 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 _attachmentDirectory 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 Not IsNothing(_mssql) Then
_logger.Debug("Data will also 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..")
' Use MSSQL Server if available
If Not IsNothing(_mssql) Then
'Checking if documents have bee´n rejected
Dim oSQL As String = "Select * from TBEDMI_DOC_REJECTED WHERE MD5_UPDATE = 0"
Dim oDT As DataTable = _mssql.GetDatatable(oSQL)
If Not IsNothing(oDT) Then
For Each oRow As DataRow In oDT.Rows
oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET REJECTED = TRUE WHERE MESSAGE_ID = '{oRow.Item("MESSAGE_ID")}'"
If _firebird.ExecuteNonQuery(oSQL) = True Then
oSQL = $"UPDATE TBEDMI_DOC_REJECTED SET MD5_UPDATE = 1 WHERE GUID = '{oRow.Item("GUID")}'"
If _mssql.ExecuteNonQuery(oSQL) = True Then
_logger.Debug($"Refreshed the Rejected Info for messageid [{oRow.Item("MESSAGE_ID")}]")
End If
End If
Next
Else
_logger.Warn("oDTTBEDMI_DOC_REJECTED is nothing...")
End If
End If
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")
Case ZUGFERD_ATTACHMENTS
args.AttachmentsSubDirectory = 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 ORDER BY XML_PATH"
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")
Dim isGrouped = row.Item("IS_GROUPED")
Dim groupScope = row.Item("GROUP_SCOPE")
args.PropertyMap.Add(xmlPath, New XmlItemProperty() With {
.Description = description,
.TableName = tableName,
.IsRequired = isRequired,
.IsGrouped = isGrouped,
.GroupScope = groupScope
})
Next
Return args
End Function
End Class