AppStd/Monorepo
8
1
Fork 0
Code Issues Pull Requests 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
GUIs.Test.ZUGFeRDTest/Form1.vb
View File

@ -25,7 +25,7 @@ Public Class Form1
_firebird = New Firebird(_logConfig, My.Settings.FB_DATASOURCE, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PASS)
_mssql = New MSSQLServer(_logConfig, My.Settings.MSSQL_CONNECTIONSTRING)
_zugferd = New ZUGFeRDInterface(_logConfig)
_zugferd = New ZUGFeRDInterface(_logConfig, "")
End Sub
Private Function LoadFolderConfig(args As WorkerArgs)
@ -164,7 +164,7 @@ Public Class Form1
End Sub
Private Sub Button7_Click(sender As Object, e As EventArgs) Handles Button7.Click
Dim oExtractor = New Jobs.PDFAttachments(_logConfig)
Dim oExtractor = New PDFAttachments(_logConfig)
Dim oResult = OpenFileDialog1.ShowDialog()
If oResult = DialogResult.OK Then

72
Modules.Interfaces/ZUGFeRDInterface.vb
View File

@ -1,9 +1,11 @@
Imports System.Xml
Imports System.IO
Imports System.Xml
Imports System.Xml.Serialization
Imports System.Xml.XPath
Imports System.Xml.Xsl
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Logging
Imports GdPicture14
Public Class ZUGFeRDInterface
Private _logConfig As LogConfig
@ -21,13 +23,23 @@ Public Class ZUGFeRDInterface
Public ReadOnly Property FileGroup As FileGroups
Public ReadOnly Property PropertyValues As PropertyValues
Public Sub New(LogConfig As LogConfig)
Public Sub New(LogConfig As LogConfig, GDPictureKey As String)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
FileGroup = New FileGroups(_logConfig)
PropertyValues = New PropertyValues(_logConfig)
Try
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(GDPictureKey)
Catch ex As Exception
_logger.Warn("GDPicture License could not be registered!")
_logger.Error(ex)
End Try
End Sub
''' <summary>
''' Validates a ZUGFeRD File and extracts the XML Document from it
''' </summary>
@ -35,7 +47,6 @@ Public Class ZUGFeRDInterface
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns></returns>
Public Function ExtractZUGFeRDFile(Path As String) As CrossIndustryDocumentType
Dim oException As New Exception
Dim oXmlDocument = ValidateZUGFeRDFile(Path)
If IsNothing(oXmlDocument) Then
@ -45,6 +56,15 @@ Public Class ZUGFeRDInterface
Return SerializeZUGFeRDDocument(oXmlDocument)
End Function
Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As CrossIndustryDocumentType
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path)
If IsNothing(oXmlDocument) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
Return SerializeZUGFeRDDocument(oXmlDocument)
End Function
Public Function ValidateZUGFeRDFile(Path As String) As XPathDocument
Dim oProcessOutput, oProcessError As String
@ -90,6 +110,52 @@ Public Class ZUGFeRDInterface
Return oXmlDocument
End Function
Public Function ValidateZUGFeRDFileWithGDPicture(Path As String) As XPathDocument
Dim oAttachmentExtractor = New PDFAttachments(_logConfig)
Dim oAllowedExtensions = New List(Of String) From {"xml"}
Dim oXmlDocument As XPathDocument
Try
Dim oResults = oAttachmentExtractor.Extract(Path, oAllowedExtensions)
If oResults Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
If oResults.Count = 0 Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
Dim oFound As Boolean = False
Dim oFoundResult As PDFAttachments.AttachmentResult = Nothing
For Each oResult In oResults
If oResult.FileName = PDFAttachments.ZUGFERD_XML_FILENAME Then
oFound = True
oFoundResult = oResult
End If
Next
If Not oFound Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If
Try
Using oStream As New MemoryStream(oFoundResult.FileContents)
oXmlDocument = New XPathDocument(oStream)
End Using
Return oXmlDocument
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
Catch ex As Exception
_logger.Error(ex)
Throw ex
End Try
End Function
Public Function SerializeZUGFeRDDocument(Document As XPathDocument) As CrossIndustryDocumentType
Try
Dim oNavigator As XPathNavigator = Document.CreateNavigator()

67
Modules.Interfaces/ZUGFeRDInterface/PDFAttachments.vb
View File

@ -4,9 +4,9 @@ Imports DigitalData.Modules.Logging
Imports GdPicture14
Public Class PDFAttachments
Private Logger As Logger
Private ReadOnly Logger As Logger
Private Const ZUGFERD_XML_FILENAME = "ZUGFeRD-invoice.xml"
Public Const ZUGFERD_XML_FILENAME = "ZUGFeRD-invoice.xml"
Public Class AttachmentResult
Public FileName As String
@ -17,61 +17,50 @@ Public Class PDFAttachments
Logger = LogConfig.GetLogger
End Sub
''' <summary>
''' Extracts all embedded files from a PDF file.
''' Note: This does NOT filter out `ZUGFeRD-invoice.xml` anymore to allow for a more generic use.
''' </summary>
''' <param name="FileName"></param>
''' <param name="AllowedExtensions"></param>
''' <returns></returns>
Public Function Extract(FileName As String, AllowedExtensions As List(Of String)) As List(Of AttachmentResult)
Dim oResults As New List(Of AttachmentResult)
Dim oExtensions = AllowedExtensions.ConvertAll(Of String)(New Converter(Of String, String)(Function(ext) ext.ToUpper))
Dim oExtensions = AllowedExtensions.ConvertAll(New Converter(Of String, String)(Function(ext) ext.ToUpper))
Try
Using oGDPicturePDF As New GdPicturePDF()
If oGDPicturePDF.LoadFromFile(FileName, False) = GdPictureStatus.OK Then
Dim oEmbeddedFileCount As Integer = oGDPicturePDF.GetEmbeddedFileCount()
If oGDPicturePDF.GetStat() = GdPictureStatus.OK Then
If oEmbeddedFileCount > 1 Then
If oEmbeddedFileCount > 0 Then
For index = 0 To oEmbeddedFileCount - 1
Dim oFileName As String = oGDPicturePDF.GetEmbeddedFileName(index)
If oGDPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim oExtension = New FileInfo(oFileName).Extension.ToUpper.Substring(1)
If oFileName.ToUpper <> ZUGFERD_XML_FILENAME.ToUpper Then
If oExtensions.Contains(oExtension) Then
Dim FileSize As Integer = oGDPicturePDF.GetEmbeddedFileSize(index)
If oExtensions.Contains(oExtension) Then
Dim FileSize As Integer = oGDPicturePDF.GetEmbeddedFileSize(index)
If oGDPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim oFileData As Byte() = New Byte(FileSize) {}
Dim status As GdPictureStatus = oGDPicturePDF.ExtractEmbeddedFile(index, oFileData)
If oGDPicturePDF.GetStat() = GdPictureStatus.OK Then
Dim oFileData As Byte() = New Byte(FileSize) {}
Dim status As GdPictureStatus = oGDPicturePDF.ExtractEmbeddedFile(index, oFileData)
If status = GdPictureStatus.OK Then
oResults.Add(New AttachmentResult() With {
.FileContents = oFileData,
.FileName = oFileName
})
Else
Logger.Error("The embedded file [{0}] has failed to extract. Status: {1}", oFileName, oGDPicturePDF.GetStat().ToString())
Continue For
End If
'If status = GdPictureStatus.OK Then
' Dim oVersionedName = Filesystem.GetVersionedFilename(oFileName)
' Dim oTempName As String = Path.Combine(Path.GetTempPath(), oVersionedName)
' Using oFileStream As New FileStream(oTempName, FileMode.OpenOrCreate)
' oFileStream.Write(oFileData, 0, oFileData.Length)
' End Using
' oResults.Add(New FileInfo(oTempName))
'Else
' Logger.Error("The embedded file [{0}] has failed to extract. Status: {1}", oFileName, oGDPicturePDF.GetStat().ToString())
' Continue For
'End If
If status = GdPictureStatus.OK Then
oResults.Add(New AttachmentResult() With {
.FileContents = oFileData,
.FileName = oFileName
})
Else
Logger.Error("An error occurred getting the file size for [{0}]. Status: {1}", oFileName, oGDPicturePDF.GetStat().ToString())
Logger.Error("The embedded file [{0}] has failed to extract. Status: {1}", oFileName, oGDPicturePDF.GetStat().ToString())
Continue For
End If
Else
Logger.Warn("File [{0}] was skipped because its extension [{1}] is not allowed.", oFileName, oExtension)
Logger.Error("An error occurred getting the file size for [{0}]. Status: {1}", oFileName, oGDPicturePDF.GetStat().ToString())
Continue For
End If
Else
Logger.Debug("File [{0}] was skipped because its name indicates the invoice data file.", oFileName)
Logger.Warn("File [{0}] was skipped because its extension [{1}] is not allowed.", oFileName, oExtension)
Continue For
End If
Else
@ -81,12 +70,12 @@ Public Class PDFAttachments
Next
End If
Else
Logger.Error("An error occurred getting the number of embedded files. Status: {0}", oGDPicturePDF.GetStat().ToString())
Return Nothing
Dim oMessage = String.Format("An error occurred getting the number of embedded files. Status: {0}", oGDPicturePDF.GetStat().ToString())
Throw New ApplicationException(oMessage)
End If
Else
Logger.Error("The file [{0}] can't be loaded.", FileName)
Return Nothing
Dim oMessage = String.Format("The file [{0}] can't be loaded. Status: [{1}]", FileName, oGDPicturePDF.GetStat().ToString())
Throw New ApplicationException(oMessage)
End If
End Using

4
Modules.Interfaces/ZUGFeRDInterface/PropertyValues.vb
View File

@ -16,7 +16,7 @@ Public Class PropertyValues
Public Class CheckPropertyValuesResult
Public MissingProperties As New List(Of String)
Public ValidProperties As List(Of ValidProperty)
Public ValidProperties As New List(Of ValidProperty)
End Class
Public Class ValidProperty
@ -36,7 +36,7 @@ Public Class PropertyValues
' PropertyMap items with `IsGrouped = False` are handled normally
Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = PropertyMap.
Where(Function(Item) Item.Value.IsGrouped = True).
Where(Function(Item) Item.Value.IsGrouped = False).
ToDictionary(Function(Item) Item.Key,
Function(Item) Item.Value)

197
Modules.Jobs/EDMI/ZUGFeRD/EmailFunctions.vb Normal file
View File

@ -0,0 +1,197 @@
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database
Imports System.Data
Imports System.IO
Public Class EmailFunctions
Private ReadOnly _logConfig As LogConfig
Private ReadOnly _logger As Logger
Private ReadOnly _mssql As MSSQLServer
Private ReadOnly _firebird As Firebird
Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer, Firebird As Firebird)
_logConfig = LogConfig
_logger = _logConfig.GetLogger()
_mssql = MSSQL
_firebird = Firebird
End Sub
Public 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 = EmailStrings.EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EmailStrings.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
Public 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 = EmailStrings.EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EmailStrings.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
End Sub
Public 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
Public 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
Public 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 RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
End Class

18
Modules.Jobs/EDMI/ZUGFeRD/EmailStrings.vb Normal file
View File

@ -0,0 +1,18 @@
Public Class EmailStrings
Public 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>"
Public Const EMAIL_SUBJECT = "WISAG ZUGFeRD Portal: Beleg abgelehnt"
Public Const EMAIL_MISSINGPROPERTIES_1 = "<p>Die angehängte Datei entspricht nicht dem WISAG ZUGFeRD-Format: {0}</p>"
Public Const EMAIL_MISSINGPROPERTIES_2 = "<p>Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:<p/>"
Public Const EMAIL_MD5_ERROR = "<p>Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.</p>"
Public Const EMAIL_TOO_MUCH_FERDS = "<p>Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
Public Const EMAIL_NO_FERDS = "<p>Ihre Email enthielt keine ZUGFeRD-Dokumente.</p>"
Public 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>
"""
End Class

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

2
Modules.Jobs/Jobs.vbproj
View File

@ -87,6 +87,8 @@
<Compile Include="EDMI\GraphQL\GraphQLArgs.vb" />
<Compile Include="EDMI\GraphQL\GraphQLJob.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailData.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailFunctions.vb" />
<Compile Include="EDMI\ZUGFeRD\EmailStrings.vb" />
<Compile Include="EDMI\ZUGFeRD\ImportZUGFeRDFiles.vb" />
<Compile Include="EDMI\ZUGFeRD\WorkerArgs.vb" />
<Compile Include="Exceptions.vb" />