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 ReadOnly _config As ConfigManager(Of Config) Private ReadOnly _logConfig As LogConfig Private ReadOnly _logger As Logger Private ReadOnly _firebird As Firebird Private ReadOnly _jobArguments As WorkerArgs Private ReadOnly _mssql As MSSQLServer Private ReadOnly RejectedMaxDifferenceInMinutes As Integer = 60 Private RejectedLastRun As Date = Now.AddMinutes(-(RejectedMaxDifferenceInMinutes - 1)) 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, .IgnoreRejectionStatus = _config.Config.Custom.IgnoreRejectionStatus, .MaxAttachmentSizeInMegaBytes = _config.Config.Custom.MaxAttachmentSizeInMegaBytes, .NamePortal = _config.Config.PORTAL_NAME } 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 _logger.Debug("Custom Options:") _logger.Debug("ExceptionEmailAddress: {0}", oArgs.ExceptionEmailAddress) _logger.Debug("IgnoreRejectionStatus: {0}", oArgs.IgnoreRejectionStatus) _logger.Debug("MaxAttachmentSizeInMegaBytes: {0}", oArgs.MaxAttachmentSizeInMegaBytes) _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 Non ZUGFeRD Directory {0}", oArgs.NonZugferdDirectory) If Not Directory.Exists(oArgs.NonZugferdDirectory) Then _logger.Warn("NonZugferdDirectory {0} does not exist!", oArgs.NonZugferdDirectory) 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 MaybeUpdateRejected() Try Dim oTimeUnit = _config.Config.Custom.RejectionTransferTimeUnit Dim oTimeValue = _config.Config.Custom.RejectionTransferTimeValue Dim oDifference As TimeSpan = Now - RejectedLastRun If oDifference.TotalMinutes < RejectedMaxDifferenceInMinutes Then _logger.Debug("Updating rejected files: Waiting for next run.") Exit Sub End If _logger.Info("Updating rejected files in Firebird.") Dim oSQL = $" SELECT [EMAIL_MSGID] FROM TBEMLP_HISTORY WHERE (STATUS = 'REJECTED' OR CUST_REJECTED = 1) AND FB_UPDATED = 0 AND DATEDIFF({oTimeUnit}, CHANGED_WHEN, GETDATE()) <= {oTimeValue} ORDER BY GUID DESC" Dim oTable As DataTable = _mssql.GetDatatable(oSQL) If Not IsNothing(oTable) Then For Each oROW As DataRow In oTable.Rows Dim oUpdate = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET REJECTED = True WHERE MESSAGE_ID = '{oROW.Item(0)}' and REJECTED = false" If _firebird.ExecuteNonQuery(oUpdate) = True Then Dim oUpdateSQL = $" UPDATE TBEMLP_HISTORY SET FB_UPDATED = 1 WHERE [EMAIL_MSGID] = '{oROW.Item(0)}' AND FB_UPDATED = 0" _mssql.ExecuteNonQuery(oUpdateSQL) End If Next RejectedLastRun = Now End If Catch ex As Exception _logger.Warn("Error while Updating REJECTED State: " & ex.Message) End Try End Sub Private Sub DoWork(sender As Object, e As DoWorkEventArgs) Handles _workerThread.DoWork Try MaybeUpdateRejected() Dim oArgs As WorkerArgs = e.Argument _logger.Debug("Background worker running..") Dim oJob As New ImportZUGFeRDFiles(_logConfig, _firebird, _config.Config.MSSQLEmailOutAccountID, _config.Config.PORTAL_NAME, _mssql) oJob.Start(oArgs) 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 oRow As DataRow In oResult.Rows Dim oFolderType = oRow.Item("FOLDER_TYPE") Select Case oFolderType Case ZUGFERD_IN pArgs.WatchDirectories.Add(oRow.Item("FOLDER_PATH")) Case ZUGFERD_SUCCESS pArgs.SuccessDirectory = oRow.Item("FOLDER_PATH") Case ZUGFERD_ERROR pArgs.ErrorDirectory = oRow.Item("FOLDER_PATH") Case ZUGFERD_EML pArgs.OriginalEmailDirectory = oRow.Item("FOLDER_PATH") Case ZUGFERD_REJECTED_EML pArgs.RejectedEmailDirectory = oRow.Item("FOLDER_PATH") Case ZUGFERD_ATTACHMENTS pArgs.AttachmentsSubDirectory = oRow.Item("FOLDER_PATH") Case ZUGFERD_NO_ZUGFERD _logger.Info($"## {ZUGFERD_NO_ZUGFERD}-Constant has been defined! [{oRow.Item("FOLDER_PATH")}]##") pArgs.NonZugferdDirectory = oRow.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