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

big refactor, move most zugferd processing into Modules.Interfaces

Browse Source
This commit is contained in:
Jonathan Jenne
2020-03-20 13:47:36 +01:00
parent 322ca23f33
commit 3d3a491744
8 changed files with 357 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files

279
Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@@ -26,106 +26,47 @@ Public Class ImportZUGFeRDFiles
Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments"
Public HISTORY_ID As Integer
Private Const EMAIL_WRAPPING_TEXT = "<html><body style=''font-family:""Arial"";font-size:10.0pt''>Sehr geehrte Damen und Herren,<br>
das WISAG-Portal zur Verarbeitung der Eingangsrechnungen im ZUGFeRD-Format konnte die von Ihnen gesandte Rechnung
leider nicht verarbeiten! <br><br> Grund: {0}<p>Bitte prüfen Sie die Datei und nehmen Sie bei Bedarf mit uns Kontakt auf.<p>
Vielen Dank für Ihr Verständnis.<br>Mit freundlichen Grüßen<br>Ihre IT-Abteilung</body></html>"
Private Const EMAIL_SUBJECT = "WISAG ZUGFeRD Portal: Beleg abgelehnt"
Private Const EMAIL_MISSINGPROPERTIES_1 = "<p>Die angehängte Datei entspricht nicht dem WISAG ZUGFeRD-Format: {0}</p>"
Private Const EMAIL_MISSINGPROPERTIES_2 = "<p>Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:<p/>"
Private Const EMAIL_MD5_ERROR = "<p>Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.</p>"
Private Const EMAIL_TOO_MUCH_FERDS = "<p>Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
Private Const EMAIL_NO_FERDS = "<p>Ihre Email enthielt keine ZUGFeRD-Dokumente.</p>"
Private Const EMAIL_INVALID_DOCUMENT = """
<p>Ihre Email enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
<p>Mögliche Gründe für ein inkorrektes Format:<ul>
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p>
"""
' List of allowed extensions for PDF/A Attachments
Private AllowedExtensions = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private ReadOnly AllowedExtensions As List(Of String) = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private _logger As Logger
Private _logConfig As LogConfig
Private _zugferd As ZUGFeRDInterface
Private _firebird As Firebird
Private _filesystem As Filesystem.File
Private _mssql As MSSQLServer
Private ReadOnly _logger As Logger
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _zugferd As ZUGFeRDInterface
Private ReadOnly _firebird As Firebird
Private ReadOnly _filesystem As Filesystem.File
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _email As EmailFunctions
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)
_zugferd = New ZUGFeRDInterface(_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'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL)
_zugferd = New ZUGFeRDInterface(_logConfig, oLicenseKey)
Else
_logger.Warn("GDPicture License could not be registered! MSSQL is not enabled!")
Throw New ArgumentNullException("MSSQL")
End If
End Sub
Private Function RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
Private Function GetEmailDataForMessageId(MessageId As String) As EmailData
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT, EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Try
Dim oDatatable = _firebird.GetDatatable(oSQL)
Dim oRow As DataRow
If oDatatable.Rows.Count = 0 Then
_logger.Warn("Got no results for MessageId {0}", MessageId)
Return Nothing
ElseIf oDatatable.Rows.Count > 1 Then
_logger.Warn("Got too many results for MessageId {0}. Using last row.", MessageId)
End If
_logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1)
Return New EmailData() With {
.From = oRow.Item("EMAIL_FROM"),
.Attachment = oRow.Item("EMAIL_ATTMT1"),
.Subject = oRow.Item("EMAIL_SUBJECT")
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing
End Try
End Function
Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
Dim oAttachmentDirectory = OriginalEmailDirectory
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
If IO.File.Exists(oAttachmentPath) Then
Return oAttachmentPath
Else
Return String.Empty
End If
End Function
Private Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
End Function
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData
Dim oEmailData = GetEmailDataForMessageId(MessageId)
Dim oSource = GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
Dim oEmailData = _email.GetEmailDataForMessageId(MessageId)
Dim oSource = _email.GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
Dim oDestination As String
' 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 = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, MessageId)
oDestination = _email.GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, MessageId)
Else
oDestination = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
oDestination = _email.GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
End If
_logger.Debug("Destination for eml file is {0}", oDestination)
@@ -154,135 +95,9 @@ Public Class ImportZUGFeRDFiles
Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String)
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}'"
_mssql.NewExecutenonQuery(oSQL)
'@MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250)
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Private Sub AddToEmailQueueFB(MessageId As String, BodyText As String, EmailData As EmailData)
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 = EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EMAIL_WRAPPING_TEXT, 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
Private Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, pEmailData As EmailData, SourceProcedure As String)
If pEmailData 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 = EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EMAIL_WRAPPING_TEXT, BodyText)
Dim oEmailAddress = pEmailData.From
Dim oAttachment = pEmailData.Attachment
If oAttachment <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachment}]!")
If IO.File.Exists(oAttachment) = False Then
_logger.Info($"Attachment.File [{oAttachment}] is not existing!!!")
End If
End If
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 MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim oHistoryID = _mssql.GetScalarValue(osql)
'osql = $"select * from TBEMLP_EMAIL_OUT where REFERENCE_ID = {oHistoryID} and EMAIL_ADRESS = '{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
'Dim oDTResult As DataTable = _mssql.GetDatatable(osql)
If IsNumeric(oHistoryID) Then
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] (
[REMINDER_TYPE_ID]
,[SENDING_PROFILE]
,[REFERENCE_ID]
,[REFERENCE_STRING]
,[WF_ID]
,[EMAIL_ADRESS]
,[EMAIL_SUBJ]
,[EMAIL_BODY]
,[COMMENT]
,[ADDED_WHO]
,EMAIL_ATTMT1)
VALUES
(77
,{oAccountId}
,{oHistoryID}
,'{MessageId}'
,77
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{SourceProcedure}'
,'{oCreatedWho}'
,'{oAttachment}')"
_mssql.ExecuteNonQuery(oInsert)
Else
'If oDTResult.Rows.Count = 0 Then
' _logger.Debug("Email has already been sent!!")
'Else
_logger.Warn("Could not get oHistoryID in AddToEmailQueueMSSQL!!")
' End If
End If
Catch ex As Exception
_logger.Error(ex)
End Try
@@ -295,23 +110,6 @@ Public Class ImportZUGFeRDFiles
_logger.Debug("Starting Job {0}", [GetType].Name)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
Try
Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL)
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(oLicenseKey)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("GDPicture License could not be retrieved! Query failed! Exiting job.")
Exit Sub
End Try
Else
_logger.Warn("GDPicture License could not be retrieved! MSSQL is not enabled! Exiting job.")
Exit Sub
End If
Try
For Each oPath As String In oArgs.WatchDirectories
Dim oDirInfo As New DirectoryInfo(oPath)
@@ -398,7 +196,8 @@ Public Class ImportZUGFeRDFiles
End Select
End Try
' Extract all attachments other than the zugferd-invoice.xml
' 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.
Dim oAttachments = oAttachmentExtractor.Extract(oFile.FullName, AllowedExtensions)
If oAttachments Is Nothing Then
_logger.Warn("Attachments for file [{0}] could not be extracted", oFile.FullName)
@@ -440,7 +239,7 @@ Public Class ImportZUGFeRDFiles
' Since extraction went well, increase the amount of ZUGFeRD files
oZUGFeRDCount += 1
#Region "Check Property Values"
' --- BEGIN Check Property Values
'' PropertyMap items with `IsGrouped = False` are handled normally
@@ -607,7 +406,7 @@ Public Class ImportZUGFeRDFiles
'Next
'--- END Check Property Values
#End Region
' Check the document against the configured property map and return:
' - a List of valid properties
' - a List of missing properties
@@ -666,9 +465,9 @@ Public Class ImportZUGFeRDFiles
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_MD5_ERROR
Dim oBody = EmailStrings.EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException")
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException")
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
Catch ex As InvalidFerdException
_logger.Error(ex)
@@ -676,9 +475,9 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_INVALID_DOCUMENT
Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException")
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException")
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "")
Catch ex As TooMuchFerdsException
_logger.Error(ex)
@@ -686,9 +485,9 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_TOO_MUCH_FERDS
Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException")
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException")
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
Catch ex As NoFerdsException
_logger.Error(ex)
@@ -696,9 +495,9 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_NO_FERDS
Dim oBody = EmailStrings.EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException")
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException")
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
Catch ex As MissingValueException
_logger.Error(ex)
@@ -713,7 +512,7 @@ Public Class ImportZUGFeRDFiles
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException")
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException")
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage)
Catch ex As Exception
@@ -821,11 +620,11 @@ Public Class ImportZUGFeRDFiles
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = String.Format(EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= EMAIL_MISSINGPROPERTIES_2
oBody &= EmailStrings.EMAIL_MISSINGPROPERTIES_2
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties