AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Zugferd: fix

Browse Source
This commit is contained in:
Jonathan Jenne 2023-10-10 15:53:55 +02:00
parent c187bdbe5e
commit a64823ae5e
6 changed files with 227 additions and 315 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Interfaces/ZUGFeRDInterface/FileGroups.vb
View File

@ -3,7 +3,7 @@ Imports System.Text.RegularExpressions
Imports DigitalData.Modules.Logging
Public Class FileGroups
Private _logger As Logger
Private ReadOnly _logger As Logger
Public Sub New(LogConfig As LogConfig)
_logger = LogConfig.GetLogger()
@ -25,7 +25,7 @@ Public Class FileGroups
Dim oMessageId = GetMessageIdFromFileName(oFile.Name)
If oMessageId Is Nothing Then
_logger.Warn("File {0} did not have the required filename-format!", oMessageId)
_logger.Warn("File {0} did not have the required filename-format!", oFile.Name)
Continue For
End If

1
Jobs/Jobs.vbproj
View File

@ -97,6 +97,7 @@
<Compile Include="ZUGFeRD\EmailFunctions.vb" />
<Compile Include="ZUGFeRD\EmailStrings.vb" />
<Compile Include="ZUGFeRD\FileFunctions.vb" />
<Compile Include="ZUGFeRD\HashFunctions.vb" />
<Compile Include="ZUGFeRD\HistoryFunctions.vb" />
<Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="ZUGFeRD\WorkerArgs.vb" />

6
Jobs/My Project/AssemblyInfo.vb
View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyTrademark("2.1.0.0")>
<Assembly: AssemblyTrademark("2.2.0.0")>
<Assembly: ComVisible(False)>
@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices
' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern
' übernehmen, indem Sie "*" eingeben:
<Assembly: AssemblyVersion("2.1.0.0")>
<Assembly: AssemblyFileVersion("2.1.0.0")>
<Assembly: AssemblyVersion("2.2.0.0")>
<Assembly: AssemblyFileVersion("2.2.0.0")>

107
Jobs/ZUGFeRD/FileFunctions.vb
View File

@ -5,7 +5,6 @@ Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class FileFunctions
@ -13,29 +12,31 @@ Namespace ZUGFeRD
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _filesystem As FilesystemEx
Private ReadOnly _email As ZUGFeRD.EmailFunctions
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
Public Sub New(pLogConfig As LogConfig, pMSSQL As MSSQLServer)
_logConfig = pLogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
_filesystem = New FilesystemEx(LogConfig)
_mssql = pMSSQL
_email = New EmailFunctions(pLogConfig, pMSSQL)
_filesystem = New FilesystemEx(pLogConfig)
End Sub
Public 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)
pArgs As WorkerArgs,
pMessageId As String,
pFiles As List(Of FileInfo),
pAttachmentFiles As List(Of FileInfo),
pEmbeddedAttachments As List(Of PDFEmbeds.EmbeddedFile),
pMoveDirectory As String,
pIsSuccess As Boolean)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oFinalMoveDirectory As String = pMoveDirectory
Dim oDateSubDirectoryName As String = Now.ToString("yyyy\\MM\\dd")
Dim oAttachmentDirectory As String = Path.Combine(oFinalMoveDirectory, Args.AttachmentsSubDirectory, oDateSubDirectoryName)
Dim oAttachmentDirectory As String = Path.Combine(oFinalMoveDirectory, pArgs.AttachmentsSubDirectory, oDateSubDirectoryName)
' Files will be moved to a subfolder for the current day if they are rejected
If Not IsSuccess Then
If Not pIsSuccess Then
oFinalMoveDirectory = Path.Combine(oFinalMoveDirectory, oDateSubDirectoryName)
End If
@ -48,7 +49,7 @@ Namespace ZUGFeRD
End Try
End If
If Not Directory.Exists(oAttachmentDirectory) And AttachmentFiles.Count > 0 Then
If Not Directory.Exists(oAttachmentDirectory) And pAttachmentFiles.Count > 0 Then
Try
Directory.CreateDirectory(oAttachmentDirectory)
Catch ex As Exception
@ -57,7 +58,7 @@ Namespace ZUGFeRD
End If
' Filter out Attachments from `Files`
Dim oInvoiceFiles As List(Of FileInfo) = Files.Except(AttachmentFiles).ToList()
Dim oInvoiceFiles As List(Of FileInfo) = pFiles.Except(pAttachmentFiles).ToList()
' Move PDF/A Files
For Each oFile In oInvoiceFiles
@ -74,7 +75,7 @@ Namespace ZUGFeRD
Next
' Move non-PDF/A Email Attachments/Files
For Each oFile In AttachmentFiles
For Each oFile In pAttachmentFiles
Try
Dim oFilePath = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
@ -87,9 +88,9 @@ Namespace ZUGFeRD
Next
' Write Embedded Files to disk
For Each oResult In EmbeddedAttachments
For Each oResult In pEmbeddedAttachments
Try
Dim oFileName As String = $"{MessageId}~{oResult.FileName}"
Dim oFileName As String = $"{pMessageId}~{oResult.FileName}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
If Not File.Exists(oAttachmentDirectory) Then
@ -108,6 +109,72 @@ Namespace ZUGFeRD
_logger.Info("Finished moving files")
End Sub
Public Function MoveAndRenameEmailToRejected(pArgs As WorkerArgs, pMessageId As String) As EmailData
_logger.Info("Moving Mail with MessageId [{0}] to Rejected folder", pMessageId)
_logger.Debug("Fetching Email Data")
Dim oEmailData = _email.GetEmailDataForMessageId(pMessageId)
_logger.Debug("Email Data fetched!")
Dim oSource = _email.GetOriginalEmailPath(pArgs.OriginalEmailDirectory, pMessageId)
_logger.Debug("Original email path: [{0}]", oSource)
Dim oDateSubDirectoryName As String = Now.ToString("yyyy-MM-dd")
Dim oDestination As String
Dim oRejectedDirectory As String = Path.Combine(pArgs.RejectedEmailDirectory, oDateSubDirectoryName)
' Create the destination directory if it does not exist
_logger.Debug("Creating destination directory [{0}]", oRejectedDirectory)
If Not Directory.Exists(oRejectedDirectory) Then
Try
Directory.CreateDirectory(oRejectedDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If oSource = String.Empty Then
_logger.Warn("Original Email for [{0}] could not be found. Exiting.", pMessageId)
Return New EmailData()
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, pMessageId)
Else
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, StringEx.ConvertTextToSlug(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 New EmailData()
End If
'---------------------------
Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
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
_logger.Info("Email [{0}] moved to rejected folder!", pMessageId)
Return oEmailData
End Function
End Class
End Namespace

123
Jobs/ZUGFeRD/HashFunctions.vb Normal file
View File

@ -0,0 +1,123 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
Imports System.Data
Imports System.IO
Imports System.Security.Cryptography
Public Class HashFunctions
Inherits BaseClass
Private ReadOnly Database As MSSQLServer
Public Sub New(pLogConfig As LogConfig, pDatabase As MSSQLServer)
MyBase.New(pLogConfig)
Database = pDatabase
End Sub
''' <summary>
''' Generates the MD5 Checksum of a file and checks it against the histroy table TBEDM_ZUGFERD_HISTORY_IN
''' </summary>
''' <param name="pFilePath">The path of the file to be checked</param>
''' <param name="pIgnoreRejectionStatus">Should the check take into account the rejection status of the file?</param>
''' <returns>The MD5 Checksum of the file, or an empty string, if the Checksum could not be created</returns>
''' <exception cref="MD5HashException">Throws, when the file should be rejected, ie. if it already exists in the table</exception>
Public Function GenerateAndCheck_MD5Sum(pFile As FileInfo, pMessageId As String, pIgnoreRejectionStatus As Boolean) As String
Dim oMD5CheckSum = CreateMD5(pFile.FullName)
' Exit if MD5 could not be created
If oMD5CheckSum = String.Empty Then
Logger.Warn("MD5 Checksum is nothing for file [{0}]!", pFile.FullName)
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)
' Check if Checksum exists in History Table
' TODO: WHAT THE FUCK IS THIS
Dim oCheckCommand = $"SELECT * FROM TBEMLP_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBEMLP_HISTORY WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oTable As DataTable = Database.GetDatatable(oCheckCommand, MSSQLServer.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}]!", pFile.FullName)
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!", pFile.FullName)
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 = oRow.ItemEx("CUST_REJECTED", False)
oHistoryId = oRow.Item("GUID")
Catch ex As Exception
Logger.Warn("Error while converting REJECTED: " & ex.Message)
oRejected = False
End Try
' Try to get the original filename from Attachment table
' If this fails, falls back to the new filename (<msgid>~Attm<i>.ext)
Dim oSQL = $"SELECT EMAIL_ATTMT FROM TBEMLP_HISTORY_ATTACHMENT WHERE EMAIL_ATTMT_INDEX = '{pFile.Name}'"
Dim oEmailAttachment = Database.GetScalarValue(oSQL, MSSQLServer.TransactionMode.NoTransaction)
Dim oOriginalName = ObjectEx.NotNull(oEmailAttachment, pFile.Name)
Logger.Info("File with MessageId [{0}] and Filename [{1}] has already been processed.", pMessageId, oOriginalName)
' 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 Rejection Status will be ignored!")
ElseIf oRejected = False Then
Logger.Info("ZuGFeRDFile already has been processed. Will be rejected.")
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{oHistoryId}] - Case 1", oOriginalName)
Else
Logger.Info("ZuGFeRDFile already has been processed. Will be rejected.")
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{oHistoryId}] - Case 2", oOriginalName)
End If
Return oMD5CheckSum
End Function
Private Function CreateMD5(pFilename 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(pFilename, 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

301
Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -37,6 +37,7 @@ Public Class ImportZUGFeRDFiles
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
@ -68,6 +69,7 @@ Public Class ImportZUGFeRDFiles
_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
@ -173,118 +175,7 @@ Public Class ImportZUGFeRDFiles
oEmailAttachmentFiles.AddRange(oResult.EmailAttachmentFiles)
oEmbeddedAttachmentFiles.AddRange(oResult.EmbeddedAttachmentFiles)
End If
' ------------------------------------------------------------
#Region "REFACTOR"
'Dim oDocument As ZUGFeRDInterface.ZugferdResult
'' 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 _filesystem.TestFileSizeIsLessThanMaxFileSize(oFile.FullName, 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 _filesystem.TestFileSizeIsLessThanMaxFileSize(oFile.FullName, 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 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)
' 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.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 oZUGFeRDCount = 1 Then
' Throw New TooMuchFerdsException()
'End If
'' Since extraction went well, increase the amount of ZUGFeRD files
'oZUGFeRDCount += 1
'' 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, oMessageId, oArgs.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(oArgs.PropertyMap, 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)
' Throw New MissingValueException(oFile, oCheckResult.MissingProperties)
'Else
' _logger.Debug("No missing properties found. Continuing.")
'End If
'DeleteExistingPropertyValues(oMessageId, oConnections)
'Dim oFirstProperty = oCheckResult.ValidProperties.FirstOrDefault()
'If oFirstProperty IsNot Nothing Then
' InsertPropertyValue(oMessageId, oConnections, New PropertyValues.ValidProperty() With {
' .MessageId = oMessageId,
' .Description = "ZUGFeRDSpezifikation",
' .GroupCounter = 0,
' .IsRequired = False,
' .Value = oDocument.Specification,
' .TableName = oFirstProperty.TableName,
' .TableColumn = "ZUGFERD_SPECIFICATION"
' })
'End If
'For Each oProperty In oCheckResult.ValidProperties
' InsertPropertyValue(oMessageId, oConnections, oProperty)
'Next
#End Region
Next
'Check if there are no ZUGFeRD files
@ -329,7 +220,7 @@ Public Class ImportZUGFeRDFiles
Next
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "ValidationException", "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
@ -342,7 +233,7 @@ Public Class ImportZUGFeRDFiles
_history.Update_HistoryEntry(oMessageId, String.Empty, oMessage)
Dim oBody = String.Format(EmailStrings.EMAIL_MD5_ERROR, ex.FileName)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
@ -353,7 +244,7 @@ Public Class ImportZUGFeRDFiles
' That 's why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format")
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.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)
@ -366,7 +257,7 @@ Public Class ImportZUGFeRDFiles
' That 's why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format")
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal)
@ -377,7 +268,7 @@ Public Class ImportZUGFeRDFiles
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email")
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal)
@ -388,7 +279,7 @@ Public Class ImportZUGFeRDFiles
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email")
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal)
@ -405,7 +296,7 @@ Public Class ImportZUGFeRDFiles
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]")
Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, ex.MissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage, oSQLTransaction)
@ -414,7 +305,7 @@ Public Class ImportZUGFeRDFiles
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached")
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oKey = FileSizeLimitReachedException.KEY_FILENAME
Dim oFileExceedingThreshold As String = IIf(ex.Data.Contains(oKey), ex.Data.Item(oKey), "")
@ -525,7 +416,6 @@ Public Class ImportZUGFeRDFiles
End Try
End Sub
#Region "=== REFACTOR"
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()
@ -600,7 +490,7 @@ Public Class ImportZUGFeRDFiles
End If
' Check the Checksum and rejection status
Dim oMD5Checksum = GenerateAndCheck_MD5Sum(oFile, pMessageId, pArgs.IgnoreRejectionStatus)
Dim oMD5Checksum = _hash.GenerateAndCheck_MD5Sum(oFile, pMessageId, pArgs.IgnoreRejectionStatus)
' Check the document against the configured property map and return:
' - a List of valid properties
@ -648,8 +538,6 @@ Public Class ImportZUGFeRDFiles
Return oResult
End Function
#End Region
Private Sub DeleteExistingPropertyValues(pMessageId As String, pConnections As DatabaseConnections)
Dim oDelSQL = $"DELETE FROM TBEDMI_ITEM_VALUE where REFERENCE_GUID = '{pMessageId}'"
@ -683,173 +571,6 @@ Public Class ImportZUGFeRDFiles
End If
End Sub
Private Function CreateMD5(pFilename 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(pFilename, 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
''' <summary>
''' Generates the MD5 Checksum of a file and checks it against the histroy table TBEDM_ZUGFERD_HISTORY_IN
''' </summary>
''' <param name="pFilePath">The path of the file to be checked</param>
''' <param name="pIgnoreRejectionStatus">Should the check take into account the rejection status of the file?</param>
''' <returns>The MD5 Checksum of the file, or an empty string, if the Checksum could not be created</returns>
''' <exception cref="MD5HashException">Throws, when the file should be rejected, ie. if it already exists in the table</exception>
Private Function GenerateAndCheck_MD5Sum(pFile As FileInfo, pMessageId As String, pIgnoreRejectionStatus As Boolean) As String
Dim oMD5CheckSum = CreateMD5(pFile.FullName)
' Exit if MD5 could not be created
If oMD5CheckSum = String.Empty Then
_logger.Warn("MD5 Checksum is nothing for file [{0}]!", pFile.FullName)
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)
' Check if Checksum exists in History Table
' TODO: WHAT THE FUCK IS THIS
Dim oCheckCommand = $"SELECT * FROM TBEMLP_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBEMLP_HISTORY WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oTable As DataTable = _mssql.GetDatatable(oCheckCommand, MSSQLServer.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}]!", pFile.FullName)
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!", pFile.FullName)
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 = oRow.ItemEx("CUST_REJECTED", False)
oHistoryId = oRow.Item("GUID")
Catch ex As Exception
_logger.Warn("Error while converting REJECTED: " & ex.Message)
oRejected = False
End Try
_logger.Info("File with MessageId [{0}] has already been processed.", pMessageId)
' 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 Rejection Status will be ignored!")
ElseIf oRejected = False Then
_logger.Info("ZuGFeRDFile already has been processed. Will be rejected.")
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{oHistoryId}] - Case 1", pFile.Name)
Else
_logger.Info("ZuGFeRDFile already has been processed. Will be rejected.")
Throw New MD5HashException($"There is already an identical invoice! - HistoryID [{oHistoryId}] - Case 2", pFile.Name)
End If
Return oMD5CheckSum
End Function
Private Function MoveAndRenameEmailToRejected(pArgs As WorkerArgs, pMessageId As String) As EmailData
_logger.Info("Moving Mail with MessageId [{0}] to Rejected folder", pMessageId)
_logger.Debug("Fetching Email Data")
Dim oEmailData = _email.GetEmailDataForMessageId(pMessageId)
_logger.Debug("Email Data fetched!")
Dim oSource = _email.GetOriginalEmailPath(pArgs.OriginalEmailDirectory, pMessageId)
_logger.Debug("Original email path: [{0}]", oSource)
Dim oDateSubDirectoryName As String = Now.ToString("yyyy-MM-dd")
Dim oDestination As String
Dim oRejectedDirectory As String = Path.Combine(pArgs.RejectedEmailDirectory, oDateSubDirectoryName)
' Create the destination directory if it does not exist
_logger.Debug("Creating destination directory [{0}]", oRejectedDirectory)
If Not Directory.Exists(oRejectedDirectory) Then
Try
Directory.CreateDirectory(oRejectedDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If oSource = String.Empty Then
_logger.Warn("Original Email for [{0}] could not be found. Exiting.", pMessageId)
Return New EmailData()
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, pMessageId)
Else
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, StringEx.ConvertTextToSlug(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 New EmailData()
End If
'---------------------------
Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
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
_logger.Info("Email [{0}] moved to rejected folder!", pMessageId)
Return oEmailData
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)