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

MS StageCommit Version

Browse Source
This commit is contained in:
Developer01 2024-09-23 16:51:20 +02:00
commit 6b92832dce
18 changed files with 27960 additions and 4174 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Interfaces/ZUGFeRDInterface.vb
View File

@ -1,13 +1,8 @@
Imports System.Collections.Generic
Imports System.IO
Imports System.Reflection.Emit
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.Interfaces.ZUGFeRD
Imports DigitalData.Modules.Interfaces.ZUGFeRDInterface
Imports DigitalData.Modules.Logging
Imports GdPicture14
@ -24,6 +19,11 @@ Public Class ZUGFeRDInterface
Public Const ZUGFERD_SPEC_10 = "ZUGFERD_10"
Public Const ZUGFERD_SPEC_2x = "ZUGFERD_2x"
Public Const XMLSCHEMA_ZUGFERD_10 = "Version1_0"
Public Const XMLSCHEMA_ZUGFERD_20 = "Version2_0"
Public Const XMLSCHEMA_ZUGFERD_211 = "Version2_1_1"
Public Const XMLSCHEMA_ZUGFERD_22 = "Version2_2_FacturX"
Private ReadOnly ValidFilenames As New List(Of String) From {
PDFEmbeds.ZUGFERD_XML_FILENAME.ToUpper,
PDFEmbeds.FACTUR_X_XML_FILENAME_DE.ToUpper,
@ -57,6 +57,7 @@ Public Class ZUGFeRDInterface
Public Property XElementObject As XElement
Public Property SchemaObject As Object
Public Property Specification As String
Public Property UsedXMLSchema As String
Public Property ValidationErrors As New List(Of ZugferdValidationError)
End Class
@ -279,6 +280,7 @@ Public Class ZUGFeRDInterface
Private Class AllowedType
Public SchemaType As Type
Public Specification As String
Public XMLSchema As String
End Class
Public Function ValidateZUGFeRDDocument(pResult As ZugferdResult) As ZugferdResult
@ -291,13 +293,15 @@ Public Class ZUGFeRDInterface
Dim oObject As Object = Nothing
Dim oSpecification As String = Nothing
Dim oUsedXMLSchema As String = Nothing
Dim oAllowedTypes As New List(Of AllowedType)
If _Options.AllowZugferd_1_0_Schema Then
oAllowedTypes.Add(New AllowedType With {
.SchemaType = GetType(Version1_0.CrossIndustryDocumentType),
.Specification = ZUGFERD_SPEC_10
.Specification = ZUGFERD_SPEC_10,
.XMLSchema = XMLSCHEMA_ZUGFERD_10
})
End If
@ -305,15 +309,18 @@ Public Class ZUGFeRDInterface
oAllowedTypes.AddRange(New List(Of AllowedType) From {
New AllowedType With {
.SchemaType = GetType(Version2_0.CrossIndustryInvoiceType),
.Specification = ZUGFERD_SPEC_2x
.Specification = ZUGFERD_SPEC_2x,
.XMLSchema = XMLSCHEMA_ZUGFERD_20
},
New AllowedType With {
.SchemaType = GetType(Version2_1_1.CrossIndustryInvoiceType),
.Specification = ZUGFERD_SPEC_2x
.Specification = ZUGFERD_SPEC_2x,
.XMLSchema = XMLSCHEMA_ZUGFERD_211
},
New AllowedType With {
.SchemaType = GetType(Version2_2_FacturX.CrossIndustryInvoiceType),
.Specification = ZUGFERD_SPEC_2x
.Specification = ZUGFERD_SPEC_2x,
.XMLSchema = XMLSCHEMA_ZUGFERD_22
}
})
End If
@ -327,6 +334,7 @@ Public Class ZUGFeRDInterface
oReader = pResult.XElementObject.CreateReader()
oObject = oSerializer.Deserialize(oReader)
oSpecification = oType.Specification
oUsedXMLSchema = oType.XMLSchema
_logger.Debug("Serializing with type [{0}] succeeded", oTypeName)
Exit For
@ -345,6 +353,7 @@ Public Class ZUGFeRDInterface
End If
pResult.Specification = oSpecification
pResult.UsedXMLSchema = oUsedXMLSchema
pResult.SchemaObject = oObject
Return pResult

30
Interfaces/ZUGFeRDInterface/PropertyValues.vb
View File

@ -15,7 +15,7 @@ Public Class PropertyValues
End Sub
Public Class CheckPropertyValuesResult
Public MissingProperties As New List(Of String)
Public MissingProperties As New List(Of MissingProperty)
Public ValidProperties As New List(Of ValidProperty)
End Class
@ -29,6 +29,12 @@ Public Class PropertyValues
Public Description As String
Public Value As String
Public XMLPath As String
End Class
Public Class MissingProperty
Public Description As String
Public XMLPath As String
End Class
Public Function CheckPropertyValues(pDocument As Object, PropertyMap As Dictionary(Of String, XmlItemProperty), MessageId As String) As CheckPropertyValuesResult
@ -98,6 +104,8 @@ Public Class PropertyValues
Dim oTableColumn As String = oColumn.Key.TableColumn
Dim oIsRequired As Boolean = oColumn.Key.IsRequired
Dim oPropertyDescription As String = oColumn.Key.Description
Dim oPropertyPath As String = oColumn.Key.XMLPath
Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1
' Returns nothing if oColumn.Value contains an empty list
@ -110,7 +118,11 @@ Public Class PropertyValues
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired Then
_logger.Warn($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found but is required. Continuing with Empty String.")
oResult.MissingProperties.Add(oPropertyDescription)
Dim oMissingProperty = New MissingProperty() With {
.Description = oPropertyDescription,
.XMLPath = oPropertyPath
}
oResult.MissingProperties.Add(oMissingProperty)
Else
_logger.Debug($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found. Continuing with Empty String.")
End If
@ -127,7 +139,8 @@ Public Class PropertyValues
.GroupCounter = oRowCounter,
.TableName = oTableName,
.TableColumn = oTableColumn,
.IsRequired = oIsRequired
.IsRequired = oIsRequired,
.XMLPath = oPropertyPath
})
Next
Next
@ -140,6 +153,7 @@ Public Class PropertyValues
Dim oPropertyValueList As List(Of Object)
Dim oTableColumn As String = oItem.Value.TableColumn
Dim oPropertyDescription As String = oItem.Value.Description
Dim oPropertyPath As String = oItem.Value.XMLPath
Dim oPropertyValue As Object = Nothing
Dim oTableName = oItem.Value.TableName
Dim oIsRequired = oItem.Value.IsRequired
@ -183,7 +197,12 @@ Public Class PropertyValues
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oItem.Value.IsRequired Then
_logger.Warn("{0} # Specification [{1}] is empty, but marked as required! Skipping.", MessageId, oPropertyDescription)
oResult.MissingProperties.Add(oPropertyDescription)
Dim oMissingProperty = New MissingProperty With
{
.Description = oPropertyDescription,
.XMLPath = oPropertyPath
}
oResult.MissingProperties.Add(oMissingProperty)
Continue For
Else
_logger.Debug("{0} # oPropertyValue for specification [{1}] is empty or not found. Skipping.", MessageId, oPropertyDescription)
@ -198,7 +217,8 @@ Public Class PropertyValues
.Value = oPropertyValue,
.TableName = oTableName,
.TableColumn = oTableColumn,
.IsRequired = oIsRequired
.IsRequired = oIsRequired,
.XMLPath = oPropertyPath
})
Next

10650
Interfaces/ZUGFeRDInterface/Version2.0/CrossIndustryInvoiceType.vb
View File

File diff suppressed because it is too large Load Diff

10033
Interfaces/ZUGFeRDInterface/Version2.1.1/CrossIndustryInvoiceType.vb
View File

File diff suppressed because it is too large Load Diff

11132
Interfaces/ZUGFeRDInterface/Version2.2_FacturX/CrossIndustryInvoiceType.vb
View File

File diff suppressed because it is too large Load Diff

5
Interfaces/ZUGFeRDInterface/XmlItemProperty.vb
View File

@ -11,4 +11,9 @@
''' Document version, eg. ZUGFeRD Schema version
''' </summary>
Public Specification As String
''' <summary>
''' XML Pfad, für Anzeige in Ablehnungsmail
''' </summary>
Public XMLPath As String
End Class

5
Jobs/Exceptions.vb
View File

@ -1,5 +1,6 @@
Imports System.Collections.Generic
Imports System.IO
Imports DigitalData.Modules.Interfaces.PropertyValues
Imports DigitalData.Modules.Interfaces.ZUGFeRDInterface
Public Class Exceptions
@ -7,9 +8,9 @@ Public Class Exceptions
Inherits ApplicationException
Public ReadOnly File As FileInfo
Public ReadOnly MissingProperties As List(Of String)
Public ReadOnly MissingProperties As List(Of MissingProperty)
Public Sub New(pFile As FileInfo, pMissingProperties As List(Of String))
Public Sub New(pFile As FileInfo, pMissingProperties As List(Of MissingProperty))
MyBase.New($"Missing values in [{pFile.Name}]")
Me.File = pFile

6
Jobs/My Project/AssemblyInfo.vb
View File

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

5
Jobs/ZUGFeRD/EmailFunctions.vb
View File

@ -7,6 +7,7 @@ Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Jobs.ImportZUGFeRDFiles
Imports System.Data.SqlClient
Imports FirebirdSql.Data
Imports DigitalData.Modules.Interfaces.PropertyValues
Namespace ZUGFeRD
Public Class EmailFunctions
@ -274,7 +275,7 @@ Namespace ZUGFeRD
Return oRandomValue
End Function
Public Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) As String
Public Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of MissingProperty)) As String
Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
@ -283,7 +284,7 @@ Namespace ZUGFeRD
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties
oBody &= $"- {prop}"
oBody &= $"- {prop.Description}"
Next
End If

16
Jobs/ZUGFeRD/HashFunctions.vb
View File

@ -72,12 +72,7 @@ Public Class HashFunctions
End Try
' Try to get the original filename from Attachment table
' If this fails, falls back to the new filename (<msgid>~Attm<i>.ext)
Dim oSQL = $"SELECT EMAIL_ATTMT FROM TBEMLP_HISTORY_ATTACHMENT WHERE EMAIL_ATTMT_INDEX = '{pFile.Name}'"
Dim oEmailAttachment = Database.GetScalarValue(oSQL, MSSQLServer.TransactionMode.NoTransaction)
Dim oOriginalName = ObjectEx.NotNull(oEmailAttachment, pFile.Name)
Dim oOriginalName As Object = GetOriginalFilename(pFile.Name)
Logger.Info("File with MessageId [{0}] and Filename [{1}] has already been processed.", pMessageId, oOriginalName)
' If the file was already rejected, it is allowed to be processed again,
@ -101,6 +96,15 @@ Public Class HashFunctions
Return oMD5CheckSum
End Function
Public Function GetOriginalFilename(pFilename As String) As String
' Try to get the original filename from Attachment table
' If this fails, falls back to the new filename (<msgid>~Attm<i>.ext)
Dim oSQL = $"SELECT EMAIL_ATTMT FROM TBEMLP_HISTORY_ATTACHMENT WHERE EMAIL_ATTMT_INDEX = '{pFilename}'"
Dim oEmailAttachment = Database.GetScalarValue(oSQL, MSSQLServer.TransactionMode.NoTransaction)
Dim oOriginalName = ObjectEx.NotNull(oEmailAttachment, pFilename)
Return oOriginalName
End Function
Private Function CreateMD5(pFilename As String) As String
Try
Dim oMD5 As New MD5CryptoServiceProvider

8
Jobs/ZUGFeRD/HistoryFunctions.vb
View File

@ -1,8 +1,5 @@
Imports System.Data.SqlClient
Imports System.ServiceModel.Channels
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD
Public Class HistoryFunctions
@ -30,7 +27,8 @@ Namespace ZUGFeRD
MD5HASH = '{pMD5Checksum}'
WHERE EMAIL_MSGID = '{pMessageId}'"
If pMessage.Contains("REJECTED") Then
'If pMessage.Contains("REJECTED") Then
If pMessage.Contains(EmailStrings.ErrorCodePraefix) Then
oSQL = $"UPDATE TBEMLP_HISTORY SET
COMMENT = '{pMessage}',
MD5HASH = '{pMD5Checksum}',

156
Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -1,17 +1,15 @@
Imports System.Collections.Generic
Imports System.Data
Imports System.Data.SqlClient
Imports System.IO
Imports System.Linq
Imports System.Security.Cryptography
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Interfaces.PropertyValues
Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
Imports System.Data.SqlClient
Imports Newtonsoft.Json.Linq
Imports System.Xml.Linq
Public Class ImportZUGFeRDFiles
Implements IJob
@ -85,7 +83,7 @@ Public Class ImportZUGFeRDFiles
Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments
Dim oPropertyExtractor = New PropertyValues(_logConfig)
'Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFEmbeds(_logConfig)
_EmailOutAccountId = oArgs.EmailOutProfileId
@ -219,10 +217,12 @@ Public Class ImportZUGFeRDFiles
Catch ex As ValidationException
_logger.Error(ex)
Dim oErrors = ex.ValidationErrors
Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.ValidationException)
'Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oErrors = ex.ValidationErrors
Dim oErrorList As String = ""
Dim oErrorListDE As String = ""
For Each oError In oErrors
@ -233,107 +233,115 @@ Public Class ImportZUGFeRDFiles
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.ValidationException, oErrorListDE, oErrorList)
AddRejectedState(oMessageId, "ValidationException", "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Die Rechnungsvalidierung ist fehlgeschlagen!", "", oSQLTransaction)
Catch ex As MD5HashException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MD5HashException)
' 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)"
_history.Update_HistoryEntry(oMessageId, String.Empty, oMessage)
' Thats why we set it to String.Empty here.
'Dim oMessage = "REJECTED - Already processed (MD5Hash)"
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oBody = String.Format(EmailStrings.EMAIL_MD5_ERROR, ex.FileName)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MD5HashException, ex.FileName, "")
AddRejectedState(oMessageId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Die gesendete Rechnung wurde bereits verarbeitet!", "", oSQLTransaction)
Catch ex As UnsupportedFerdException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.UnsupportedFerdException)
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format")
' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnsupportedFerdException, ex.XmlFile, "")
AddRejectedState(oMessageId, "UnsupportedFerdException", "Nicht unterstütztes Datenformat", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Nicht unterstütztes Datenformat", "", oSQLTransaction)
Catch ex As InvalidFerdException
_logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.InvalidFerdException)
' When InvalidFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format")
' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.InvalidFerdException, "", "")
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Inkorrektes Format", "", oSQLTransaction)
Catch ex As TooMuchFerdsException
_logger.Error(ex)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email")
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.TooMuchFerdsException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.TooMuchFerdsException, "", "")
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction)
Catch ex As NoFerdsException
_logger.Error(ex)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email")
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.NoFerdsException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.NoFerdsException, "", "")
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction)
AddRejectedState(oMessageId, oRejectionCodeString, "Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction)
Catch ex As MissingValueException
_logger.Error(ex)
Dim oMessage As String = ""
For Each prop In ex.MissingProperties
oMessage &= $"- {prop}"
Next
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MissingValueException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]")
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oMissingFieldList As String = ""
For Each oMissingFieldDescription In ex.MissingProperties
oMissingFieldList += $"<li>{oMissingFieldDescription}</li>"
oMissingFieldList += $"<li>{oMissingFieldDescription.Description}<br/><em>{oMissingFieldDescription.XMLPath}</em></li>"
Next
Dim oOrgFilename = _hash.GetOriginalFilename(ex.File.Name)
Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, ex.MissingProperties)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MissingValueException, ex.File.Name, oMissingFieldList)
AddRejectedState(oMessageId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage, oSQLTransaction)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MissingValueException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MissingValueException, oOrgFilename, oMissingFieldList)
AddRejectedState(oMessageId, oRejectionCodeString, "Es fehlten ZugferdSpezifikationen", "", oSQLTransaction)
Catch ex As FileSizeLimitReachedException
_logger.Error(ex)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - File size limit reached")
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.FileSizeLimitReachedException)
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oEmailData = _file.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 oOrgFilename = _hash.GetOriginalFilename(oFileExceedingThreshold)
Dim oBody = String.Format(EmailStrings.EMAIL_FILE_SIZE_REACHED, oArgs.MaxAttachmentSizeInMegaBytes, oFileWithoutMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.FileSizeLimitReachedException, oArgs.MaxAttachmentSizeInMegaBytes, oFileWithoutMessageId)
AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
Dim oBody = String.Format(EmailStrings.EMAIL_FILE_SIZE_REACHED, oArgs.MaxAttachmentSizeInMegaBytes, oOrgFilename)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "FileSizeLimitReachedException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.FileSizeLimitReachedException, oArgs.MaxAttachmentSizeInMegaBytes, oOrgFilename)
AddRejectedState(oMessageId, oRejectionCodeString, "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*
@ -363,21 +371,22 @@ Public Class ImportZUGFeRDFiles
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
' Send Email to Digital Data
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "UnhandledException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnhandledException, ex.Message, ex.StackTrace)
' Rollback Transaction
oSQLTransaction.Rollback()
oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False
If oSQLConnection IsNot Nothing And oSQLTransaction IsNot Nothing Then
' Send Email to Digital Data
Dim oBody = _email.CreateBodyForUnhandledException(oMessageId, ex)
Dim oEmailData As New EmailData With {
.From = oArgs.ExceptionEmailAddress,
.Subject = $"UnhandledException im ZUGFeRD-Parser @ {oMessageId}"
}
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "UnhandledException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.UnhandledException, ex.Message, ex.StackTrace)
' Rollback Transaction
oSQLTransaction.Rollback()
End If
Finally
Try
' If an application error occurred, dont move files so they will be processed again later
@ -407,8 +416,10 @@ Public Class ImportZUGFeRDFiles
' finally commit all changes To the Database
' ==================================================================
If oIsSuccess Or oExpectedError Then
' Commit Transaction
oSQLTransaction.Commit()
If oSQLTransaction IsNot Nothing Then
' Commit Transaction
oSQLTransaction.Commit()
End If
End If
Catch ex As Exception
_logger.Error(ex)
@ -416,7 +427,9 @@ Public Class ImportZUGFeRDFiles
End Try
Try
oSQLConnection.Close()
If oSQLConnection IsNot Nothing Then
oSQLConnection.Close()
End If
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("Database Connections were not closed successfully.")
@ -432,10 +445,21 @@ Public Class ImportZUGFeRDFiles
End Try
End Sub
Private Function GetRejectionCodeString(pMessageId As String, pRejectionCode As ErrorCode) As String
Dim intCode As Integer = DirectCast(pRejectionCode, Integer)
Dim oRejectionCodeString = $"{EmailStrings.ErrorCodePraefix}{intCode}"
' Wir wollen im error-Log den Code und die MessageID haben, um die es geht
Dim oInfoMessage = $"Rejection {oRejectionCodeString} triggered for '{pMessageId}'"
_logger.Error(oInfoMessage)
Return oRejectionCodeString
End Function
Private Function ProcessFile(pMessageId As String, pEmailData As EmailData, pZugferdFiles As Integer, oFile As FileInfo, oConnections As DatabaseConnections, pArgs As WorkerArgs) As ProcessFileResult
Dim oDocument As ZUGFeRDInterface.ZugferdResult
Dim oResult As New ProcessFileResult()
Dim oMissingProperties As New List(Of String)
' Only pdf files are allowed from here on
If Not oFile.Name.ToUpper.EndsWith(".PDF") Then
@ -520,7 +544,6 @@ Public Class ImportZUGFeRDFiles
If oCheckResult.MissingProperties.Count > 0 Then
_logger.Warn("[{0}] missing properties found. Exiting.", oCheckResult.MissingProperties.Count)
oMissingProperties = oCheckResult.MissingProperties
Throw New MissingValueException(oFile, oCheckResult.MissingProperties)
Else
_logger.Debug("No missing properties found. Continuing.")
@ -548,7 +571,7 @@ Public Class ImportZUGFeRDFiles
'Next
' DataTable vorbereiten
Dim oDataTable As DataTable = FillDataTable(pMessageId, oCheckResult, oDocument.Specification)
Dim oDataTable As DataTable = FillDataTable(pMessageId, oCheckResult, oDocument.Specification, oDocument.UsedXMLSchema)
' ColumnList initialisieren
Dim oColumnNames As List(Of String) = New List(Of String) From {
@ -578,7 +601,7 @@ Public Class ImportZUGFeRDFiles
End Function
Private Function FillDataTable(pMessageId As String, pCheckResult As PropertyValues.CheckPropertyValuesResult, pSpecification As String) As DataTable
Private Function FillDataTable(pMessageId As String, pCheckResult As PropertyValues.CheckPropertyValuesResult, pSpecification As String, pUsedXMLSchema As String) As DataTable
Dim oDataTable As DataTable = New DataTable()
oDataTable.Columns.Add(New DataColumn("REFERENCE_GUID", GetType(String)))
@ -600,6 +623,17 @@ Public Class ImportZUGFeRDFiles
_logger.Debug("Mapping Property [ZUGFERD_SPECIFICATION] with value [{0}]", pSpecification)
oDataTable.Rows.Add(oFirstRow)
' Zweite Zeile enthält das verwendete XML Schema
Dim oSecondRow As DataRow = oDataTable.NewRow()
oSecondRow("REFERENCE_GUID") = pMessageId
oSecondRow("ITEM_DESCRIPTION") = "ZUGFeRDXMLSchema"
oSecondRow("ITEM_VALUE") = pUsedXMLSchema
oSecondRow("GROUP_COUNTER") = 0
oSecondRow("SPEC_NAME") = "ZUGFERD_XML_SCHEMA"
oSecondRow("IS_REQUIRED") = False
_logger.Debug("Mapping Property [ZUGFERD_XML_SCHEMA] with value [{0}]", pUsedXMLSchema)
oDataTable.Rows.Add(oSecondRow)
For Each oProperty In pCheckResult.ValidProperties
@ -610,10 +644,14 @@ Public Class ImportZUGFeRDFiles
oGroupCounterValue = 0
End If
If oProperty.Value.Length > 900 Then
_logger.Warn("Value for field [{0}] is longer than 900 characters, will be truncated!", oProperty.TableColumn)
End If
Dim oNewRow As DataRow = oDataTable.NewRow()
oNewRow("REFERENCE_GUID") = pMessageId
oNewRow("ITEM_DESCRIPTION") = oProperty.Description
oNewRow("ITEM_VALUE") = oProperty.Value.Replace("'", "''")
oNewRow("ITEM_VALUE") = oProperty.Value.Truncate(900).Replace("'", "''")
oNewRow("GROUP_COUNTER") = oGroupCounterValue
oNewRow("SPEC_NAME") = oProperty.TableColumn
oNewRow("IS_REQUIRED") = oProperty.IsRequired

3
Logging/LogConfig.vb
View File

@ -87,7 +87,8 @@ Public Class LogConfig
Private Const LOG_FORMAT_BASE As String = "${time}|${logger:shortName=True}|${level:uppercase=true}"
Private Const LOG_FORMAT_CALLSITE As String = "${callsite:className=false:fileName=true:includeSourcePath=false:methodName=true}"
Private Const LOG_FORMAT_EXCEPTION As String = "${exception:format=Message,StackTrace:innerFormat=Message,StackTrace:maxInnerExceptionLevel=3}"
'Private Const LOG_FORMAT_EXCEPTION As String = "${exception:format=Message,StackTrace:innerFormat=Message,StackTrace:maxInnerExceptionLevel=3}"
Private Const LOG_FORMAT_EXCEPTION As String = "${message}${onexception:${newline}${exception:format=Message,StackTrace:innerFormat=Message,StackTrace:maxInnerExceptionLevel=3}}"
Private Const LOG_FORMAT_DEFAULT As String = LOG_FORMAT_BASE & " >> ${message}"
Private Const LOG_FORMAT_ERROR As String = LOG_FORMAT_BASE & " >> " & LOG_FORMAT_EXCEPTION

8
Logging/My Project/AssemblyInfo.vb
View File

@ -12,8 +12,8 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Logging")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyTrademark("2.6.3.0")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("2.6.4.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.6.3.0")>
<Assembly: AssemblyFileVersion("2.6.3.0")>
<Assembly: AssemblyVersion("2.6.4.0")>
<Assembly: AssemblyFileVersion("2.6.4.0")>

4
Messaging/Limilab.vb
View File

@ -65,9 +65,9 @@ Public Class Limilab
End Function
Private Function LOG_Limilab(Log_enabled As Boolean) As Boolean
Private Sub LOG_Limilab(Log_enabled As Boolean)
Log.Enabled = Log_enabled
End Function
End Sub
''' <summary>
''' Tests connection to a given IMAP Server by connecting and doing a simple message query.

22
Messaging/Mail/MailSender.vb
View File

@ -40,8 +40,15 @@ Namespace Mail
Try
Dim oSuccessfulSends As New List(Of String)
Dim oFailedSends As New List(Of String)
Dim oResult As Boolean
For Each oSendToAddress In pSendTo
Dim oResult = SendMailTo(oSendToAddress, pSendFrom, pSubject, pBody, pCreationTime, pAttachments, pTest)
If IsValidEmailAddress(oSendToAddress) Then
oResult = SendMailTo(oSendToAddress, pSendFrom, pSubject, pBody, pCreationTime, pAttachments, pTest)
Else
Logger.Warn("EMail adress [{0}] is NOT valid!", oSendToAddress)
oResult = False
End If
If oResult = True Then
oSuccessfulSends.Add(oSendToAddress & "|" & pSubject)
@ -143,6 +150,19 @@ Namespace Mail
Return pMailBuilder
End Function
Private Function IsValidEmailAddress(pEmailAddress As String) As Boolean
Try
If pEmailAddress.Contains("@") Then
Dim oAddress = New System.Net.Mail.MailAddress(pEmailAddress)
Return oAddress.Address = pEmailAddress
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
End Class
End Namespace

14
Messaging/Mail/MailSession.vb
View File

@ -150,7 +150,7 @@ Namespace Mail
If TypeOf Client Is Imap Then
Dim oClient As Imap = Client
Logger.Debug("Connecting with [ConnectSSL] on [{0}]", pSession.Server)
Logger.Debug("Connecting with [OAuth2/ConnectSSL] on [{0}]", pSession.Server)
oClient.ConnectSSL(pSession.Server)
Else
Throw New ApplicationException("Only OAuth2 for IMAP is not yet supported!")
@ -166,11 +166,13 @@ Namespace Mail
ElseIf pSession.AuthType = AUTH_SSL Then
Try
If pSession.Port = 993 Then
Logger.Debug("Connecting with [ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
' Port 465 ist der SMTP-SSL-Port, wird bei der WISAG verwendet, aber veraltet
' Port 993 ist der IMAP-SSL-Port, zum Abholen der Mails
If pSession.Port = 465 Or pSession.Port = 993 Then
Logger.Debug("Connecting with [SSL/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.ConnectSSL(pSession.Server, pSession.Port)
Else
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Logger.Debug("Connecting with [SSL/Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
End If
Logger.Info("Connection Successful!")
@ -188,10 +190,10 @@ Namespace Mail
Try
If pSession.Port = 993 Then
Logger.Debug("Connecting with [ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Logger.Debug("Connecting with [STARTTLS/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.ConnectSSL(pSession.Server, pSession.Port)
Else
Logger.Debug("Connecting with [Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Logger.Debug("Connecting with [STARTTLS/Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
End If
Logger.Info("Connection Successful!")

8
Messaging/My Project/AssemblyInfo.vb
View File

@ -12,8 +12,8 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Messaging")>
<Assembly: AssemblyCopyright("Copyright © 2023")>
<Assembly: AssemblyTrademark("1.9.2.0")>
<Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("1.9.6.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.9.4.0")>
<Assembly: AssemblyFileVersion("1.9.4.0")>
<Assembly: AssemblyVersion("1.9.6.0")>
<Assembly: AssemblyFileVersion("1.9.6.0")>