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

Jobs/Zugferd: Improve structure

Browse Source
This commit is contained in:
Jonathan Jenne 2023-08-22 08:37:15 +02:00
parent 7fea3dc1ff
commit 72f7211d63
5 changed files with 367 additions and 361 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Jobs/Jobs.vbproj
View File

@ -100,6 +100,8 @@
<Compile Include="ZUGFeRD\EmailData.vb" />
<Compile Include="ZUGFeRD\EmailFunctions.vb" />
<Compile Include="ZUGFeRD\EmailStrings.vb" />
<Compile Include="ZUGFeRD\FileFunctions.vb" />
<Compile Include="ZUGFeRD\HistoryFunctions.vb" />
<Compile Include="ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="ZUGFeRD\WorkerArgs.vb" />
<Compile Include="Exceptions.vb" />

78
Jobs/ZUGFeRD/EmailFunctions.vb
View File

@ -1,10 +1,12 @@
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Language
Imports DigitalData.Modules.Base
Imports System.Data
Imports System.IO
Imports System.Data.SqlClient
Imports System.Collections.Generic
Namespace ZUGFeRD
Public Class EmailFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
@ -16,53 +18,6 @@ Public Class EmailFunctions
_mssql = MSSQL
End Sub
'Public Sub AddToEmailQueueFB(MessageId As String, BodyText As String, EmailData As EmailData, NamePortal As String)
' If EmailData Is Nothing Then
' _logger.Warn("EmailData is empty. Email will not be sent!")
' Exit Sub
' End If
' Try
' Dim oJobId = RandomValue(1, 10000)
' Dim oReference = MessageId
' Dim oEmailTo = ""
' Dim oSubject = EmailStrings.EMAIL_SUBJECT_REJECTED.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal)
' Dim oAccountId = 1
' Dim oCreatedWho = "ZUGFeRD Service"
' Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT.Replace(EmailStrings.constNAME_ZUGFERD_PORTAL, NamePortal), BodyText)
' Dim oEmailAddress = EmailData.From
' Dim oAttachment = EmailData.Attachment
' If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
' _logger.Warn("Could not find email-address for MessageId {0}", MessageId)
' oEmailTo = String.Empty
' Else
' oEmailTo = oEmailAddress
' End If
' _logger.Debug("Generated Email:")
' _logger.Debug("To: {0}", oEmailTo)
' _logger.Debug("Subject: {0}", oSubject)
' _logger.Debug("Body {0}", oFinalBodyText)
' Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
' Dim oDTResult As DataTable = _firebird.GetDatatable(osql)
' If oDTResult.Rows.Count = 0 Then
' Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
' oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES "
' oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{oFinalBodyText.Replace("'", "''")}', '{oCreatedWho}', '{oAttachment}')"
' _firebird.ExecuteNonQuery(oSQLInsert)
' _logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo)
' Else
' _logger.Debug("Email has already been sent!!")
' End If
' Catch ex As Exception
' _logger.Error(ex)
' End Try
'End Sub
Public Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, pEmailData As EmailData, SourceProcedure As String, pEmailAccountId As Integer, NamePortal As String)
If pEmailData Is Nothing Then
_logger.Warn("EmailData is empty. Email will not be sent!")
@ -162,10 +117,12 @@ Public Class EmailFunctions
Dim oSubjectDefault = String.Format("No Subject found for ({0})", MessageId)
Dim oSubject = oRow.ItemEx("EMAIL_SUBJECT", oSubjectDefault)
_logger.Info("Email Data for [{0}] fetched!", MessageId)
Return New EmailData() With {
.From = oFrom,
.Subject = oSubject
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing
@ -188,6 +145,8 @@ Public Class EmailFunctions
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
_logger.Debug("Email Filename is [{0}]", oAttachmentFile)
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
@ -197,4 +156,27 @@ Public Class EmailFunctions
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
Public 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
Public 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
End Class
End Namespace

112
Jobs/ZUGFeRD/FileFunctions.vb Normal file
View File

@ -0,0 +1,112 @@
Imports System.Collections.Generic
Imports System.IO
Imports System.Linq
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class FileFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _filesystem As Filesystem.File
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
_filesystem = New Filesystem.File(LogConfig)
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)
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
End Class
End Namespace

68
Jobs/ZUGFeRD/HistoryFunctions.vb Normal file
View File

@ -0,0 +1,68 @@
Imports System.Data.SqlClient
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class HistoryFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
End Sub
Public Function Create_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Creating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
Dim oSQL = $"INSERT INTO TBEMLP_HISTORY (COMMENT, MD5HASH, EMAIL_MSGID) VALUES ('{Message}', '{MD5Checksum}', '{MessageId}')"
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
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.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End If
_logger.Debug("History Entry created!")
End Using
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
Public Function Update_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Updating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
' Only look for history entry by MessageId since the MD5 Hash might not be generated yet
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
Dim oSQL = $"UPDATE TBEMLP_HISTORY SET COMMENT = '{Message}' WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End Using
_logger.Debug("History Entry created!")
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
End Class
End Namespace

256
Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -9,7 +9,6 @@ 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
@ -35,7 +34,10 @@ Public Class ImportZUGFeRDFiles
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions
Private ReadOnly _email As ZUGFeRD.EmailFunctions
Private ReadOnly _file As ZUGFeRD.FileFunctions
Private ReadOnly _history As ZUGFeRD.HistoryFunctions
Private ReadOnly _gdpictureLicenseKey As String
Private _zugferd As ZUGFeRDInterface
@ -51,7 +53,9 @@ Public Class ImportZUGFeRDFiles
_logger = LogConfig.GetLogger()
_filesystem = New Filesystem.File(_logConfig)
_mssql = MSSQL
_email = New EmailFunctions(LogConfig, _mssql)
_email = New ZUGFeRD.EmailFunctions(LogConfig, _mssql)
_file = New ZUGFeRD.FileFunctions(LogConfig, _mssql)
_history = New ZUGFeRD.HistoryFunctions(LogConfig, _mssql)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
@ -63,18 +67,23 @@ Public Class ImportZUGFeRDFiles
End If
End Sub
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData
_logger.Info("Moving Mail with MessageId [{0}] to Rejected folder", MessageId)
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(MessageId)
Dim oSource = _email.GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
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(Args.RejectedEmailDirectory, oDateSubDirectoryName)
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)
@ -83,12 +92,17 @@ Public Class ImportZUGFeRDFiles
End Try
End If
If oSource = String.Empty Then
_logger.Warn("Original Email for [{0}] could not be found. Exiting.", pMessageId)
Return Nothing
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)
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, pMessageId)
Else
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, oEmailData.Subject)
oDestination = _email.GetEmailPathWithSubjectAsName(oRejectedDirectory, StringEx.ConvertTextToSlug(oEmailData.Subject))
End If
_logger.Debug("Destination for eml file is {0}", oDestination)
@ -102,6 +116,8 @@ Public Class ImportZUGFeRDFiles
Return Nothing
End If
'---------------------------
Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
File.Move(oSource, oFinalFileName)
@ -112,6 +128,8 @@ Public Class ImportZUGFeRDFiles
oEmailData.Attachment = oSource
End Try
_logger.Info("Email [{0}] moved to rejected folder!", pMessageId)
Return oEmailData
End Function
@ -351,20 +369,9 @@ Public Class ImportZUGFeRDFiles
'If no errors occurred...
'Log the History
If oMD5CheckSum <> String.Empty Then
Create_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS", oSQLTransaction)
'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
_history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "SUCCESS", oSQLTransaction)
Else
Create_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, String.Empty, "SUCCESS (with empty MD5Hash)", oSQLTransaction)
End If
oIsSuccess = True
@ -375,7 +382,7 @@ Public Class ImportZUGFeRDFiles
Dim oErrors = ex.ValidationErrors
Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage, oSQLTransaction)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage, oSQLTransaction)
Dim oErrorList As String = ""
For Each oError In oErrors
@ -384,7 +391,6 @@ Public Class ImportZUGFeRDFiles
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "ValidationException", "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
@ -394,7 +400,7 @@ Public Class ImportZUGFeRDFiles
' When MD5HashException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
Dim oMessage = "REJECTED - Already processed (MD5Hash)"
Update_HistoryEntry(oMessageId, String.Empty, oMessage, oSQLTransaction)
_history.Update_HistoryEntry(oMessageId, String.Empty, oMessage, oSQLTransaction)
Dim oBody = EmailStrings.EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
@ -406,7 +412,7 @@ Public Class ImportZUGFeRDFiles
' 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", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile)
@ -419,7 +425,7 @@ Public Class ImportZUGFeRDFiles
' 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", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
@ -430,7 +436,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As TooMuchFerdsException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
@ -441,7 +447,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As NoFerdsException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
@ -449,11 +455,6 @@ Public Class ImportZUGFeRDFiles
_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)
@ -462,9 +463,9 @@ Public Class ImportZUGFeRDFiles
oMessage &= $"- {prop}"
Next
Create_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]", oSQLTransaction)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oBody = _email.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)
@ -472,7 +473,7 @@ Public Class ImportZUGFeRDFiles
Catch ex As FileSizeLimitReachedException
_logger.Error(ex)
Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached", oSQLTransaction)
_history.Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached", oSQLTransaction)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
@ -487,12 +488,18 @@ Public Class ImportZUGFeRDFiles
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
Catch ex As NoFerdsAlternateException
' TODO: Maybe dont even log this 'error', since it's not really an error and it might happen *A LOT*
_logger.Error(ex)
oMoveDirectory = oArgs.NonZugferdDirectory
Catch ex As OutOfMemoryException
_logger.Warn("OutOfMemory Error occurred: {0}", ex.Message)
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex)
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"OutOfMemoryException im ZUGFeRD-Parser @ {oMessageId}"
@ -511,7 +518,7 @@ Public Class ImportZUGFeRDFiles
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = CreateBodyForUnhandledException(oMessageId, ex)
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
@ -532,12 +539,12 @@ Public Class ImportZUGFeRDFiles
_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)
_file.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 oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"FileMoveException im ZUGFeRD-Parser @ {oMessageId}"
@ -612,123 +619,6 @@ Public Class ImportZUGFeRDFiles
End If
End Sub
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
@ -749,55 +639,7 @@ Public Class ImportZUGFeRDFiles
End Try
End Function
Private Function Create_HistoryEntry(MessageId As String, MD5Checksum As String, Message As String, Transaction As SqlTransaction) As Boolean
Try
_logger.Info("Creating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
Dim oSQL = $"INSERT INTO TBEMLP_HISTORY (COMMENT, MD5HASH, EMAIL_MSGID) VALUES ('{Message}', '{MD5Checksum}', '{MessageId}')"
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
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.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End If
_logger.Debug("History Entry created!")
End Using
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 SqlTransaction) As Boolean
Try
_logger.Info("Updating History Entry for MessageId [{0}] with comment [{1}]", MessageId, Message)
' Only look for history entry by MessageId since the MD5 Hash might not be generated yet
Using oConnection = _mssql.GetConnection()
' 09.07.2021: This can't be in the transaction since the history
' Entry needs to be accessed by MoveAndRenameEmailToRejected shortly after
Dim oSQL = $"UPDATE TBEMLP_HISTORY SET COMMENT = '{Message}' WHERE EMAIL_MSGID = '{MessageId}'"
_mssql.ExecuteNonQueryWithConnectionObject(oSQL, oConnection)
End Using
_logger.Debug("History Entry created!")
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