Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Linq
Imports System.Security.Cryptography
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 System.Data.SqlClient
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 _firebird As Firebird
Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions
Private ReadOnly _gdpictureLicenseKey As String
Private _zugferd As ZUGFeRDInterface
Private _EmailOutAccountId As Integer
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_firebird = Firebird
_filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL
_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'"
_gdpictureLicenseKey = _mssql.GetScalarValue(oSQL)
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 oDateSubDirectoryName As String = Now.ToString("yyyy-MM-dd")
Dim oDestination As String
Dim oRejectedDirectory As String = Path.Combine(Args.RejectedEmailDirectory, oDateSubDirectoryName)
' Create the destination directory if it does not exist
If Not Directory.Exists(oRejectedDirectory) Then
Try
Directory.CreateDirectory(oRejectedDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
' 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(oRejectedDirectory, MessageId)
Else
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, 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 firebird-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, Transaction As SqlTransaction)
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.Replace("'", "''")}'"
_mssql.ExecuteNonQuery(oSQL, Transaction)
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 PDFEmbeds(_logConfig)
_EmailOutAccountId = oArgs.EmailOutProfileId
Dim oOptions As New ZUGFeRDInterface.ZugferdOptions() With {
.AllowFacturX_Filename = oArgs.AllowFacturX,
.AllowXRechnung_Filename = oArgs.AllowXRechnung
}
_zugferd = New ZUGFeRDInterface(_logConfig, _gdpictureLicenseKey, oOptions)
_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 oFBConnection As FbConnection = _firebird.GetConnection()
Dim oFBTransaction As FbTransaction = oFBConnection.BeginTransaction()
Dim oSQLConnection As SqlConnection = _mssql.GetConnection()
Dim oSQLTransaction As SqlTransaction = oSQLConnection?.BeginTransaction()
If oSQLConnection Is Nothing Then
_logger.Warn("SQL Connection was not set. No INSERTs for MSSQL Server will be performed!")
oArgs.InsertIntoSQLServer = False
End If
' 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 oMissingProperties As New List(Of String)
Dim oMD5CheckSum As String = String.Empty
_logger.Info("Start processing file group {0}", oMessageId)
Try
For Each oFile In oFileGroupFiles
' 09.12.2021: oDocument is now an Object, because have different classes corresponding to the
' different versions of ZUGFeRD and the type is unknown at compile-time.
' 17.11.2022: oDocument is now a Tuple of (String, Object), to be able to return the filename
' of the extracted xml file.
' 21.12.2022: oDocument is now an object of type ZugferdResult to be able to save
' the new meta data, ie. the type of schema (zugferd version)
Dim oDocument As ZUGFeRDInterface.ZugferdResult
' 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.ToUpper.EndsWith(".PDF") Then
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
oEmailAttachmentFiles.Add(oFile)
' Checking filesize for attachment files
If Check_FileSize(oFile, oArgs.MaxAttachmentSizeInMegaBytes) = False Then
_logger.Warn("Filesize for File [{0}] exceeded limit of {1} MB", oFile.Name, oArgs.MaxAttachmentSizeInMegaBytes)
Throw New FileSizeLimitReachedException(oFile.Name, oArgs.MaxAttachmentSizeInMegaBytes)
End If
Continue For
End If
_logger.Info("Start processing file {0}", oFile.Name)
' Checking filesize for pdf files
If Check_FileSize(oFile, oArgs.MaxAttachmentSizeInMegaBytes) = False Then
_logger.Warn("Filesize for File [{0}] exceeded limit of {1} MB", oFile.Name, oArgs.MaxAttachmentSizeInMegaBytes)
Throw New FileSizeLimitReachedException(oFile.Name, oArgs.MaxAttachmentSizeInMegaBytes)
End If
Try
oDocument = _zugferd.ExtractZUGFeRDFileWithGDPicture(oFile.FullName)
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)
oEmailAttachmentFiles.Add(oFile)
Continue For
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.Warn("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
' 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 = 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
' Check the Checksum and rejection status
oMD5CheckSum = GenerateAndCheck_MD5Sum(oFile.FullName, oArgs.IgnoreRejectionStatus)
' 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
' Check the document against the configured property map and return:
' - a List of valid properties
' - a List of missing properties
Dim oPropertyMap = GetPropertyMapFor(oArgs, oDocument.Specification)
Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument.SchemaObject, oPropertyMap, oMessageId)
_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)
oMissingProperties = oCheckResult.MissingProperties
Throw New MissingValueException(oFile)
End If
_logger.Debug("No missing properties found. Continuing.")
Dim oDelSQL = $"DELETE FROM TBEDMI_ITEM_VALUE where REFERENCE_GUID = '{oMessageId}'"
Dim oStep As String
oStep = "Firebird TBEDMI_ITEM_VALUE Delete messageID Items"
Try
_firebird.ExecuteNonQueryWithConnection(oDelSQL, oFBConnection, Firebird.TransactionMode.ExternalTransaction, oFBTransaction)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Step [{0}] with SQL [{1}] was not successful.", oStep, oDelSQL)
End Try
If oArgs.InsertIntoSQLServer = True Then
oStep = "MSSQL TBEDMI_ITEM_VALUE Delete messageID Items"
Try
_mssql.ExecuteNonQueryWithConnectionObject(oDelSQL, oSQLConnection, MSSQLServer.TransactionMode.ExternalTransaction, oSQLTransaction)
Catch ex As Exception
_logger.Warn("Step [{0}] with SQL [{1}] was not successful.", oStep, oDelSQL)
End Try
End If
For Each oProperty In oCheckResult.ValidProperties
Dim oGroupCounterValue = oProperty.GroupCounter
' If GroupCounter is -1, it means this is a default property that can only occur once.
' Set the actual inserted value to 0
If oGroupCounterValue = -1 Then
oGroupCounterValue = 0
End If
Dim oCommand = $"INSERT INTO {oProperty.TableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER,SPEC_NAME,IS_REQUIRED) VALUES
('{oMessageId}', '{oProperty.Description}', '{oProperty.Value.Replace("'", "''")}', {oGroupCounterValue},'{oProperty.TableColumn}','{oProperty.IsRequired}')"
_logger.Debug("Mapping Property [{0}] with value [{1}], Will be inserted into table [{2}]", oProperty.TableColumn, oProperty.Value.Replace("'", "''"), oProperty.TableName)
' Insert into SQL Server
If oArgs.InsertIntoSQLServer = True Then
Dim oResult = _mssql.ExecuteNonQueryWithConnectionObject(oCommand, oSQLConnection, MSSQLServer.TransactionMode.ExternalTransaction, oSQLTransaction)
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, oFBConnection, Firebird.TransactionMode.ExternalTransaction, oFBTransaction)
Next
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 oArgs.NonZugferdDirectory Is Nothing OrElse oArgs.NonZugferdDirectory = String.Empty Then
Throw New NoFerdsException()
End If
' Also, if the directory is set but does not exist, still a rejection will be generated.
If Not IO.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...
'Log the History
If oMD5CheckSum <> String.Empty Then
Create_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS", oFBTransaction)
'Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oMessageId}', '{oMD5CheckSum}')"
'_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oFBConnection, Firebird.TransactionMode.ExternalTransaction, oFBTransaction)
'' History ID is only need in case of an error
'oFBTransaction.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
Else
Create_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)", oFBTransaction)
End If
oIsSuccess = True
oMoveDirectory = oArgs.SuccessDirectory
Catch ex As MD5HashException
_logger.Error(ex)
Dim oMessage = "REJECTED - Already processed (MD5Hash)"
Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage, oFBTransaction)
Dim oBody = EmailStrings.EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
Catch ex As UnsupportedFerdException
_logger.Error(ex)
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oFBTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "UnsupportedFerdException", "Nicht unterstütztes Datenformat", "", oSQLTransaction)
Catch ex As InvalidFerdException
_logger.Error(ex)
' When InvalidFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oFBTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "", oSQLTransaction)
Catch ex As TooMuchFerdsException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oFBTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction)
Catch ex As NoFerdsException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oFBTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", 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 MissingValueException
_logger.Error(ex)
Dim oMessage As String = ""
For Each prop In oMissingProperties
oMessage &= $"- {prop}"
Next
Create_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]", oFBTransaction)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage, oSQLTransaction)
Catch ex As FileSizeLimitReachedException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached", oFBTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oKey = FileSizeLimitReachedException.KEY_FILENAME
Dim oFileExceedingThreshold As String = IIf(ex.Data.Contains(oKey), ex.Data.Item(oKey), "")
Dim oFileWithoutMessageId = oFileExceedingThreshold.
Replace(oMessageId, "").
Replace("~", "")
Dim oBody = String.Format(EmailStrings.EMAIL_FILE_SIZE_REACHED, oArgs.MaxAttachmentSizeInMegaBytes, oFileWithoutMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
Catch ex As OutOfMemoryException
_logger.Warn("OutOfMemory Error occurred: {0}", ex.Message)
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"OutOfMemoryException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "OutOfMemoryException", _EmailOutAccountId, oArgs.NamePortal)
' Rollback Firebird
oFBTransaction.Rollback()
' Rollback MSSQL
oSQLTransaction.Rollback()
oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "UnhandledException", _EmailOutAccountId, oArgs.NamePortal)
' Rollback Firebird
oFBTransaction.Rollback()
' Rollback MSSQL
oSQLTransaction.Rollback()
oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False
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
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory, oIsSuccess)
End If
_logger.Info("Finished processing file group {0}", oMessageId)
Catch ex As Exception
' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"FileMoveException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "FileMoveException", _EmailOutAccountId, oArgs.NamePortal)
_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
' Commit SQL Transaction
oSQLTransaction.Commit()
' Commit Firebird Transaction
oFBTransaction.Commit()
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Database Transactions were not committed successfully.")
End Try
Try
oFBConnection.Close()
oSQLConnection.Close()
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Database Connections were not closed successfully.")
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 Function GetPropertyMapFor(pWorkerArgs As WorkerArgs, pSpecification As String) As Dictionary(Of String, XmlItemProperty)
Dim oPropertyMap = DoGetPropertyMapFor(pWorkerArgs, pSpecification)
_logger.Debug("Found [{0}] Properties for Specification [{1}].", oPropertyMap.Count, pSpecification)
' If no properties were found, fall back to the default specification before giving up
If oPropertyMap.Count = 0 Then
_logger.Warn("No Properties found for Specification [{0}]. Loading default property map!", pSpecification)
Return DoGetPropertyMapFor(pWorkerArgs, ZUGFeRDInterface.ZUGFERD_SPEC_DEFAULT)
End If
Return oPropertyMap
End Function
Private Function DoGetPropertyMapFor(pWorkerArgs As WorkerArgs, pSpecification As String) As Dictionary(Of String, XmlItemProperty)
Return pWorkerArgs.PropertyMap.
Where(Function(kv) kv.Value.Specification = pSpecification).
ToDictionary(Function(kv) kv.Key, Function(kv) kv.Value)
End Function
Private Sub MoveFiles(
Args As WorkerArgs,
MessageId As String,
Files As List(Of FileInfo),
AttachmentFiles As List(Of FileInfo),
EmbeddedAttachments As List(Of PDFEmbeds.EmbeddedFile),
MoveDirectory As String,
IsSuccess As Boolean)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oDateSubDirectoryName As String = Now.ToString("yyyy\\MM\\dd")
Dim oAttachmentDirectory As String = Path.Combine(oFinalMoveDirectory, Args.AttachmentsSubDirectory, oDateSubDirectoryName)
' Files will be moved to a subfolder for the current day if they are rejected
If Not IsSuccess Then
oFinalMoveDirectory = Path.Combine(oFinalMoveDirectory, oDateSubDirectoryName)
End If
' 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 oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oFinalMoveDirectory)
_logger.Info("File moved to {0}", oFilePath)
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 oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFilePath, oAttachmentDirectory)
_logger.Info("Attachment moved to {0}", oFilePath)
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)
If Not File.Exists(oAttachmentDirectory) Then
Directory.CreateDirectory(oAttachmentDirectory)
End If
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oWriter.Write(oResult.FileContents, 0, oResult.FileContents.Length)
_logger.Info("Embedded Attachment moved to {0}", oFilePath)
End Using
Catch ex As Exception
_logger.Warn("Could not save embedded attachment {0}", oResult.FileName)
_logger.Error(ex)
End Try
Next
_logger.Info("Finished moving files")
End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) As 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 CreateBodyForUnhandledException(MessageId As String, Exception As Exception) As String
Dim oBody = String.Format(EmailStrings.EMAIL_UNHANDLED_EXCEPTION, MessageId, Exception.Message, Exception.StackTrace)
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
Private Function Create_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As FbTransaction) As Boolean
Try
Dim oConnection = _firebird.GetConnection()
Dim oSQL = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (COMMENT, MD5HASH, MESSAGE_ID) VALUES ('{Message}', '{MD5Checksum}', '{MessageId}')"
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
_firebird.ExecuteNonQueryWithConnection(oSQL, oConnection, Firebird.TransactionMode.WithTransaction)
' Close the connection
oConnection.Close()
If Message.Contains("REJECTED") Then
oSQL = $"UPDATE TBEMLP_HISTORY SET STATUS = 'REJECTED', COMMENT = '{Message}', CUST_REJECTED = 1,CUST_REJECTED_WHEN = GETDATE() WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQuery(oSQL)
End If
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be created for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
Private Function Update_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As FbTransaction) As Boolean
Try
Dim oConnection = _firebird.GetConnection()
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = '{Message}' WHERE MD5HASH = '{MD5Checksum}' AND MESSAGE_ID = '{MessageId}'"
_firebird.ExecuteNonQueryWithConnection(oSQL, oConnection, Firebird.TransactionMode.WithTransaction)
' Close the connection
oConnection.Close()
Return True
Catch ex As Exception
_logger.Warn("History Entry count not be updated for message id [{0}] and md5 [{1}]", MessageId, MD5Checksum)
_logger.Error(ex)
Return False
End Try
End Function
'''
''' Generates the MD5 Checksum of a file and checks it against the histroy table TBEDM_ZUGFERD_HISTORY_IN
'''
''' The path of the file to be checked
''' Should the check take into account the rejection status of the file?
''' The MD5 Checksum of the file, or an empty string, if the Checksum could not be created
''' Throws, when the file should be rejected, ie. if it already exists in the table
Private Function GenerateAndCheck_MD5Sum(pFilePath As String, pIgnoreRejectionStatus As Boolean) As String
Dim oMD5CheckSum = CreateMD5(pFilePath)
' Exit if MD5 could not be created
If oMD5CheckSum = String.Empty Then
_logger.Warn("MD5 Checksum is nothing for file [{0}]!", pFilePath)
Return oMD5CheckSum
End If
' Check if Checksum exists in History Table
Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE GUID = (SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oTable As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.NoTransaction)
' If History entries could not be fetched, just return the MD5 Checksum
If IsNothing(oTable) Then
_logger.Warn("Be careful: oExistsDT is nothing for file [{0}]!", pFilePath)
Return oMD5CheckSum
End If
' If Checksum does not exist in History entries, just return the MD5 Checksum
If oTable.Rows.Count = 0 Then
_logger.Debug("File [{0}] was not found in History!", pFilePath)
Return oMD5CheckSum
End If
' ====================================================
' Checksum exists in History entries, reject!
' ====================================================
Dim oRejected As Boolean
Dim oHistoryId As Integer
' Try to read Rejected Status and History Id
Try
Dim oRow As DataRow = oTable.Rows.Item(0)
oRejected = DirectCast(oRow.Item("REJECTED"), Boolean)
oHistoryId = oRow.Item("GUID")
Catch ex As Exception
_logger.Warn("Error while converting REJECTED: " & ex.Message)
oRejected = False
End Try
_logger.Info("File has already been processed...")
' If the file was already rejected, it is allowed to be processed again,
' even if the Checksum exists in the history entries (default case)
' Which means, if it was not rejected before, it will be rejected in any case!
'
' This logic can be overwritten by the IgnoreRejectionStatus parameter.
' If it is set to true, the file will be rejected if the file exists in the history entries,
' regardless of the rejected parameter.
If oRejected = True And pIgnoreRejectionStatus = True Then
_logger.Info("ZuGFeRDFile already has been processed, but formerly obviously was rejected!")
Else
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{oHistoryId}]")
End If
Return oMD5CheckSum
End Function
'''
''' Checks the size of the supplied file.
'''
'''
'''
'''
Private Function Check_FileSize(pFileInfo As FileInfo, pMaxFileSizeInMegaBytes As Integer) As Boolean
_logger.Info("Checking Filesize of {0}", pFileInfo.Name)
_logger.Debug("Filesize threshold is {0} MB.", pMaxFileSizeInMegaBytes)
If pMaxFileSizeInMegaBytes <= 0 Then
_logger.Debug("Filesize is not configured. Skipping check.")
Return True
End If
Dim oMaxSize = pMaxFileSizeInMegaBytes * 1024 * 1024
If oMaxSize > 0 And pFileInfo.Length > oMaxSize Then
_logger.Debug("Filesize is bigger than threshold. Rejecting.")
Return False
Else
_logger.Debug("Filesize is smaller than threshold. All fine.")
Return True
End If
End Function
End Class