AppStd/Monorepo
8
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Working Rejected

Browse Source
This commit is contained in:
Digital Data - Marlon Schreiber 2019-09-24 13:16:01 +02:00
parent 82a839949d
commit cf461c79d9
5 changed files with 106 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
DDZUGFeRDService/ThreadRunner.vb
View File

@ -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

2
GUIs.Test.ZUGFeRDTest/Form1.vb
View File

@ -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

129
Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -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 = "<p>The invoice attached to your email has already been processed in our system.</p>"
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 = """
<p>Your email contained a ZUGFeRD document but it was incorrectly formatted.</p>
<p>Possible reasons include:<ul>
<li>Amount value has incorrect format (25,01 instead of 25.01)</li>
<p>Ihre email einthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
<p>Mögliche Gründe für ein inkorrektes Format:<ul>
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p>
"""
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As TooMuchFerdsException
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
Dim oBody = "<p>Your email contained more than one ZUGFeRD-Document.</p>"
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE MESSAGE_ID = '{oFileGroupId}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = "<p>Ihre email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As NoFerdsException
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE MESSAGE_ID = '{oFileGroupId}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As MissingValueException
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
oMoveDirectory = oArgs.ErrorDirectory
Dim oMessage As String = ""
For Each prop In oMissingProperties
oMessage &= $"- {prop}"
Next
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Missing Required Properties: {oMessage}' WHERE MESSAGE_ID = '{oFileGroupId}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE MESSAGE_ID = '{oFileGroupId}'"
_firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = args.ErrorDirectory
oMoveDirectory = oArgs.ErrorDirectory
Finally
oConnection.Close()
' Move all files of the current group
Try
MoveFiles(args, oFileGroupFiles, oFileAttachmentFiles, oMoveDirectory)
MoveFiles(oArgs, oFileGroupFiles, oFileAttachmentFiles, oMoveDirectory)
_logger.Info("Finished processing file group {0}", oFileGroupId)
Catch ex As Exception
_logger.Warn("Could not move files!")
@ -625,11 +658,11 @@ Public Class ImportZUGFeRDFiles
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>"
Dim oBody = $"<p>Die angehängte Datei entspricht nicht dem WISAG ZUGFeRD-Format: {OriginalFilename}</p>"
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= $"The following Properties were marked as Required but were not found:"
oBody &= $"Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:"
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties

1
Modules.Database/Firebird.vb
View File

@ -203,6 +203,7 @@ Public Class Firebird
End If
oCommand.ExecuteNonQuery()
_Logger.Debug("Command executed!")
Catch ex As Exception
_Logger.Error(ex, $"Error in ExecuteNonQuery while executing command: '{SqlCommand}'")
_Logger.Warn($"Unexpected error in ExecuteNonQueryWithConnection: '{SqlCommand}'")

2
Modules.Database/MSSQLServer.vb
View File

@ -110,7 +110,7 @@ Public Class MSSQLServer
''' <returns>Returns true if properly executed, else false</returns>
''' <remarks></remarks>
Public Function NewExecutenonQuery(executeStatement As String) As Boolean
_Logger.Warn("NewExecutenonQuery is deprecated. Use ExecuteNonQuery instead.")
'_Logger.Warn("NewExecutenonQuery is deprecated. Use ExecuteNonQuery instead.")
Return ExecuteNonQuery(executeStatement)
End Function