Modules/Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb

691 lines
34 KiB
VB.net

Imports System.Collections.Generic
Imports System.Data
Imports System.Data.SqlClient
Imports System.IO
Imports System.Linq
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Config
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
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 Const ZUGFERD_NO_ZUGFERD = "Non-ZUGFeRD Files"
Public HISTORY_ID As Integer
Private Const DIRECTORY_DONT_MOVE = "DIRECTORY_DONT_MOVE"
' List of allowed extensions for PDF/A Attachments
' This list should not contain xml so the zugferd xml file will be filtered out
Private ReadOnly AllowedExtensions As New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private ReadOnly _logger As Logger
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _filesystem As FilesystemEx
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As ZUGFeRD.EmailFunctions
Private ReadOnly _file As ZUGFeRD.FileFunctions
Private ReadOnly _history As ZUGFeRD.HistoryFunctions
Private ReadOnly _hash As HashFunctions
Private ReadOnly _embeds As PDFEmbeds
Private ReadOnly _gdpictureLicenseKey As String
Private _zugferd As ZUGFeRDInterface
Private _EmailOutAccountId As Integer
Private Class ProcessFileResult
Public ZugferdFileFound As Boolean = False
Public ZugferdFileCount As Integer = 0
Public MD5Checksum As String = Nothing
Public EmailAttachmentFiles As New List(Of FileInfo)
Public EmbeddedAttachmentFiles As New List(Of PDFEmbeds.EmbeddedFile)
End Class
Private Class DatabaseConnections
Public Property SQLServerConnection As SqlConnection
Public Property SQLServerTransaction As SqlTransaction
End Class
Public Sub New(LogConfig As LogConfig, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_filesystem = New FilesystemEx(_logConfig)
_mssql = MSSQL
_email = New ZUGFeRD.EmailFunctions(LogConfig, _mssql)
_file = New ZUGFeRD.FileFunctions(LogConfig, _mssql)
_history = New ZUGFeRD.HistoryFunctions(LogConfig, _mssql)
_embeds = New PDFEmbeds(LogConfig)
_hash = New HashFunctions(_logConfig, _mssql)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
_gdpictureLicenseKey = ConfigDbFunct.GetProductLicense("GDPICTURE", "11.2024", _logConfig, _mssql.CurrentConnectionString)
Else
_logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!")
Throw New ArgumentNullException("MSSQL")
End If
End Sub
Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments
Dim oAttachmentExtractor = New PDFEmbeds(_logConfig)
_EmailOutAccountId = oArgs.EmailOutProfileId
_zugferd = New ZUGFeRDInterface(_logConfig, _gdpictureLicenseKey, New ZUGFeRDInterface.ZugferdOptions() With {
.AllowFacturX_Filename = oArgs.AllowFacturX,
.AllowXRechnung_Filename = oArgs.AllowXRechnung
})
_logger.Debug("Starting Job {0}", [GetType].Name)
Try
'For Each oPath As String In oArgs.WatchDirectory
Dim oPath As String = oArgs.WatchDirectory
Dim oDirInfo As New DirectoryInfo(oPath)
_logger.Debug($"Start processing directory {oDirInfo.FullName}")
If oDirInfo.Exists = False Then
_logger.Warn("Watch directory exists. Exiting.")
Exit Sub
End If
' Filter out *.lock files
Dim oFiles As List(Of FileInfo) = oDirInfo.
GetFiles().
Where(Function(f) Not f.Name.EndsWith(".lock")).
ToList()
If oFiles.Count = 0 Then
_logger.Debug("No files to process. Exiting.")
Exit Sub
End If
_logger.Info("Found {0} files", oFiles.Count)
' 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 oSQLConnection As SqlConnection = _mssql.GetConnection()
Dim oSQLTransaction As SqlTransaction = oSQLConnection?.BeginTransaction()
Dim oConnections As New DatabaseConnections() With {
.SQLServerConnection = oSQLConnection,
.SQLServerTransaction = oSQLTransaction
}
' Count the amount of ZUGFeRD files
Dim oZUGFeRDCount As Integer = 0
' Set the default Move Directory
Dim oMoveDirectory As String = oArgs.ErrorDirectory
' Flag to save if the whole process was a success.
' Will be set only at the end of the function if no error occurred.
Dim oIsSuccess As Boolean = False
' Flag to save if the occurred error (if any) was expected
' Used to determine if transactions should be committed or not
Dim oExpectedError As Boolean = True
' Create file lists
Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value
Dim oEmailAttachmentFiles As New List(Of FileInfo)
Dim oEmbeddedAttachmentFiles As New List(Of PDFEmbeds.EmbeddedFile)
Dim oMessageId As String = oFileGroup.Key
Dim oMD5CheckSum As String = String.Empty
_logger.Info("START processing file group {0}", oMessageId)
If _file.CheckFileAge(oFileGroupFiles, oArgs.MinFileAgeInMinutes) Then
_logger.Info("At least one file was created less than [{0}] minutes ago. Skipping file group.", oArgs.MinFileAgeInMinutes)
Continue For
End If
Dim oEmailDataBase = _email.GetEmailDataForMessageId(oMessageId)
Try
For Each oFile In oFileGroupFiles
Dim oResult As ProcessFileResult = ProcessFile(oMessageId, oEmailDataBase, oZUGFeRDCount, oFile, oConnections, oArgs)
If oResult.ZugferdFileFound = True Then
_logger.Debug("Zugferd File found")
oMD5CheckSum = oResult.MD5Checksum
oZUGFeRDCount = oResult.ZugferdFileCount
oEmailAttachmentFiles.AddRange(oResult.EmailAttachmentFiles)
oEmbeddedAttachmentFiles.AddRange(oResult.EmbeddedAttachmentFiles)
Else ' No zugferd found!
oEmailAttachmentFiles.AddRange(oResult.EmailAttachmentFiles)
oEmbeddedAttachmentFiles.AddRange(oResult.EmbeddedAttachmentFiles)
End If
Next
'Check if there are no ZUGFeRD files
If oZUGFeRDCount = 0 Then
' If NonZugferdDirectory is not set, a NoFerdsException will be thrown and a rejection will be generated
' This is the default/initial behaviour.
If String.IsNullOrEmpty(oArgs.NonZugferdDirectory) Then
Throw New NoFerdsException()
End If
' Also, if the directory is set but does not exist, still a rejection will be generated.
If Not Directory.Exists(oArgs.NonZugferdDirectory) Then
Throw New NoFerdsException()
End If
' Only if the directory is set and does exist, it will be used and any file groups which
' do NOT CONTAIN ANY ZUGFERD DOCUMENTS, are moved to that directory.
Throw New NoFerdsAlternateException()
End If
'If no errors occurred, update the history table for this MessageId
If String.IsNullOrEmpty(oMD5CheckSum) Then
_history.Update_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)")
Else
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS")
End If
oIsSuccess = True
oMoveDirectory = oArgs.SuccessDirectory
Catch ex As ValidationException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.ValidationException)
'Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oErrors = ex.ValidationErrors
Dim oErrorList As String = ""
Dim oErrorListDE As String = ""
For Each oError In oErrors
oErrorList += $"<li>Element '{oError.ElementName}' with Value '{oError.ElementValue}': {oError.ErrorMessage}</li>"
oErrorListDE += $"<li>Element '{oError.ElementName}' mit Wert '{oError.ElementValue}': {oError.ErrorMessageDE}</li>"
Next
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.ValidationException, oErrorListDE, oErrorList)
AddRejectedState(oMessageId, oRejectionCodeString, "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
Catch ex As MD5HashException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MD5HashException)
' When MD5HashException is thrown, we don't have a MD5Hash yet.
' Thats why we set it to String.Empty here.
'Dim oMessage = "REJECTED - Already processed (MD5Hash)"
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oBody = String.Format(EmailStrings.EMAIL_MD5_ERROR, ex.FileName)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MD5HashException, ex.FileName, "")
AddRejectedState(oMessageId, oRejectionCodeString, "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
Catch ex As UnsupportedFerdException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.UnsupportedFerdException)
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnsupportedFerdException, ex.XmlFile, "")
AddRejectedState(oMessageId, oRejectionCodeString, "Nicht unterstütztes Datenformat", "", oSQLTransaction)
Catch ex As InvalidFerdException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.InvalidFerdException)
' When InvalidFerdException is thrown, we don't have a MD5Hash yet.
' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.InvalidFerdException, "", "")
AddRejectedState(oMessageId, oRejectionCodeString, "Inkorrektes Format", "", oSQLTransaction)
Catch ex As TooMuchFerdsException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.TooMuchFerdsException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.TooMuchFerdsException, "", "")
AddRejectedState(oMessageId, oRejectionCodeString, "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction)
Catch ex As NoFerdsException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.NoFerdsException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.NoFerdsException, "", "")
AddRejectedState(oMessageId, oRejectionCodeString, "Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction)
Catch ex As MissingValueException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MissingValueException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oMissingFieldList As String = ""
For Each oMissingFieldDescription In ex.MissingProperties
oMissingFieldList += $"<li>{oMissingFieldDescription.Description}<br/><em>{oMissingFieldDescription.XMLPath}</em></li>"
Next
Dim oOrgFilename = _hash.GetOriginalFilename(ex.File.Name)
Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, ex.MissingProperties)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MissingValueException, oOrgFilename, oMissingFieldList)
AddRejectedState(oMessageId, oRejectionCodeString, "Es fehlten ZugferdSpezifikationen", "", oSQLTransaction)
Catch ex As FileSizeLimitReachedException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.FileSizeLimitReachedException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oKey = FileSizeLimitReachedException.KEY_FILENAME
Dim oFileExceedingThreshold As String = IIf(ex.Data.Contains(oKey), ex.Data.Item(oKey), "")
Dim oOrgFilename = _hash.GetOriginalFilename(oFileExceedingThreshold)
Dim oBody = String.Format(EmailStrings.EMAIL_FILE_SIZE_REACHED, oArgs.MaxAttachmentSizeInMegaBytes, oOrgFilename)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.FileSizeLimitReachedException, oArgs.MaxAttachmentSizeInMegaBytes, oOrgFilename)
AddRejectedState(oMessageId, oRejectionCodeString, "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
Catch ex As NoFerdsAlternateException
' TODO: Maybe dont even log this 'error', since it's not really an error and it might happen *A LOT*
_logger.Error(ex)
oMoveDirectory = oArgs.NonZugferdDirectory
Catch ex As OutOfMemoryException
_logger.Warn("OutOfMemory Error occurred: {0}", ex.Message)
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"OutOfMemoryException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "OutOfMemoryException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnhandledException, ex.Message, ex.StackTrace)
' Rollback Transaction
oSQLTransaction.Rollback()
oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False
If oSQLConnection IsNot Nothing And oSQLTransaction IsNot Nothing Then
' Send Email to Digital Data
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "UnhandledException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnhandledException, ex.Message, ex.StackTrace)
' Rollback Transaction
oSQLTransaction.Rollback()
End If
Finally
Try
' If an application error occurred, dont move files so they will be processed again later
If oMoveDirectory = DIRECTORY_DONT_MOVE Then
_logger.Info("Application Error occurred. Files for message Id {0} will not be moved.", oMessageId)
Else
' Move all files of the current group
_file.MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess)
End If
_logger.Info("END processing file group {0}", oMessageId)
Catch ex As Exception
' Send Email to Digital Data
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"FileMoveException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "FileMoveException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnhandledException, ex.Message, ex.StackTrace)
_logger.Warn("Could not move files!")
_logger.Error(ex)
Throw ex
End Try
Try
' If everything went OK or an expected error occurred,
' finally commit all changes To the Database
' ==================================================================
If oIsSuccess Or oExpectedError Then
If oSQLTransaction IsNot Nothing Then
' Commit Transaction
oSQLTransaction.Commit()
End If
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Database Transactions were not committed successfully.")
End Try
Try
If oSQLConnection IsNot Nothing Then
oSQLConnection.Close()
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Database Connections were not closed successfully.")
End Try
End Try
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 Function GetRejectionCodeString(pMessageId As String, pRejectionCode As ErrorCode) As String
Dim intCode As Integer = DirectCast(pRejectionCode, Integer)
Dim oRejectionCodeString = $"{EmailStrings.ErrorCodePraefix}{intCode}"
' Wir wollen im error-Log den Code und die MessageID haben, um die es geht
Dim oInfoMessage = $"Rejection {oRejectionCodeString} triggered for '{pMessageId}'"
_logger.Error(oInfoMessage)
Return oRejectionCodeString
End Function
Private Function ProcessFile(pMessageId As String, pEmailData As EmailData, pZugferdFiles As Integer, oFile As FileInfo, oConnections As DatabaseConnections, pArgs As WorkerArgs) As ProcessFileResult
Dim oDocument As ZUGFeRDInterface.ZugferdResult
Dim oResult As New ProcessFileResult()
' Only pdf files are allowed from here on
If Not oFile.Name.ToUpper.EndsWith(".PDF") Then
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
oResult.EmailAttachmentFiles.Add(oFile)
' Checking filesize for attachment files
If _filesystem.TestFileSizeIsLessThanMaxFileSize(oFile.FullName, pArgs.MaxAttachmentSizeInMegaBytes) = False Then
_logger.Warn("Filesize for File [{0}] exceeded limit of {1} MB", oFile.Name, pArgs.MaxAttachmentSizeInMegaBytes)
Throw New FileSizeLimitReachedException(oFile.Name, pArgs.MaxAttachmentSizeInMegaBytes)
End If
Return oResult
End If
_logger.Info("Start processing file {0}", oFile.Name)
' Checking filesize for pdf files
If _filesystem.TestFileSizeIsLessThanMaxFileSize(oFile.FullName, pArgs.MaxAttachmentSizeInMegaBytes) = False Then
_logger.Warn("Filesize for File [{0}] exceeded limit of {1} MB", oFile.Name, pArgs.MaxAttachmentSizeInMegaBytes)
Throw New FileSizeLimitReachedException(oFile.Name, pArgs.MaxAttachmentSizeInMegaBytes)
End If
Try
oDocument = _zugferd.ExtractZUGFeRDFileWithGDPicture(oFile.FullName)
Catch ex As ValidationException
Throw ex
Catch ex As ZUGFeRDExecption
Select Case ex.ErrorType
Case ZUGFeRDInterface.ErrorType.NoZugferd
_logger.Info("File [{0}] is not a valid ZUGFeRD document. Skipping.", oFile.Name)
oResult.EmailAttachmentFiles.Add(oFile)
Return oResult
Case ZUGFeRDInterface.ErrorType.UnsupportedFormat
_logger.Info("File [{0}/{1}] is an unsupported ZUFeRD document format!", oFile.Name, ex.XmlFile)
Throw New UnsupportedFerdException(ex.XmlFile)
Case ZUGFeRDInterface.ErrorType.NoValidZugferd
_logger.Info("File [{0}] is an Incorrectly formatted ZUGFeRD document!", oFile.Name)
Throw New InvalidFerdException()
Case Else
_logger.Warn("Unexpected Error occurred while extracting ZUGFeRD Information from file {0}", oFile.Name)
Throw ex
End Select
End Try
' Check if there are more than one ZUGFeRD files
If pZugferdFiles = 1 Then
Throw New TooMuchFerdsException()
End If
' Since extraction went well, increase the amount of ZUGFeRD files
pZugferdFiles += 1
_logger.Info("Zugferd file found. Increasing counter.")
' 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.
' Right now the zugferd-invoice.xml is filtered out because `AllowedExtensions` does not contain `xml`.
Dim oAttachments = _embeds.Extract(oFile.FullName, AllowedExtensions)
If oAttachments Is Nothing Then
_logger.Warn("Attachments for file [{0}] could not be extracted", oFile.FullName)
Else
oResult.EmbeddedAttachmentFiles.AddRange(oAttachments)
End If
' Check the Checksum and rejection status
Dim oMD5Checksum = _hash.GenerateAndCheck_MD5Sum(oFile, pMessageId, pArgs.IgnoreRejectionStatus)
' Check the document against the configured property map and return:
' - a List of valid properties
' - a List of missing properties
Dim oPropertyMap = _zugferd.FilterPropertyMap(pArgs.PropertyMap, oDocument.Specification)
Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument.SchemaObject, oPropertyMap, pMessageId)
_logger.Info("Properties checked: [{0}] missing properties / [{1}] valid properties found.", oCheckResult.MissingProperties.Count, oCheckResult.ValidProperties.Count)
If oCheckResult.MissingProperties.Count > 0 Then
_logger.Warn("[{0}] missing properties found. Exiting.", oCheckResult.MissingProperties.Count)
Throw New MissingValueException(oFile, oCheckResult.MissingProperties)
Else
_logger.Debug("No missing properties found. Continuing.")
End If
If DeleteExistingPropertyValues(pMessageId, oConnections) = False Then
Throw New Exception("Could not cleanup data. Exiting.")
End If
' DataTable vorbereiten
Dim oDataTable As DataTable = FillDataTable(pMessageId, oCheckResult, oDocument.Specification, oDocument.UsedXMLSchema)
' ColumnList initialisieren
Dim oColumnNames As List(Of String) = New List(Of String) From {
"REFERENCE_GUID",
"ITEM_DESCRIPTION",
"ITEM_VALUE",
"GROUP_COUNTER",
"SPEC_NAME",
"IS_REQUIRED"
}
Dim oBulkResult = BulkInsert(oConnections, oDataTable, "TBEDMI_ITEM_VALUE", oColumnNames)
If oBulkResult = False Then
_logger.Error("Bulk Insert for MessageId [{0}] failed!", pMessageId)
Throw New Exception("Bulk Insert failed! Exiting.")
End If
_logger.Info("Bulk Insert finished. [{0}] rows inserted for MessageId [{1}].", oDataTable.Rows.Count, pMessageId)
_logger.Debug("File processed.")
oResult.ZugferdFileFound = True
oResult.MD5Checksum = oMD5Checksum
oResult.ZugferdFileCount = pZugferdFiles
Return oResult
End Function
Private Function FillDataTable(pMessageId As String, pCheckResult As PropertyValues.CheckPropertyValuesResult, pSpecification As String, pUsedXMLSchema As String) As DataTable
Dim oDataTable As DataTable = New DataTable()
oDataTable.Columns.Add(New DataColumn("REFERENCE_GUID", GetType(String)))
oDataTable.Columns.Add(New DataColumn("ITEM_DESCRIPTION", GetType(String)))
oDataTable.Columns.Add(New DataColumn("ITEM_VALUE", GetType(String)))
oDataTable.Columns.Add(New DataColumn("GROUP_COUNTER", GetType(Int32)))
oDataTable.Columns.Add(New DataColumn("SPEC_NAME", GetType(String)))
oDataTable.Columns.Add(New DataColumn("IS_REQUIRED", GetType(Boolean)))
' Erste Zeile enthält die Spezifikation
Dim oFirstRow As DataRow = oDataTable.NewRow()
oFirstRow("REFERENCE_GUID") = pMessageId
oFirstRow("ITEM_DESCRIPTION") = "ZUGFeRDSpezifikation"
oFirstRow("ITEM_VALUE") = pSpecification
oFirstRow("GROUP_COUNTER") = 0
oFirstRow("SPEC_NAME") = "ZUGFERD_SPECIFICATION"
oFirstRow("IS_REQUIRED") = False
_logger.Debug("Mapping Property [ZUGFERD_SPECIFICATION] with value [{0}]", pSpecification)
oDataTable.Rows.Add(oFirstRow)
' Zweite Zeile enthält das verwendete XML Schema
Dim oSecondRow As DataRow = oDataTable.NewRow()
oSecondRow("REFERENCE_GUID") = pMessageId
oSecondRow("ITEM_DESCRIPTION") = "ZUGFeRDXMLSchema"
oSecondRow("ITEM_VALUE") = pUsedXMLSchema
oSecondRow("GROUP_COUNTER") = 0
oSecondRow("SPEC_NAME") = "ZUGFERD_XML_SCHEMA"
oSecondRow("IS_REQUIRED") = False
_logger.Debug("Mapping Property [ZUGFERD_XML_SCHEMA] with value [{0}]", pUsedXMLSchema)
oDataTable.Rows.Add(oSecondRow)
For Each oProperty In pCheckResult.ValidProperties
' If GroupCounter is -1, it means this is a default property that can only occur once.
' Set the actual inserted value to 0
Dim oGroupCounterValue As Integer = oProperty.GroupCounter
If oGroupCounterValue = -1 Then
oGroupCounterValue = 0
End If
If oProperty.Value.Length > 900 Then
_logger.Warn("Value for field [{0}] is longer than 900 characters, will be truncated!", oProperty.TableColumn)
End If
Dim oNewRow As DataRow = oDataTable.NewRow()
oNewRow("REFERENCE_GUID") = pMessageId
oNewRow("ITEM_DESCRIPTION") = oProperty.Description
oNewRow("ITEM_VALUE") = oProperty.Value.Truncate(900).Replace("'", "''")
oNewRow("GROUP_COUNTER") = oGroupCounterValue
oNewRow("SPEC_NAME") = oProperty.TableColumn
oNewRow("IS_REQUIRED") = oProperty.IsRequired
_logger.Debug("Mapping Property [{0}] with value [{1}]", oProperty.TableColumn, oProperty.Value.Replace("'", "''"))
oDataTable.Rows.Add(oNewRow)
Next
Return oDataTable
End Function
Private Function DeleteExistingPropertyValues(pMessageId As String, pConnections As DatabaseConnections) As Boolean
Dim oDelSQL = $"DELETE FROM TBEDMI_ITEM_VALUE where REFERENCE_GUID = '{pMessageId}'"
Dim oStep As String = "TBEDMI_ITEM_VALUE Delete MessageID Items"
Try
Dim retValue As Boolean = _mssql.ExecuteNonQueryWithConnectionObject(oDelSQL, pConnections.SQLServerConnection, MSSQLServer.TransactionMode.ExternalTransaction, pConnections.SQLServerTransaction)
Return retValue
Catch ex As Exception
_logger.Warn("Step [{0}] with SQL [{1}] was not successful.", oStep, oDelSQL)
End Try
End Function
Private Function BulkInsert(pConnections As DatabaseConnections, pTable As DataTable, pDestinationTable As String, pColumns As List(Of String)) As Boolean
Using oBulkCopy = New SqlBulkCopy(pConnections.SQLServerConnection, SqlBulkCopyOptions.Default, pConnections.SQLServerTransaction)
oBulkCopy.DestinationTableName = pDestinationTable
For Each oColumn In pColumns
oBulkCopy.ColumnMappings.Add(New SqlBulkCopyColumnMapping(oColumn, oColumn))
Next
Try
oBulkCopy.WriteToServer(pTable)
Catch ex As Exception
_logger.Error(ex)
Return False
End Try
End Using
Return True
End Function
Private Sub AddRejectedState(pMessageID As String, pTitle As String, pTitle1 As String, pComment As String, pTransaction As SqlTransaction)
Try
'PRCUST_ADD_HISTORY_STATE: @MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250)
Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{pMessageID}','{pTitle}','{pTitle1}','{pComment.Replace("'", "''")}'"
_mssql.ExecuteNonQuery(oSQL, pTransaction)
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
End Class