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

30
Interfaces/ZUGFeRDInterface/PropertyValues.vb
View File

@ -15,7 +15,7 @@ Public Class PropertyValues
End Sub End Sub
Public Class CheckPropertyValuesResult Public Class CheckPropertyValuesResult
Public MissingProperties As New List(Of String) Public MissingProperties As New List(Of MissingProperty)
Public ValidProperties As New List(Of ValidProperty) Public ValidProperties As New List(Of ValidProperty)
End Class End Class
@ -29,6 +29,12 @@ Public Class PropertyValues
Public Description As String Public Description As String
Public Value 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 End Class
Public Function CheckPropertyValues(pDocument As Object, PropertyMap As Dictionary(Of String, XmlItemProperty), MessageId As String) As CheckPropertyValuesResult 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 oTableColumn As String = oColumn.Key.TableColumn
Dim oIsRequired As Boolean = oColumn.Key.IsRequired Dim oIsRequired As Boolean = oColumn.Key.IsRequired
Dim oPropertyDescription As String = oColumn.Key.Description Dim oPropertyDescription As String = oColumn.Key.Description
Dim oPropertyPath As String = oColumn.Key.XMLPath
Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1 Dim oRowCounter = oRowIndex + oGlobalGroupCounter + 1
' Returns nothing if oColumn.Value contains an empty list ' 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 IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired 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.") _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 Else
_logger.Debug($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found. Continuing with Empty String.") _logger.Debug($"{MessageId} # oPropertyValue for specification [{oTableColumn}] is empty or not found. Continuing with Empty String.")
End If End If
@ -127,7 +139,8 @@ Public Class PropertyValues
.GroupCounter = oRowCounter, .GroupCounter = oRowCounter,
.TableName = oTableName, .TableName = oTableName,
.TableColumn = oTableColumn, .TableColumn = oTableColumn,
.IsRequired = oIsRequired .IsRequired = oIsRequired,
.XMLPath = oPropertyPath
}) })
Next Next
Next Next
@ -140,6 +153,7 @@ Public Class PropertyValues
Dim oPropertyValueList As List(Of Object) Dim oPropertyValueList As List(Of Object)
Dim oTableColumn As String = oItem.Value.TableColumn Dim oTableColumn As String = oItem.Value.TableColumn
Dim oPropertyDescription As String = oItem.Value.Description Dim oPropertyDescription As String = oItem.Value.Description
Dim oPropertyPath As String = oItem.Value.XMLPath
Dim oPropertyValue As Object = Nothing Dim oPropertyValue As Object = Nothing
Dim oTableName = oItem.Value.TableName Dim oTableName = oItem.Value.TableName
Dim oIsRequired = oItem.Value.IsRequired Dim oIsRequired = oItem.Value.IsRequired
@ -183,7 +197,12 @@ Public Class PropertyValues
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oItem.Value.IsRequired Then If oItem.Value.IsRequired Then
_logger.Warn("{0} # Specification [{1}] is empty, but marked as required! Skipping.", MessageId, oPropertyDescription) _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 Continue For
Else Else
_logger.Debug("{0} # oPropertyValue for specification [{1}] is empty or not found. Skipping.", MessageId, oPropertyDescription) _logger.Debug("{0} # oPropertyValue for specification [{1}] is empty or not found. Skipping.", MessageId, oPropertyDescription)
@ -198,7 +217,8 @@ Public Class PropertyValues
.Value = oPropertyValue, .Value = oPropertyValue,
.TableName = oTableName, .TableName = oTableName,
.TableColumn = oTableColumn, .TableColumn = oTableColumn,
.IsRequired = oIsRequired .IsRequired = oIsRequired,
.XMLPath = oPropertyPath
}) })
Next 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 ''' Document version, eg. ZUGFeRD Schema version
''' </summary> ''' </summary>
Public Specification As String Public Specification As String
''' <summary>
''' XML Pfad, für Anzeige in Ablehnungsmail
''' </summary>
Public XMLPath As String
End Class End Class

5
Jobs/Exceptions.vb
View File

@ -1,5 +1,6 @@
Imports System.Collections.Generic Imports System.Collections.Generic
Imports System.IO Imports System.IO
Imports DigitalData.Modules.Interfaces.PropertyValues
Imports DigitalData.Modules.Interfaces.ZUGFeRDInterface Imports DigitalData.Modules.Interfaces.ZUGFeRDInterface
Public Class Exceptions Public Class Exceptions
@ -7,9 +8,9 @@ Public Class Exceptions
Inherits ApplicationException Inherits ApplicationException
Public ReadOnly File As FileInfo 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}]") MyBase.New($"Missing values in [{pFile.Name}]")
Me.File = pFile Me.File = pFile

6
Jobs/My Project/AssemblyInfo.vb
View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")> <Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")> <Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2024")> <Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("2.5.8.0")> <Assembly: AssemblyTrademark("2.6.2.0")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@ -30,5 +30,5 @@ Imports System.Runtime.InteropServices
' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern ' Sie können alle Werte angeben oder die standardmäßigen Build- und Revisionsnummern
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
<Assembly: AssemblyVersion("2.5.9.0")> <Assembly: AssemblyVersion("2.6.2.0")>
<Assembly: AssemblyFileVersion("2.5.9.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 DigitalData.Modules.Jobs.ImportZUGFeRDFiles
Imports System.Data.SqlClient Imports System.Data.SqlClient
Imports FirebirdSql.Data Imports FirebirdSql.Data
Imports DigitalData.Modules.Interfaces.PropertyValues
Namespace ZUGFeRD Namespace ZUGFeRD
Public Class EmailFunctions Public Class EmailFunctions
@ -274,7 +275,7 @@ Namespace ZUGFeRD
Return oRandomValue Return oRandomValue
End Function 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) Dim oBody = String.Format(EmailStrings.EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then If MissingProperties.Count > 0 Then
@ -283,7 +284,7 @@ Namespace ZUGFeRD
oBody &= $"{vbNewLine}{vbNewLine}" oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties For Each prop In MissingProperties
oBody &= $"- {prop}" oBody &= $"- {prop.Description}"
Next Next
End If End If

16
Jobs/ZUGFeRD/HashFunctions.vb
View File

@ -72,12 +72,7 @@ Public Class HashFunctions
End Try End Try
' Try to get the original filename from Attachment table Dim oOriginalName As Object = GetOriginalFilename(pFile.Name)
' 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)
Logger.Info("File with MessageId [{0}] and Filename [{1}] has already been processed.", pMessageId, oOriginalName) 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, ' If the file was already rejected, it is allowed to be processed again,
@ -101,6 +96,15 @@ Public Class HashFunctions
Return oMD5CheckSum Return oMD5CheckSum
End Function 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 Private Function CreateMD5(pFilename As String) As String
Try Try
Dim oMD5 As New MD5CryptoServiceProvider Dim oMD5 As New MD5CryptoServiceProvider

8
Jobs/ZUGFeRD/HistoryFunctions.vb
View File

@ -1,8 +1,5 @@
Imports System.Data.SqlClient Imports DigitalData.Modules.Database
Imports System.ServiceModel.Channels
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports Microsoft.VisualBasic.FileIO
Namespace ZUGFeRD Namespace ZUGFeRD
Public Class HistoryFunctions Public Class HistoryFunctions
@ -30,7 +27,8 @@ Namespace ZUGFeRD
MD5HASH = '{pMD5Checksum}' MD5HASH = '{pMD5Checksum}'
WHERE EMAIL_MSGID = '{pMessageId}'" 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 oSQL = $"UPDATE TBEMLP_HISTORY SET
COMMENT = '{pMessage}', COMMENT = '{pMessage}',
MD5HASH = '{pMD5Checksum}', MD5HASH = '{pMD5Checksum}',

156
Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb
View File

@ -1,17 +1,15 @@
Imports System.Collections.Generic Imports System.Collections.Generic
Imports System.Data Imports System.Data
Imports System.Data.SqlClient
Imports System.IO Imports System.IO
Imports System.Linq Imports System.Linq
Imports System.Security.Cryptography
Imports DigitalData.Modules.Base Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Interfaces.PropertyValues
Imports DigitalData.Modules.Jobs.Exceptions Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports System.Data.SqlClient
Imports Newtonsoft.Json.Linq
Imports System.Xml.Linq
Public Class ImportZUGFeRDFiles Public Class ImportZUGFeRDFiles
Implements IJob Implements IJob
@ -85,7 +83,7 @@ Public Class ImportZUGFeRDFiles
Public Sub Start(Arguments As Object) Implements IJob.Start Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments Dim oArgs As WorkerArgs = Arguments
Dim oPropertyExtractor = New PropertyValues(_logConfig) 'Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFEmbeds(_logConfig) Dim oAttachmentExtractor = New PDFEmbeds(_logConfig)
_EmailOutAccountId = oArgs.EmailOutProfileId _EmailOutAccountId = oArgs.EmailOutProfileId
@ -219,10 +217,12 @@ Public Class ImportZUGFeRDFiles
Catch ex As ValidationException Catch ex As ValidationException
_logger.Error(ex) _logger.Error(ex)
Dim oErrors = ex.ValidationErrors Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.ValidationException)
Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oMessage)
'Dim oMessage = "REJECTED - ZUGFeRD yes but formal validation failed!"
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oErrors = ex.ValidationErrors
Dim oErrorList As String = "" Dim oErrorList As String = ""
Dim oErrorListDE As String = "" Dim oErrorListDE As String = ""
For Each oError In oErrors For Each oError In oErrors
@ -233,107 +233,115 @@ Public Class ImportZUGFeRDFiles
Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList) Dim oBody = String.Format(EmailStrings.EMAIL_VALIDATION_ERROR, oErrorList)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "ValidationException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.ValidationException, oErrorListDE, oErrorList) _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 Catch ex As MD5HashException
_logger.Error(ex) _logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MD5HashException)
' When MD5HashException is thrown, we don't have a MD5Hash yet. ' When MD5HashException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' Thats why we set it to String.Empty here.
Dim oMessage = "REJECTED - Already processed (MD5Hash)" 'Dim oMessage = "REJECTED - Already processed (MD5Hash)"
_history.Update_HistoryEntry(oMessageId, String.Empty, oMessage) _history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oBody = String.Format(EmailStrings.EMAIL_MD5_ERROR, ex.FileName) Dim oBody = String.Format(EmailStrings.EMAIL_MD5_ERROR, ex.FileName)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "MD5HashException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.MD5HashException, ex.FileName, "") _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 Catch ex As UnsupportedFerdException
_logger.Error(ex) _logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.UnsupportedFerdException)
' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet. ' When UnsupportedFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format") _history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile) 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, "") _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 Catch ex As InvalidFerdException
_logger.Error(ex) _logger.Error(ex)
Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.InvalidFerdException)
' When InvalidFerdException is thrown, we don't have a MD5Hash yet. ' When InvalidFerdException is thrown, we don't have a MD5Hash yet.
' That 's why we set it to String.Empty here. ' Thats why we set it to String.Empty here.
_history.Update_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format") _history.Update_HistoryEntry(oMessageId, String.Empty, oRejectionCodeString)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject) Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.InvalidFerdException, "", "") _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 Catch ex As TooMuchFerdsException
_logger.Error(ex) _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 oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject) 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, "", "") _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 Catch ex As NoFerdsException
_logger.Error(ex) _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 oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject) Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oSQLTransaction, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal, oArgs.RejectionTemplateId, ErrorCode.NoFerdsException, "", "") _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 Catch ex As MissingValueException
_logger.Error(ex) _logger.Error(ex)
Dim oMessage As String = "" Dim oRejectionCodeString = GetRejectionCodeString(oMessageId, ErrorCode.MissingValueException)
For Each prop In ex.MissingProperties
oMessage &= $"- {prop}"
Next
_history.Update_HistoryEntry(oMessageId, oMD5CheckSum, $"REJECTED - Missing Required Properties: [{oMessage}]") _history.Update_HistoryEntry(oMessageId, oMD5CheckSum, oRejectionCodeString)
Dim oMissingFieldList As String = "" Dim oMissingFieldList As String = ""
For Each oMissingFieldDescription In ex.MissingProperties For Each oMissingFieldDescription In ex.MissingProperties
oMissingFieldList += $"<li>{oMissingFieldDescription}</li>" oMissingFieldList += $"<li>{oMissingFieldDescription.Description}<br/><em>{oMissingFieldDescription.XMLPath}</em></li>"
Next Next
Dim oOrgFilename = _hash.GetOriginalFilename(ex.File.Name)
Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, ex.MissingProperties) Dim oBody = _email.CreateBodyForMissingProperties(ex.File.Name, ex.MissingProperties)
Dim oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId) 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 Catch ex As FileSizeLimitReachedException
_logger.Error(ex) _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 oEmailData = _file.MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oKey = FileSizeLimitReachedException.KEY_FILENAME Dim oKey = FileSizeLimitReachedException.KEY_FILENAME
Dim oFileExceedingThreshold As String = IIf(ex.Data.Contains(oKey), ex.Data.Item(oKey), "") Dim oFileExceedingThreshold As String = IIf(ex.Data.Contains(oKey), ex.Data.Item(oKey), "")
Dim oFileWithoutMessageId = oFileExceedingThreshold. Dim oOrgFilename = _hash.GetOriginalFilename(oFileExceedingThreshold)
Replace(oMessageId, "").
Replace("~", "")
Dim oBody = String.Format(EmailStrings.EMAIL_FILE_SIZE_REACHED, oArgs.MaxAttachmentSizeInMegaBytes, oFileWithoutMessageId) 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, oFileWithoutMessageId)
AddRejectedState(oMessageId, "FileSizeLimitReachedException", "Erlaubte Dateigröße überschritten", "", oSQLTransaction)
_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 Catch ex As NoFerdsAlternateException
' TODO: Maybe dont even log this 'error', since it's not really an error and it might happen *A LOT* ' 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.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex) _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 oMoveDirectory = DIRECTORY_DONT_MOVE
oExpectedError = False 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 Finally
Try Try
' If an application error occurred, dont move files so they will be processed again later ' 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 ' finally commit all changes To the Database
' ================================================================== ' ==================================================================
If oIsSuccess Or oExpectedError Then If oIsSuccess Or oExpectedError Then
' Commit Transaction If oSQLTransaction IsNot Nothing Then
oSQLTransaction.Commit() ' Commit Transaction
oSQLTransaction.Commit()
End If
End If End If
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
@ -416,7 +427,9 @@ Public Class ImportZUGFeRDFiles
End Try End Try
Try Try
oSQLConnection.Close() If oSQLConnection IsNot Nothing Then
oSQLConnection.Close()
End If
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
_logger.Warn("Database Connections were not closed successfully.") _logger.Warn("Database Connections were not closed successfully.")
@ -432,10 +445,21 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Sub 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 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 oDocument As ZUGFeRDInterface.ZugferdResult
Dim oResult As New ProcessFileResult() Dim oResult As New ProcessFileResult()
Dim oMissingProperties As New List(Of String)
' Only pdf files are allowed from here on ' Only pdf files are allowed from here on
If Not oFile.Name.ToUpper.EndsWith(".PDF") Then If Not oFile.Name.ToUpper.EndsWith(".PDF") Then
@ -520,7 +544,6 @@ Public Class ImportZUGFeRDFiles
If oCheckResult.MissingProperties.Count > 0 Then If oCheckResult.MissingProperties.Count > 0 Then
_logger.Warn("[{0}] missing properties found. Exiting.", oCheckResult.MissingProperties.Count) _logger.Warn("[{0}] missing properties found. Exiting.", oCheckResult.MissingProperties.Count)
oMissingProperties = oCheckResult.MissingProperties
Throw New MissingValueException(oFile, oCheckResult.MissingProperties) Throw New MissingValueException(oFile, oCheckResult.MissingProperties)
Else Else
_logger.Debug("No missing properties found. Continuing.") _logger.Debug("No missing properties found. Continuing.")
@ -548,7 +571,7 @@ Public Class ImportZUGFeRDFiles
'Next 'Next
' DataTable vorbereiten ' DataTable vorbereiten
Dim oDataTable As DataTable = FillDataTable(pMessageId, oCheckResult, oDocument.Specification) Dim oDataTable As DataTable = FillDataTable(pMessageId, oCheckResult, oDocument.Specification, oDocument.UsedXMLSchema)
' ColumnList initialisieren ' ColumnList initialisieren
Dim oColumnNames As List(Of String) = New List(Of String) From { Dim oColumnNames As List(Of String) = New List(Of String) From {
@ -578,7 +601,7 @@ Public Class ImportZUGFeRDFiles
End Function 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() Dim oDataTable As DataTable = New DataTable()
oDataTable.Columns.Add(New DataColumn("REFERENCE_GUID", GetType(String))) 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) _logger.Debug("Mapping Property [ZUGFERD_SPECIFICATION] with value [{0}]", pSpecification)
oDataTable.Rows.Add(oFirstRow) 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 For Each oProperty In pCheckResult.ValidProperties
@ -610,10 +644,14 @@ Public Class ImportZUGFeRDFiles
oGroupCounterValue = 0 oGroupCounterValue = 0
End If 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() Dim oNewRow As DataRow = oDataTable.NewRow()
oNewRow("REFERENCE_GUID") = pMessageId oNewRow("REFERENCE_GUID") = pMessageId
oNewRow("ITEM_DESCRIPTION") = oProperty.Description oNewRow("ITEM_DESCRIPTION") = oProperty.Description
oNewRow("ITEM_VALUE") = oProperty.Value.Replace("'", "''") oNewRow("ITEM_VALUE") = oProperty.Value.Truncate(900).Replace("'", "''")
oNewRow("GROUP_COUNTER") = oGroupCounterValue oNewRow("GROUP_COUNTER") = oGroupCounterValue
oNewRow("SPEC_NAME") = oProperty.TableColumn oNewRow("SPEC_NAME") = oProperty.TableColumn
oNewRow("IS_REQUIRED") = oProperty.IsRequired 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_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_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_DEFAULT As String = LOG_FORMAT_BASE & " >> ${message}"
Private Const LOG_FORMAT_ERROR As String = LOG_FORMAT_BASE & " >> " & LOG_FORMAT_EXCEPTION 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: AssemblyDescription("")>
<Assembly: AssemblyCompany("Digital Data")> <Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Logging")> <Assembly: AssemblyProduct("Modules.Logging")>
<Assembly: AssemblyCopyright("Copyright © 2023")> <Assembly: AssemblyCopyright("Copyright © 2024")>
<Assembly: AssemblyTrademark("2.6.3.0")> <Assembly: AssemblyTrademark("2.6.4.0")>
<Assembly: ComVisible(False)> <Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.6.3.0")> <Assembly: AssemblyVersion("2.6.4.0")>
<Assembly: AssemblyFileVersion("2.6.3.0")> <Assembly: AssemblyFileVersion("2.6.4.0")>

4
Messaging/Limilab.vb
View File

@ -65,9 +65,9 @@ Public Class Limilab
End Function End Function
Private Function LOG_Limilab(Log_enabled As Boolean) As Boolean Private Sub LOG_Limilab(Log_enabled As Boolean)
Log.Enabled = Log_enabled Log.Enabled = Log_enabled
End Function End Sub
''' <summary> ''' <summary>
''' Tests connection to a given IMAP Server by connecting and doing a simple message query. ''' 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 Try
Dim oSuccessfulSends As New List(Of String) Dim oSuccessfulSends As New List(Of String)
Dim oFailedSends As New List(Of String) Dim oFailedSends As New List(Of String)
Dim oResult As Boolean
For Each oSendToAddress In pSendTo 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 If oResult = True Then
oSuccessfulSends.Add(oSendToAddress & "|" & pSubject) oSuccessfulSends.Add(oSendToAddress & "|" & pSubject)
@ -143,6 +150,19 @@ Namespace Mail
Return pMailBuilder Return pMailBuilder
End Function 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 Class
End Namespace End Namespace

14
Messaging/Mail/MailSession.vb
View File

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

8
Messaging/My Project/AssemblyInfo.vb
View File

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