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 _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 Try Dim oSQL = "SELECT [EMAIL_MSGID] FROM TBEMLP_HISTORY WHERE STATUS = 'REJECTED' 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)}' and REJECTED = false" _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, My.Settings.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(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