From cf461c79d9b1e84e0e27e75f903e82d3a0b7f9bc Mon Sep 17 00:00:00 2001 From: Digital Data - Marlon Schreiber Date: Tue, 24 Sep 2019 13:16:01 +0200 Subject: [PATCH] Working Rejected --- DDZUGFeRDService/ThreadRunner.vb | 26 ++++- GUIs.Test.ZUGFeRDTest/Form1.vb | 2 +- Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb | 129 +++++++++++++++--------- Modules.Database/Firebird.vb | 1 + Modules.Database/MSSQLServer.vb | 2 +- 5 files changed, 106 insertions(+), 54 deletions(-) diff --git a/DDZUGFeRDService/ThreadRunner.vb b/DDZUGFeRDService/ThreadRunner.vb index d1ffbe67..c95894c1 100644 --- a/DDZUGFeRDService/ThreadRunner.vb +++ b/DDZUGFeRDService/ThreadRunner.vb @@ -39,8 +39,8 @@ Public Class ThreadRunner args = LoadPropertyMapFor(args, "DEFAULT") ' Use MSSQL Server if available - If _mssql IsNot Nothing Then - _logger.Debug("Data will be inserted into MSSQL Server.") + If Not IsNothing(_mssql) Then + _logger.Debug("Data will also be inserted into MSSQL Server.") args.InsertIntoSQLServer = True End If @@ -113,7 +113,25 @@ Public Class ThreadRunner 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 @@ -159,7 +177,7 @@ Public Class ThreadRunner 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 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 diff --git a/GUIs.Test.ZUGFeRDTest/Form1.vb b/GUIs.Test.ZUGFeRDTest/Form1.vb index 08e1ce10..ec510ee9 100644 --- a/GUIs.Test.ZUGFeRDTest/Form1.vb +++ b/GUIs.Test.ZUGFeRDTest/Form1.vb @@ -58,7 +58,7 @@ Public Class Form1 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 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 oRow As DataRow In oResult.Rows diff --git a/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb b/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb index 99c87314..5bbcef61 100644 --- a/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -22,6 +22,7 @@ Public Class ImportZUGFeRDFiles Public Const ZUGFERD_EML = "ZUGFeRD Eml" Public Const ZUGFERD_REJECTED_EML = "ZUGFeRD Eml Rejected" Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments" + Public HISTORY_ID As Integer Private _logger As Logger Private _logConfig As LogConfig @@ -115,8 +116,8 @@ Public Class ImportZUGFeRDFiles Loop Try - File.Move(oSource, oDestination) - oEmailData.Attachment = oDestination + File.Move(oSource, oFileName) 'oDestination) + oEmailData.Attachment = oFileName 'oDestination Catch ex As Exception _logger.Warn("File {0} could not be moved! Original Filename will be used!", oSource) _logger.Error(ex) @@ -149,14 +150,21 @@ Public Class ImportZUGFeRDFiles _logger.Debug("To: {0}", oEmailTo) _logger.Debug("Subject: {0}", oSubject) _logger.Debug("Body {0}", BodyText) + Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'" + + Dim oDTResult As DataTable = _firebird.GetDatatable(osql) + If oDTResult.Rows.Count = 0 Then + Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE " + oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES " + oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{BodyText}', '{oCreatedWho}', '{oAttachment}')" + _firebird.ExecuteNonQuery(oSQLInsert) + _logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo) + Else + _logger.Debug("Email has already been sent!!") + End If - Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE " - oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES " - oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{BodyText}', '{oCreatedWho}', '{oAttachment}')" - _firebird.ExecuteNonQuery(oSQLInsert) - _logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo) Catch ex As Exception _logger.Error(ex) End Try @@ -203,13 +211,13 @@ Public Class ImportZUGFeRDFiles Public Sub Start(Arguments As Object) Implements IJob.Start - Dim args As WorkerArgs = Arguments + Dim oArgs As WorkerArgs = Arguments Dim oPropertyExtractor = New PropertyValues(_logConfig) _logger.Info("Starting Job {0}", [GetType].Name) Try - For Each oPath As String In args.WatchDirectories + For Each oPath As String In oArgs.WatchDirectories Dim oDirInfo As New DirectoryInfo(oPath) _logger.Info($"Start processing directory {oDirInfo.FullName}") @@ -244,7 +252,7 @@ Public Class ImportZUGFeRDFiles ' Count the amount of ZUGFeRD files Dim oZUGFeRDCount As Integer = 0 ' Set the default Move Directory - Dim oMoveDirectory As String = args.SuccessDirectory + Dim oMoveDirectory As String = oArgs.SuccessDirectory ' Create file lists Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value Dim oFileAttachmentFiles As New List(Of FileInfo) @@ -259,10 +267,8 @@ Public Class ImportZUGFeRDFiles Try For Each oFile In oFileGroupFiles Dim oDocument As CrossIndustryDocumentType - ' Start a global group counter for each file Dim oGlobalGroupCounter = 0 - ' Clear missing properties for the new file oMissingProperties = New List(Of String) oCurrentFileCount += 1 @@ -299,12 +305,22 @@ Public Class ImportZUGFeRDFiles oMD5CheckSum = CreateMD5(oFile.FullName) If oMD5CheckSum <> String.Empty Then - Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}')" + Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE GUID = (SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))" Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction) If Not IsNothing(oMD5DT) Then If oMD5DT.Rows.Count = 1 Then - 'TODO: Hier muss noch gepüft werden ob die Rechnung schon mal abgelehnt wurde?! - Throw New MD5HashException() + Dim oRejected As Boolean + Try + oRejected = CBool(oMD5DT.Rows(0).Item("REJECTED")) + Catch ex As Exception + _logger.Warn("Error while converting REJECTED: " & ex.Message) + oRejected = False + End Try + If oRejected = False Then + Throw New MD5HashException() + Else + _logger.Info("ZuGFeRDFile already has been worked, but formerly obviously was rejected!") + End If End If Else _logger.Warn("Be careful: oExistsDT is nothing!") @@ -322,7 +338,7 @@ Public Class ImportZUGFeRDFiles oZUGFeRDCount += 1 ' PropertyMap items with `IsGrouped = False` are handled normally - Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = args.PropertyMap. + Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap. Where(Function(Item As KeyValuePair(Of String, XmlItemProperty)) Return Item.Value.IsGrouped = False End Function). @@ -332,12 +348,12 @@ Public Class ImportZUGFeRDFiles _logger.Debug("Found {0} default properties.", oDefaultProperties.Count) ' PropertyMap items with `IsGrouped = True` are grouped by group scope - Dim oGroupedProperties = args.PropertyMap. + Dim oGroupedProperties = oArgs.PropertyMap. Where(Function(Item) Item.Value.IsGrouped = True). ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope Function(Item) Item) - _logger.Debug("Found {0} properties grouped in {1} group(s)", args.PropertyMap.Count - oDefaultProperties.Count, oGroupedProperties.Count) + _logger.Debug("Found {0} properties grouped in {1} group(s)", oArgs.PropertyMap.Count - oDefaultProperties.Count, oGroupedProperties.Count) ' Iterate through groups to get group scope and group items For Each oGroup In oGroupedProperties Dim oGroupScope As String = oGroup.Key @@ -353,7 +369,7 @@ Public Class ImportZUGFeRDFiles Try oPropertyValues = oPropertyExtractor.GetPropValue(oDocument, oProperty.Key) Catch ex As Exception - _logger.Warn("Unknown error occurred while fetching property {0} in group {1}:", oProperty.Value.Description, oGroupScope) + _logger.Warn("Unknown error occurred while fetching property [{0}] in group [{1}]:", oProperty.Value.Description, oGroupScope) _logger.Error(ex) oPropertyValues = New List(Of Object) End Try @@ -391,10 +407,10 @@ Public Class ImportZUGFeRDFiles If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then If oColumn.Key.IsRequired Then - _logger.Warn("Property {0} is empty or not found but was required. Continuing with Empty String.", oPropertyDescription) + _logger.Warn("Property [{0}] is empty or not found but is required. Continuing with Empty String.", oPropertyDescription) oMissingProperties.Add(oPropertyDescription) Else - _logger.Warn("Property {0} is empty or not found. Continuing with Empty String.", oPropertyDescription) + _logger.Debug("Property [{0}] is empty or not found. Continuing with Empty String.", oPropertyDescription) End If oPropertyValue = String.Empty @@ -406,7 +422,7 @@ Public Class ImportZUGFeRDFiles _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2} with RowCounter {3}", oPropertyDescription, oPropertyValue, oTableName, oRowCounter) ' Insert into SQL Server - If args.InsertIntoSQLServer = True Then + If oArgs.InsertIntoSQLServer = True Then Dim oResult = _mssql.NewExecutenonQuery(oCommand) If oResult = False Then _logger.Warn("SQL Command was not successful. Check the log.") @@ -465,17 +481,17 @@ Public Class ImportZUGFeRDFiles oMissingProperties.Add(oPropertyDescription) Continue For Else - _logger.Debug("Property {0} is empty or not found. Skipping.", oPropertyDescription) + _logger.Debug("Property [{0}] is empty or not found. Skipping.", oPropertyDescription) Continue For End If End If Dim oTableName = Item.Value.TableName Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}')" - _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName) + _logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName) ' Insert into SQL Server - If args.InsertIntoSQLServer = True Then + If oArgs.InsertIntoSQLServer = True Then Dim oResult = _mssql.NewExecutenonQuery(oCommand) If oResult = False Then _logger.Warn("SQL Command was not successful. Check the log.") @@ -501,67 +517,84 @@ Public Class ImportZUGFeRDFiles If oMD5CheckSum <> String.Empty Then Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oFileGroupId}', '{oMD5CheckSum}')" _firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction) + Try + Dim oSQL = $"SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE MESSAGE_ID = '{oFileGroupId}'" + HISTORY_ID = _firebird.GetScalarValue(oSQL) + Catch ex As Exception + HISTORY_ID = 0 + End Try End If - 'commit the transaction oTransaction.Commit() Catch ex As MD5HashException _logger.Error(ex) - - oMoveDirectory = args.ErrorDirectory + oMoveDirectory = oArgs.ErrorDirectory + Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE MESSAGE_ID = '{oFileGroupId}'" + _firebird.ExecuteNonQuery(oSQL) Dim oBody = "

The invoice attached to your email has already been processed in our system.

" - Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId) + Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId) AddToEmailQueue(oFileGroupId, oBody, oEmailData) Catch ex As InvalidFerdException _logger.Error(ex) - oMoveDirectory = args.ErrorDirectory - + oMoveDirectory = oArgs.ErrorDirectory + Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE MESSAGE_ID = '{oFileGroupId}'" + _firebird.ExecuteNonQuery(oSQL) Dim oBody = """ -

Your email contained a ZUGFeRD document but it was incorrectly formatted.

-

Possible reasons include: