Monorepo/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb

668 lines
38 KiB
VB.net

Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Linq
Imports System.Reflection
Imports System.Security.Cryptography
Imports System.Text.RegularExpressions
Imports System.Xml
Imports DigitalData.Modules.Filesystem
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
Imports FirebirdSql.Data.FirebirdClient
Imports GdPicture14
Public Class ImportZUGFeRDFiles
Implements IJob
Public Const ZUGFERD_IN = "ZUGFeRD in"
Public Const ZUGFERD_ERROR = "ZUGFeRD Error"
Public Const ZUGFERD_SUCCESS = "ZUGFeRD Success"
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
' List of allowed extensions for PDF/A Attachments
Private ReadOnly AllowedExtensions As List(Of String) = New List(Of String) From {"xml", "docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private ReadOnly _logger As Logger
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _zugferd As ZUGFeRDInterface
Private ReadOnly _firebird As Firebird
Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _EmailOutAccountId As Integer
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, pEmailOutAccount As Integer, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_firebird = Firebird
_filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL
_EmailOutAccountId = pEmailOutAccount
_email = New EmailFunctions(LogConfig, _mssql, _firebird)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL)
_zugferd = New ZUGFeRDInterface(_logConfig, oLicenseKey)
Else
_logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!")
Throw New ArgumentNullException("MSSQL")
End If
End Sub
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData
Dim oEmailData = _email.GetEmailDataForMessageId(MessageId)
Dim oSource = _email.GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
Dim oDestination As String
' If oEmailData is Nothing, TBEDM_EMAIL_PROFILER_HISTORY for MessageId was not found.
' This only should happen when testing and db-tables are deleted frequently
If oEmailData Is Nothing Then
oDestination = _email.GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, MessageId)
Else
oDestination = _email.GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
End If
_logger.Debug("Destination for eml file is {0}", oDestination)
Dim oFinalFileName = _filesystem.GetVersionedFilename(oDestination)
_logger.Debug("Versioned filename for eml file is {0}", oFinalFileName)
If oEmailData Is Nothing Then
_logger.Warn("Could not get Email Data from database. File {0} will not be moved!", oSource)
Return Nothing
End If
Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
IO.File.Move(oSource, oFinalFileName)
oEmailData.Attachment = oFinalFileName
Catch ex As Exception
_logger.Warn("File {0} could not be moved! Original Filename will be used!", oSource)
_logger.Error(ex)
oEmailData.Attachment = oSource
End Try
Return oEmailData
End Function
Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String)
Try
'PRCUST_ADD_HISTORY_STATE: @MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250)
Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{oMessageID}','{oTitle}','{oTitle1}','{oComment}'"
_mssql.NewExecutenonQuery(oSQL)
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments
Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFAttachments(_logConfig)
_logger.Debug("Starting Job {0}", [GetType].Name)
Try
For Each oPath As String In oArgs.WatchDirectories
Dim oDirInfo As New DirectoryInfo(oPath)
_logger.Debug($"Start processing directory {oDirInfo.FullName}")
If oDirInfo.Exists Then
' Filter out *.lock files
Dim oFiles As List(Of FileInfo) = oDirInfo.
GetFiles().
Where(Function(f) Not f.Name.EndsWith(".lock")).
ToList()
Dim oFileCount = oFiles.Count
Dim oCurrentFileCount = 0
If oFileCount = 0 Then
_logger.Debug("No files to process.")
Continue For
Else
_logger.Info("Found {0} files", oFileCount)
End If
' Group files by messageId
Dim oGrouped As Dictionary(Of String, List(Of FileInfo)) = _zugferd.FileGroup.GroupFiles(oFiles)
_logger.Info("Found {0} file groups", oGrouped.Count)
' Process each file group together
For Each oFileGroup In oGrouped
' Start a new transaction for each file group.
' This way we can rollback database changes for the whole filegroup in case something goes wrong.
Dim oConnection As FbConnection = _firebird.GetConnection()
Dim oTransaction As FbTransaction = oConnection.BeginTransaction()
' Count the amount of ZUGFeRD files
Dim oZUGFeRDCount As Integer = 0
' Set the default Move Directory
Dim oMoveDirectory As String = oArgs.SuccessDirectory
' Create file lists
Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value
Dim oEmailAttachmentFiles As New List(Of FileInfo)
Dim oEmbeddedAttachmentFiles As New List(Of PDFAttachments.AttachmentResult)
Dim oMessageId As String = oFileGroup.Key
Dim oMissingProperties As New List(Of String)
Dim oMD5CheckSum As String = String.Empty
_logger.NewBlock($"Message Id {oMessageId}")
_logger.Info("Start processing file group {0}", oMessageId)
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
' Only pdf files are allowed from here on
If Not oFile.Name.EndsWith(".pdf") Then
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
oEmailAttachmentFiles.Add(oFile)
Continue For
End If
_logger.Info("Start processing file {0}", oFile.Name)
Try
oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName)
Catch ex As ZUGFeRDExecption
Select Case ex.ErrorType
Case ZUGFeRDInterface.ErrorType.NoZugferd
_logger.Warn("File is not a valid ZUGFeRD document! Skipping.")
oEmailAttachmentFiles.Add(oFile)
Continue For
Case ZUGFeRDInterface.ErrorType.NoValidZugferd
_logger.Warn("File is an Incorrectly formatted ZUGFeRD document!")
Throw New InvalidFerdException()
Case Else
_logger.Warn("Unexpected Error occurred while extracting ZUGFeRD Information from file {0}", oFile.FullName)
Throw ex
End Select
End Try
' Extract all attachments with the extensions specified in `AllowedExtensions`.
' If you need to extract and use embedded xml files, you need to filter out the zugferd-invoice.xml yourself.
Dim oAttachments = oAttachmentExtractor.Extract(oFile.FullName, AllowedExtensions)
If oAttachments Is Nothing Then
_logger.Warn("Attachments for file [{0}] could not be extracted", oFile.FullName)
Else
oEmbeddedAttachmentFiles.AddRange(oAttachments)
End If
oMD5CheckSum = CreateMD5(oFile.FullName)
If oMD5CheckSum <> String.Empty Then
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
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
HISTORY_ID = oMD5DT.Rows(0).Item("GUID")
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{HISTORY_ID}]")
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!")
End If
Else
_logger.Warn("Be careful: oMD5CheckSum is nothing!")
End If
' Check if there are more than one ZUGFeRD files
If oZUGFeRDCount = 1 Then
Throw New TooMuchFerdsException()
End If
' Since extraction went well, increase the amount of ZUGFeRD files
oZUGFeRDCount += 1
#Region "Check Property Values"
' --- BEGIN Check Property Values
'' PropertyMap items with `IsGrouped = False` are handled normally
'Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap.
' Where(Function(Item) Item.Value.IsGrouped = True).
' ToDictionary(Function(Item) Item.Key,
' Function(Item) Item.Value)
'_logger.Debug("Found {0} default properties.", oDefaultProperties.Count)
'' PropertyMap items with `IsGrouped = True` are grouped by group scope
'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)", 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
' Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
' Dim oRowCount = 0
' _logger.Debug("Fetching Property values for group {0}.", oGroupScope)
' ' get properties as a nested object, see `oPropertyList`
' For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
' Dim oPropertyValues As List(Of Object)
' 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.Error(ex)
' oPropertyValues = New List(Of Object)
' End Try
' ' Flatten result value
' oPropertyValues = oPropertyExtractor.GetFinalPropValue(oPropertyValues)
' ' Add to list
' oPropertyList.Add(oProperty.Value, oPropertyValues)
' ' check the first batch of values to determine the row count
' If oRowCount = 0 Then
' oRowCount = oPropertyValues.Count
' End If
' Next
' ' Structure of oPropertyList
' ' [ # Propertyname # Row 1 # Row 2
' ' PositionsMenge: [BilledQuantity1, BilledQuantity2, ...],
' ' PositionsSteuersatz: [ApplicablePercent1, ApplicablePercent2, ...],
' ' ...
' ' ]
' For oRowIndex = 0 To oRowCount - 1
' _logger.Debug("Processing row {0}", oRowIndex)
' For Each oColumn As KeyValuePair(Of XmlItemProperty, List(Of Object)) In oPropertyList
' Dim oTableName As String = oColumn.Key.TableName
' Dim oPropertyDescription As String = oColumn.Key.Description
' Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1
' ' Returns nothing if oColumn.Value contains an empty list
' Dim oPropertyValue = oColumn.Value.ElementAtOrDefault(oRowIndex)
' _logger.Debug("Processing property {0}.", oPropertyDescription)
' If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
' If oColumn.Key.IsRequired Then
' _logger.Warn("Property [{0}] is empty or not found but is required. Continuing with Empty String.", oPropertyDescription)
' oMissingProperties.Add(oPropertyDescription)
' Else
' _logger.Debug("Property [{0}] is empty or not found. Continuing with Empty String.", oPropertyDescription)
' End If
' oPropertyValue = String.Empty
' End If
' _logger.Debug("Property {0} has value '{1}'", oPropertyDescription, oPropertyValue)
' Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oMessageId}', '{oPropertyDescription}', '{oPropertyValue}', {oRowCounter})"
' _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 oArgs.InsertIntoSQLServer = True Then
' Dim oResult = _mssql.NewExecutenonQuery(oCommand)
' If oResult = False Then
' _logger.Warn("SQL Command was not successful. Check the log.")
' End If
' End If
' ' Insert into Firebird
' _firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
' Next
' Next
' oGlobalGroupCounter += oRowCount
'Next
'' Iterate through default properties
'For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
' Dim oPropertyValueList As List(Of Object)
' Dim oPropertyDescription As String = Item.Value.Description
' Dim oPropertyValue As Object = Nothing
' Try
' oPropertyValueList = oPropertyExtractor.GetPropValue(oDocument, Item.Key)
' Catch ex As Exception
' _logger.Warn("Unknown error occurred while fetching property {0} in group {1}:", oPropertyDescription, Item.Value.GroupScope)
' _logger.Error(ex)
' oPropertyValueList = New List(Of Object)
' End Try
' Try
' If IsNothing(oPropertyValueList) Then
' oPropertyValue = Nothing
' ElseIf TypeOf oPropertyValueList Is List(Of Object) Then
' Select Case oPropertyValueList.Count
' Case 0
' oPropertyValue = Nothing
' Case Else
' Dim oList As List(Of Object) = DirectCast(oPropertyValueList, List(Of Object))
' oPropertyValue = oList.Item(0)
' ' This should hopefully show config errors
' If TypeOf oPropertyValue Is List(Of Object) Then
' _logger.Warn("Property with Description {0} may be configured incorrectly", oPropertyDescription)
' oPropertyValue = Nothing
' End If
' End Select
' End If
' Catch ex As Exception
' _logger.Warn("Unknown error occurred while processing property {0}:", oPropertyDescription)
' _logger.Error(ex)
' oPropertyValue = Nothing
' End Try
' If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
' If Item.Value.IsRequired Then
' _logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription)
' oMissingProperties.Add(oPropertyDescription)
' Continue For
' Else
' _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 ('{oMessageId}', '{oPropertyDescription}', '{oPropertyValue}')"
' _logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName)
' ' Insert into SQL Server
' If oArgs.InsertIntoSQLServer = True Then
' Dim oResult = _mssql.NewExecutenonQuery(oCommand)
' If oResult = False Then
' _logger.Warn("SQL Command was not successful. Check the log.")
' End If
' End If
' ' Insert into Firebird
' _firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
'Next
'--- END Check Property Values
#End Region
' Check the document against the configured property map and return:
' - a List of valid properties
' - a List of missing properties
Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument, oArgs.PropertyMap, oMessageId)
If oCheckResult.MissingProperties.Count > 0 Then
Throw New MissingValueException(oFile)
End If
For Each oProperty In oCheckResult.ValidProperties
Dim oGroupCounterValue = Nothing
If oProperty.GroupCounter > -1 Then
oGroupCounterValue = oProperty.GroupCounter
End If
If (oGroupCounterValue > 0) = False Then
Dim oTerm As String
If IsNothing(oGroupCounterValue) Then
oTerm = "NOTHING"
Else
oTerm = oGroupCounterValue.ToString
End If
_logger.Warn($"[ImportZUGFeRDFiles] - oGroupCounterValue is not valid [{oTerm}]!!")
Else
Dim oCommand = $"INSERT INTO {oProperty.TableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oMessageId}', '{oProperty.Description}', '{oProperty.Value}', {oGroupCounterValue})"
_logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oProperty.Description, oProperty.Value, oProperty.TableName)
' Insert into SQL Server
If oArgs.InsertIntoSQLServer = True Then
Dim oResult = _mssql.NewExecutenonQuery(oCommand)
If oResult = False Then
_logger.Warn($"SQL Command [{oCommand}] was not successful. Check the log.")
End If
End If
' Insert into Firebird
_firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
End If
Next
Next
'Check if there are no ZUGFeRD files
If oZUGFeRDCount = 0 Then
Throw New NoFerdsException()
End If
'If no errors occurred...
'Log the History
If oMD5CheckSum <> String.Empty Then
Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oMessageId}', '{oMD5CheckSum}')"
_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
'commit the transaction
oTransaction.Commit()
Try
Dim oSQL = $"SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE MESSAGE_ID = '{oMessageId}'"
HISTORY_ID = _firebird.GetScalarValue(oSQL)
Catch ex As Exception
HISTORY_ID = 0
End Try
End If
Catch ex As MD5HashException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
Catch ex As InvalidFerdException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId)
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "")
Catch ex As TooMuchFerdsException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId)
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
Catch ex As NoFerdsException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EmailStrings.EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId)
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
Catch ex As MissingValueException
_logger.Error(ex)
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 GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage)
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 GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = oArgs.ErrorDirectory
AddRejectedState(oMessageId, "UnexpectedException", "", ex.Message)
Finally
oConnection.Close()
' Move all files of the current group
Try
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory)
_logger.Info("Finished processing file group {0}", oMessageId)
Catch ex As Exception
_logger.Warn("Could not move files!")
_logger.Error(ex)
Throw ex
Finally
_logger.EndBlock()
End Try
End Try
Next
End If
Next
_logger.Debug("Finishing Job {0}", Me.GetType.Name)
Catch ex As Exception
_logger.Error(ex)
_logger.Info("Job Failed! See error log for details")
End Try
End Sub
Private Sub MoveFiles(Args As WorkerArgs, MessageId As String, Files As List(Of FileInfo), AttachmentFiles As List(Of FileInfo), EmbeddedAttachments As List(Of PDFAttachments.AttachmentResult), MoveDirectory As String)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oAttachmentDirectory As String = Path.Combine(MoveDirectory, Args.AttachmentsSubDirectory)
' Create directories if they don't exist
If Not Directory.Exists(oFinalMoveDirectory) Then
Try
Directory.CreateDirectory(oFinalMoveDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If Not Directory.Exists(oAttachmentDirectory) And AttachmentFiles.Count > 0 Then
Try
Directory.CreateDirectory(oAttachmentDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
' Filter out Attachments from `Files`
Dim oInvoiceFiles As List(Of FileInfo) = Files.Except(AttachmentFiles).ToList()
' Move PDF/A Files
For Each oFile In oInvoiceFiles
Try
Dim oFileName = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFileName, oFinalMoveDirectory)
_logger.Info("Finished processing file {0}", oFile.Name)
_logger.Info("File moved to {0}", oFileName)
Catch ex As Exception
_logger.Warn("Could not move file {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Move non-PDF/A Email Attachments/Files
For Each oFile In AttachmentFiles
Try
Dim oFileName = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFileName, oAttachmentDirectory)
_logger.Info("Finished processing file {0}", oFile.Name)
_logger.Info("Attachment moved to {0}", oFileName)
Catch ex As Exception
_logger.Warn("Could not move attachment {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Write Embedded Files to disk
For Each oResult In EmbeddedAttachments
Try
Dim oFileName As String = $"{MessageId}~{oResult.FileName}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oWriter.Write(oResult.FileContents, 0, oResult.FileContents.Length)
End Using
Catch ex As Exception
_logger.Warn("Could not save embedded attachment {0}", oResult.FileName)
_logger.Error(ex)
End Try
Next
End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= EmailStrings.EMAIL_MISSINGPROPERTIES_2
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties
oBody &= $"- {prop}"
Next
End If
Return oBody
End Function
Private Function CreateMD5(ByVal Filename As String) As String
Try
Dim oMD5 As New MD5CryptoServiceProvider
Dim oHash As Byte()
Dim oHashString As String
Dim oResult As String = ""
Using oFileStream As New FileStream(Filename, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
oHash = oMD5.ComputeHash(oFileStream)
oHashString = BitConverter.ToString(oHash)
End Using
oResult = oHashString.Replace("-", "")
Return oResult
Catch ex As Exception
_logger.Error(ex)
Return ""
End Try
End Function
End Class