847 lines
44 KiB
VB.net
847 lines
44 KiB
VB.net
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.
|
|
Dim oDocument As Tuple(Of String, Object)
|
|
|
|
' 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 oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument, oArgs.PropertyMap, 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 oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, ex.XmlFile)
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
|
|
_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 oBody = EmailStrings.EMAIL_INVALID_DOCUMENT
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
|
|
_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 oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
|
|
_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 oBody = EmailStrings.EMAIL_NO_FERDS
|
|
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
|
|
_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 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
|
|
|
|
''' <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(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
|
|
|
|
''' <summary>
|
|
''' Checks the size of the supplied file.
|
|
''' </summary>
|
|
''' <param name="pFileInfo"></param>
|
|
''' <param name="pMaxFileSizeInMegaBytes"></param>
|
|
''' <returns></returns>
|
|
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
|