diff --git a/Database/Adapters/MSSQLServer.vb b/Database/Adapters/MSSQLServer.vb index c6695542..d3e4d02f 100644 --- a/Database/Adapters/MSSQLServer.vb +++ b/Database/Adapters/MSSQLServer.vb @@ -340,7 +340,7 @@ Public Class MSSQLServer pSqlCommandObject.CommandTimeout = pTimeout Using oAdapter As New SqlDataAdapter(pSqlCommandObject) - Logger.Debug("GetDatatableWithConnectionObject: Running Query [{0}]", pSqlCommandObject.CommandText) + Logger.Debug("GetDatatableWithConnectionObject: Running Query [{0}] and Parameters [{1}]", pSqlCommandObject.CommandText, GetParameterListAsString(pSqlCommandObject)) oAdapter.Fill(oTable) End Using @@ -427,7 +427,7 @@ Public Class MSSQLServer Dim oTransaction As SqlTransaction = MaybeGetTransaction(pSqlConnection, pTransactionMode, pTransaction) Try - Logger.Debug("ExecuteNonQueryWithConnectionObject: Running Command [{0}]", pSqlCommandObject.CommandText) + Logger.Debug("ExecuteNonQueryWithConnectionObject: Running Command [{0}] and Parameters [{1}]", pSqlCommandObject.CommandText, GetParameterListAsString(pSqlCommandObject)) pSqlCommandObject.Connection = pSqlConnection pSqlCommandObject.Transaction = oTransaction @@ -517,6 +517,9 @@ Public Class MSSQLServer Dim oResult As Object = Nothing Try + + Logger.Debug("GetScalarValueWithConnectionObject: Running Query [{0}] with Parameters [{1}]", pSqlCommandObject, GetParameterListAsString(pSqlCommandObject)) + pSqlCommandObject.Connection = pSqlConnection pSqlCommandObject.CommandTimeout = pTimeout pSqlCommandObject.Transaction = oTransaction @@ -601,4 +604,13 @@ Public Class MSSQLServer Dim res = command.EndExecuteNonQuery(result) Logger.Info("Finished executing Async database operation: {0}", command.CommandText) End Sub + + Private Function GetParameterListAsString(pSQLCommand As SqlCommand) As String + Dim oList = pSQLCommand.Parameters. + Cast(Of SqlParameter). + Select(Function(p) $"({p.ParameterName}={p.Value})"). + ToList() + + Return String.Join(",", oList) + End Function End Class diff --git a/Database/Database.vbproj b/Database/Database.vbproj index 1137ac87..b0ef3829 100644 --- a/Database/Database.vbproj +++ b/Database/Database.vbproj @@ -100,7 +100,6 @@ - diff --git a/Database/Helpers.vb b/Database/Helpers.vb deleted file mode 100644 index 4d09d04b..00000000 --- a/Database/Helpers.vb +++ /dev/null @@ -1,10 +0,0 @@ -Public Class Helpers - - Public Shared Function MaybeEscapeSQLCommand(pSQLCommand As String) As String - - - - End Function - - -End Class diff --git a/Database/My Project/AssemblyInfo.vb b/Database/My Project/AssemblyInfo.vb index 9e1ccdd2..2c7ff65c 100644 --- a/Database/My Project/AssemblyInfo.vb +++ b/Database/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Filesystem/File.vb b/Filesystem/File.vb index 60379f2b..3a20856d 100644 --- a/Filesystem/File.vb +++ b/Filesystem/File.vb @@ -109,11 +109,21 @@ Public Class File ''' ''' Adds file version string to given filename `Destination` if that file already exists. ''' - ''' - ''' - Public Function GetVersionedFilename(Destination As String) As String + ''' Filepath to check + ''' Versioned string + Public Function GetVersionedFilename(pFilePath As String) As String + Return GetVersionedFilenameWithFilecheck(pFilePath, Function(pPath As String) IO.File.Exists(pFilePath)) + End Function + + ''' + ''' Adds file version string to given filename `Destination` if that file already exists. + ''' + ''' Filepath to check + ''' Custom action to check for file existence + ''' Versioned string + Public Function GetVersionedFilenameWithFilecheck(pFilePath As String, pFileExistsAction As Func(Of String, Boolean)) As String Try - Dim oFileName As String = Destination + Dim oFileName As String = pFilePath Dim oFinalFileName = oFileName Dim oDestinationDir = Path.GetDirectoryName(oFileName) @@ -131,7 +141,7 @@ Public Class File ' Shorten the filename (only filename, without extension or version) ' by cutting the length in half. This should work no matter how long the path and/or filename are. ' The initial check operates on the full path to catch all scenarios. - If Destination.Length > MAX_FILE_PATH_LENGTH Then + If pFilePath.Length > MAX_FILE_PATH_LENGTH Then _Logger.Info("Filename is too long. Filename will be cut to prevent further errors.") _Logger.Info("Original Filename is: {0}", oFileNameWithoutExtension) Dim oNewLength As Integer = Math.Round(oFileNameWithoutExtension.Length / 2) @@ -147,15 +157,15 @@ Public Class File _Logger.Debug("Intermediate Filename is {0}", oFinalFileName) _Logger.Debug("File version: {0}", oFileVersion) oFileVersion += 1 - Loop While (IO.File.Exists(oFinalFileName)) + Loop While pFileExistsAction(oFinalFileName) = True _Logger.Debug("Final Filename is {0}", oFinalFileName) Return oFinalFileName Catch ex As Exception - _Logger.Warn("Filename {0} could not be versioned. Original filename will be returned!", Destination) + _Logger.Warn("Filename {0} could not be versioned. Original filename will be returned!", pFilePath) _Logger.Error(ex) - Return Destination + Return pFilePath End Try End Function @@ -195,6 +205,8 @@ Public Class File oStringVersion = 1 End If + _Logger.Debug("Versioned: String [{0}], Version [{1}]", pString, oStringVersion) + Return New Tuple(Of String, Integer)(pString, oStringVersion) End Function diff --git a/Filesystem/My Project/AssemblyInfo.vb b/Filesystem/My Project/AssemblyInfo.vb index f1519343..dffefb47 100644 --- a/Filesystem/My Project/AssemblyInfo.vb +++ b/Filesystem/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Interfaces/ActiveDirectoryInterface.vb b/Interfaces/ActiveDirectoryInterface.vb index d3617f4e..5da2f55a 100644 --- a/Interfaces/ActiveDirectoryInterface.vb +++ b/Interfaces/ActiveDirectoryInterface.vb @@ -193,6 +193,8 @@ Public Class ActiveDirectoryInterface .FirebirdSyskey = oMap.FirebirdSyskey, .MSSQLColumn = oMap.MSSQLColumn }) + Else + _logger.Debug("Attribute [{0}] is empty.", oMap.AttributeName) End If Next Else diff --git a/Interfaces/ActiveDirectoryInterface/ActiveDirectoryUser.vb b/Interfaces/ActiveDirectoryInterface/ActiveDirectoryUser.vb index ee7504f6..0a0558b3 100644 --- a/Interfaces/ActiveDirectoryInterface/ActiveDirectoryUser.vb +++ b/Interfaces/ActiveDirectoryInterface/ActiveDirectoryUser.vb @@ -8,6 +8,7 @@ Public Class ADUser Public Property GivenName As String Public Property Middlename As String Public Property Email As String + Public Property Language As String Public CustomAttributes As List(Of CustomAttribute) diff --git a/Interfaces/My Project/AssemblyInfo.vb b/Interfaces/My Project/AssemblyInfo.vb index d792ad58..955d1b45 100644 --- a/Interfaces/My Project/AssemblyInfo.vb +++ b/Interfaces/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Interfaces/ZUGFeRDInterface.vb b/Interfaces/ZUGFeRDInterface.vb index 344d4f01..4c10aa50 100644 --- a/Interfaces/ZUGFeRDInterface.vb +++ b/Interfaces/ZUGFeRDInterface.vb @@ -12,6 +12,13 @@ Public Class ZUGFeRDInterface Private ReadOnly _logger As Logger Private ReadOnly _Options As ZugferdOptions + ' These constants define the specification markers for the different + ' zugferd document schema versions. These markers need to be used to + ' define the property map in the database (column SPECIFICATION). + Public Const ZUGFERD_SPEC_DEFAULT = "DEFAULT" + Public Const ZUGFERD_SPEC_10 = "ZUGFERD_10" + Public Const ZUGFERD_SPEC_2x = "ZUGFERD_2x" + Private ReadOnly ValidFilenames As New List(Of String) From { PDFEmbeds.ZUGFERD_XML_FILENAME.ToUpper, PDFEmbeds.FACTUR_X_XML_FILENAME_DE.ToUpper, @@ -35,6 +42,15 @@ Public Class ZUGFeRDInterface Public Class ZugferdOptions Public Property AllowFacturX_Filename As Boolean = True Public Property AllowXRechnung_Filename As Boolean = True + Public Property AllowZugferd_1_0_Schema As Boolean = True + Public Property AllowZugferd_2_x_Schema As Boolean = True + End Class + + Public Class ZugferdResult + Public Property DataFileName As String + Public Property XPathObject As XPathDocument + Public Property SchemaObject As Object + Public Property Specification As String End Class ''' @@ -89,14 +105,14 @@ Public Class ZUGFeRDInterface ''' ''' ''' - Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Tuple(Of String, Object) - Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path) + Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As ZugferdResult + Dim oResult = ValidateZUGFeRDFileWithGDPicture(Path) - If IsNothing(oXmlDocument.Item2) Then + If IsNothing(oResult.SchemaObject) Then Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") End If - Return SerializeZUGFeRDDocument(oXmlDocument) + Return SerializeZUGFeRDDocument(oResult) End Function ''' @@ -104,14 +120,14 @@ Public Class ZUGFeRDInterface ''' ''' ''' - Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Tuple(Of String, Object) - Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream) + Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As ZugferdResult + Dim oResult = ValidateZUGFeRDFileWithGDPicture(Stream) - If IsNothing(oXmlDocument.Item2) Then + If IsNothing(oResult.SchemaObject) Then Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") End If - Return SerializeZUGFeRDDocument(oXmlDocument) + Return SerializeZUGFeRDDocument(oResult) End Function ''' @@ -120,7 +136,7 @@ Public Class ZUGFeRDInterface ''' ''' ''' The embedded xml data as an XPath document - Public Function ValidateZUGFeRDFileWithGDPicture(pStream As Stream) As Tuple(Of String, XPathDocument) + Public Function ValidateZUGFeRDFileWithGDPicture(pStream As Stream) As ZugferdResult Dim oEmbedExtractor = New PDFEmbeds(_logConfig) Try @@ -148,7 +164,7 @@ Public Class ZUGFeRDInterface ''' ''' ''' The embedded xml data as an XPath document - Public Function ValidateZUGFeRDFileWithGDPicture(pPath As String) As Tuple(Of String, XPathDocument) + Public Function ValidateZUGFeRDFileWithGDPicture(pPath As String) As ZugferdResult Dim oEmbedExtractor = New PDFEmbeds(_logConfig) Try @@ -170,7 +186,7 @@ Public Class ZUGFeRDInterface End Try End Function - Private Function HandleEmbeddedFiles(pResults As List(Of PDFEmbeds.EmbeddedFile)) As Tuple(Of String, XPathDocument) + Private Function HandleEmbeddedFiles(pResults As List(Of PDFEmbeds.EmbeddedFile)) As ZugferdResult If pResults Is Nothing Then Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.") End If @@ -200,7 +216,10 @@ Public Class ZUGFeRDInterface Try Using oStream As New MemoryStream(oAllowedResult.FileContents) - Return New Tuple(Of String, XPathDocument)(oAllowedResult.FileName, New XPathDocument(oStream)) + Return New ZugferdResult With { + .DataFileName = oAllowedResult.FileName, + .XPathObject = New XPathDocument(oStream) + } End Using Catch ex As ZUGFeRDExecption @@ -214,44 +233,59 @@ Public Class ZUGFeRDInterface End Try End Function - Public Function SerializeZUGFeRDDocument(pDocument As Tuple(Of String, XPathDocument)) As Tuple(Of String, Object) + Public Function SerializeZUGFeRDDocument(pResult As ZugferdResult) As ZugferdResult Try - Dim oNavigator As XPathNavigator = pDocument.Item2.CreateNavigator() + Dim oNavigator As XPathNavigator = pResult.XPathObject.CreateNavigator() Dim oReader As XmlReader - Dim oResult = Nothing - Dim oTypes As New List(Of Type) From { - GetType(ZUGFeRD.Version1_0.CrossIndustryDocumentType), - GetType(ZUGFeRD.Version2_0.CrossIndustryInvoiceType), - GetType(ZUGFeRD.Version2_1_1.CrossIndustryInvoiceType), - GetType(ZUGFeRD.Version2_2_FacturX.CrossIndustryInvoiceType) - } + Dim oObject As Object = Nothing + Dim oSpecification As String = Nothing - For Each oType In oTypes - _logger.Debug("Trying Type [{0}]", oType.FullName) - Dim oSerializer As New XmlSerializer(oType) + Dim oAllowedTypes As New Dictionary(Of String, Type) + + If _Options.AllowZugferd_1_0_Schema Then + oAllowedTypes.Add(ZUGFERD_SPEC_10, GetType(ZUGFeRD.Version1_0.CrossIndustryDocumentType)) + End If + + If _Options.AllowZugferd_2_x_Schema Then + oAllowedTypes.Add(ZUGFERD_SPEC_2x, GetType(ZUGFeRD.Version2_0.CrossIndustryInvoiceType)) + oAllowedTypes.Add(ZUGFERD_SPEC_2x, GetType(ZUGFeRD.Version2_1_1.CrossIndustryInvoiceType)) + oAllowedTypes.Add(ZUGFERD_SPEC_2x, GetType(ZUGFeRD.Version2_2_FacturX.CrossIndustryInvoiceType)) + End If + + For Each oType In oAllowedTypes + Dim oTypeName As String = oType.Value.FullName + Dim oSerializer As New XmlSerializer(oType.Value) + _logger.Debug("Trying Type [{0}]", oTypeName) Try oReader = oNavigator.ReadSubtree() - oResult = oSerializer.Deserialize(oReader) - _logger.Debug("Serializing with type [{0}] succeeded", oType.FullName) + + oObject = oSerializer.Deserialize(oReader) + oSpecification = oType.Key + + _logger.Debug("Serializing with type [{0}] succeeded", oTypeName) Exit For Catch ex As Exception - _logger.Debug("Serializing with type [{0}] failed", oType.FullName) + _logger.Debug("Serializing with type [{0}] failed", oTypeName) _logger.Debug(ex.Message) _logger.Error(ex.InnerException?.Message) End Try Next - If oResult Is Nothing Then + If oObject Is Nothing Then Throw New ApplicationException("No Types matched the given document. Document could not be serialized.") End If - Return oResult + pResult.Specification = oSpecification + pResult.SchemaObject = oObject + + Return pResult Catch ex As Exception _logger.Error(ex) - Throw New ZUGFeRDExecption(ErrorType.NoValidZugferd, "Datei ist eine ungültige ZUGFeRD Datei.") + Dim oMessage = "Datei ist eine ungültige ZUGFeRD Datei oder das Format wird nicht unterstüzt, oder das Format ist deaktiviert." + Throw New ZUGFeRDExecption(ErrorType.NoValidZugferd, oMessage) End Try End Function diff --git a/Interfaces/ZUGFeRDInterface/XmlItemProperty.vb b/Interfaces/ZUGFeRDInterface/XmlItemProperty.vb index a14c456e..672dcce0 100644 --- a/Interfaces/ZUGFeRDInterface/XmlItemProperty.vb +++ b/Interfaces/ZUGFeRDInterface/XmlItemProperty.vb @@ -1,8 +1,14 @@ Public Class XmlItemProperty + Public IsRequired As Boolean + Public IsGrouped As Boolean + Public TableName As String Public TableColumn As String Public Description As String - Public IsRequired As Boolean - Public IsGrouped As Boolean Public GroupScope As String + + ''' + ''' Document version, eg. ZUGFeRD Schema version + ''' + Public Specification As String End Class \ No newline at end of file diff --git a/Jobs/Jobs.vbproj b/Jobs/Jobs.vbproj index 7aa0c6db..68e81994 100644 --- a/Jobs/Jobs.vbproj +++ b/Jobs/Jobs.vbproj @@ -116,9 +116,9 @@ - + False - ..\Interfaces\bin\Debug\DigitalData.Modules.Language.dll + ..\Language\bin\Debug\DigitalData.Modules.Language.dll ..\packages\FirebirdSql.Data.FirebirdClient.7.5.0\lib\net452\FirebirdSql.Data.FirebirdClient.dll diff --git a/Jobs/My Project/AssemblyInfo.vb b/Jobs/My Project/AssemblyInfo.vb index 9dac9b52..4625e99b 100644 --- a/Jobs/My Project/AssemblyInfo.vb +++ b/Jobs/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -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: - - + + diff --git a/Jobs/ZUGFeRD/EmailFunctions.vb b/Jobs/ZUGFeRD/EmailFunctions.vb index 9dd4c1ae..010de5b1 100644 --- a/Jobs/ZUGFeRD/EmailFunctions.vb +++ b/Jobs/ZUGFeRD/EmailFunctions.vb @@ -1,5 +1,6 @@ Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database +Imports DigitalData.Modules.Language Imports System.Data Imports System.IO Imports System.Data.SqlClient @@ -164,10 +165,19 @@ Public Class EmailFunctions _logger.Debug("Got Email Data for FileId {0}", MessageId) oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1) + Dim oFromDefault = String.Format("No Sender found for ({0})", MessageId) + Dim oFrom = oRow.ItemEx("EMAIL_FROM", oFromDefault) + + Dim oAttachmentDefault = String.Format("No Attachment found for ({0})", MessageId) + Dim oAttachment = oRow.ItemEx("EMAIL_ATTMT1", oAttachmentDefault) + + Dim oSubjectDefault = String.Format("No Subject found for ({0})", MessageId) + Dim oSubject = oRow.ItemEx("EMAIL_SUBJECT", oSubjectDefault) + Return New EmailData() With { - .From = oRow.Item("EMAIL_FROM"), - .Attachment = oRow.Item("EMAIL_ATTMT1"), - .Subject = oRow.Item("EMAIL_SUBJECT") + .From = oFrom, + .Attachment = oAttachment, + .Subject = oSubject } Catch ex As Exception _logger.Warn("Could not fetch Email Data for FileId {0}", MessageId) diff --git a/Jobs/ZUGFeRD/EmailStrings.vb b/Jobs/ZUGFeRD/EmailStrings.vb index ed3b1639..fbecd5bb 100644 --- a/Jobs/ZUGFeRD/EmailStrings.vb +++ b/Jobs/ZUGFeRD/EmailStrings.vb @@ -20,9 +20,9 @@ Public Const EMAIL_MD5_ERROR = "

Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.

" - Public Const EMAIL_TOO_MUCH_FERDS = "

Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.

" + Public Const EMAIL_TOO_MUCH_FERDS = "

In Ihrer Email ({0}) sind mehr als ein ZUGFeRD Dokument enthalten. Bitte prüfen Sie Rechnung an Anhänge. Nur eine Rechnung darf das ZUGFeRD-Format enthalten

" - Public Const EMAIL_NO_FERDS = "

Ihre Email enthielt keine ZUGFeRD-Dokumente.

" + Public Const EMAIL_NO_FERDS = "

Ihre Email ({0}) enthielt keine ZUGFeRD-Dokumente.

" Public Const EMAIL_FILE_SIZE_REACHED = "

Die von Ihnen gesendete Rechnung oder einer der Rechnungs-Anhänge überschreitet die erlaubte Größe von {0} MB.

@@ -32,13 +32,13 @@ " Public Const EMAIL_INVALID_DOCUMENT = " -

Ihre Email enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.

+

Ihre Email ({0}) enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.

Mögliche Gründe für ein inkorrektes Format:

  • Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)

" Public Const EMAIL_UNSUPPORTED_DOCUMENT = " -

Ihre Email enthielt ein ZUGFeRD Dokument ({0}), welches zur Zeit noch nicht unsterstützt wird.

+

Ihre Email ({0}) enthielt ein ZUGFeRD Format ({1}), welches zur Zeit noch nicht freigeschaltet ist.

" End Class diff --git a/Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb b/Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb index 226ada45..88b98b26 100644 --- a/Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Jobs/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -206,7 +206,9 @@ Public Class ImportZUGFeRDFiles ' different versions of ZUGFeRD and the type is unknown at compile-time. ' 17.11.2022: oDocument is now a Tuple of (String, Object), to be able to return the filename ' of the extracted xml file. - Dim oDocument As Tuple(Of String, Object) + ' 21.12.2022: oDocument is now an object of type ZugferdResult to be able to save + ' the new meta data, ie. the type of schema (zugferd version) + Dim oDocument As ZUGFeRDInterface.ZugferdResult ' Start a global group counter for each file Dim oGlobalGroupCounter = 0 @@ -283,7 +285,8 @@ Public Class ImportZUGFeRDFiles ' Check the document against the configured property map and return: ' - a List of valid properties ' - a List of missing properties - Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument, oArgs.PropertyMap, oMessageId) + Dim oPropertyMap = GetPropertyMapFor(oArgs, oDocument.Specification) + Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument.SchemaObject, oPropertyMap, oMessageId) _logger.Info("Properties checked: [{0}] missing properties / [{1}] valid properties found.", oCheckResult.MissingProperties.Count, oCheckResult.ValidProperties.Count) @@ -398,8 +401,9 @@ Public Class ImportZUGFeRDFiles ' That 's why we set it to String.Empty here. Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oFBTransaction) - Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, ex.XmlFile) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) + Dim oBody As String = String.Format(EmailStrings.EMAIL_UNSUPPORTED_DOCUMENT, oEmailData.Subject, ex.XmlFile) + _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal) AddRejectedState(oMessageId, "UnsupportedFerdException", "Nicht unterstütztes Datenformat", "", oSQLTransaction) @@ -410,8 +414,9 @@ Public Class ImportZUGFeRDFiles ' That 's why we set it to String.Empty here. Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oFBTransaction) - Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) + Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject) + _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal) AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "", oSQLTransaction) @@ -420,8 +425,9 @@ Public Class ImportZUGFeRDFiles Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - More than one ZUGFeRD-document in email", oFBTransaction) - Dim oBody = EmailStrings.EMAIL_TOO_MUCH_FERDS Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) + Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject) + _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal) AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction) @@ -430,8 +436,9 @@ Public Class ImportZUGFeRDFiles Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oFBTransaction) - Dim oBody = EmailStrings.EMAIL_NO_FERDS Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) + Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject) + _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal) AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction) @@ -576,6 +583,26 @@ Public Class ImportZUGFeRDFiles End Try End Sub + Private Function GetPropertyMapFor(pWorkerArgs As WorkerArgs, pSpecification As String) As Dictionary(Of String, XmlItemProperty) + Dim oPropertyMap = DoGetPropertyMapFor(pWorkerArgs, pSpecification) + + _logger.Debug("Found [{0}] Properties for Specification [{1}].", oPropertyMap.Count, pSpecification) + + ' If no properties were found, fall back to the default specification before giving up + If oPropertyMap.Count = 0 Then + _logger.Warn("No Properties found for Specification [{0}]. Loading default property map!", pSpecification) + Return DoGetPropertyMapFor(pWorkerArgs, ZUGFeRDInterface.ZUGFERD_SPEC_DEFAULT) + End If + + Return oPropertyMap + End Function + + Private Function DoGetPropertyMapFor(pWorkerArgs As WorkerArgs, pSpecification As String) As Dictionary(Of String, XmlItemProperty) + Return pWorkerArgs.PropertyMap. + Where(Function(kv) kv.Value.Specification = pSpecification). + ToDictionary(Function(kv) kv.Key, Function(kv) kv.Value) + End Function + Private Sub MoveFiles( Args As WorkerArgs, MessageId As String, diff --git a/Jobs/ZUGFeRD/WorkerArgs.vb b/Jobs/ZUGFeRD/WorkerArgs.vb index a34a90b0..ba9ac70d 100644 --- a/Jobs/ZUGFeRD/WorkerArgs.vb +++ b/Jobs/ZUGFeRD/WorkerArgs.vb @@ -26,4 +26,6 @@ Public Class WorkerArgs Public AllowFacturX As Boolean = True Public AllowXRechnung As Boolean = True + Public AllowZugferd10 As Boolean = True + Public AllowZugferd2x As Boolean = True End Class \ No newline at end of file diff --git a/Logging/LogConfig.vb b/Logging/LogConfig.vb index 8a9d1458..77450f51 100644 --- a/Logging/LogConfig.vb +++ b/Logging/LogConfig.vb @@ -75,12 +75,14 @@ Public Class LogConfig Private Const FILE_NAME_FORMAT_DEBUG As String = "${shortdate}-${var:product}${var:suffix}${event-properties:item=ModuleName}-Debug.log" Private Const FILE_NAME_FORMAT_TRACE As String = "${shortdate}-${var:product}${var:suffix}${event-properties:item=ModuleName}-Trace.log" Private Const FILE_NAME_FORMAT_ERROR As String = "${shortdate}-${var:product}${var:suffix}${event-properties:item=ModuleName}-Error.log" + Private Const FILE_NAME_FORMAT_JSON As String = "${shortdate}-${var:product}${var:suffix}${event-properties:item=ModuleName}.log.json" Private Const TARGET_DEFAULT As String = "defaultTarget" Private Const TARGET_ERROR_EX As String = "errorExceptionTarget" Private Const TARGET_ERROR As String = "errorTarget" Private Const TARGET_DEBUG As String = "debugTarget" Private Const TARGET_TRACE As String = "traceTarget" + Private Const TARGET_JSON As String = "jsonTarget" 'Private Const TARGET_MEMORY As String = "memoryTarget" Private Const LOG_FORMAT_BASE As String = "${time}|${logger:shortName=True}|${level:uppercase=true}" @@ -101,8 +103,9 @@ Public Class LogConfig Private ReadOnly _basePath As String = _failSafePath Private _config As LoggingConfiguration - Private _isDebug As Boolean = False - Private _isTrace As Boolean = False + Private _EnableDebugLogging As Boolean = False + Private _EnableTraceLogging As Boolean = False + Private _EnableJsonLogging As Boolean = False #End Region #Region "Public Properties" @@ -137,21 +140,31 @@ Public Class LogConfig ''' True, if debug log will be written. False otherwise. Public Property Debug As Boolean Get - Return _isDebug + Return _EnableDebugLogging End Get - Set(isDebug As Boolean) - _isDebug = isDebug - ReloadConfig(isDebug, _isTrace) + Set(value As Boolean) + _EnableDebugLogging = value + ReloadConfig() End Set End Property Public Property Trace As Boolean Get - Return _isTrace + Return _EnableTraceLogging End Get - Set(isTrace As Boolean) - _isTrace = isTrace - ReloadConfig(_isDebug, isTrace) + Set(value As Boolean) + _EnableTraceLogging = value + ReloadConfig() + End Set + End Property + + Public Property EnableJsonLog As Boolean + Get + Return _EnableJsonLogging + End Get + Set(value As Boolean) + _EnableJsonLogging = value + ReloadConfig() End Set End Property @@ -443,6 +456,7 @@ Public Class LogConfig _config.AddTarget(TARGET_DEFAULT, GetDefaultLogTarget(_basePath)) _config.AddTarget(TARGET_DEBUG, GetDebugLogTarget(_basePath)) _config.AddTarget(TARGET_TRACE, GetTraceLogTarget(_basePath)) + _config.AddTarget(TARGET_JSON, GetJsonLogTarget(_basePath)) '_config.AddTarget(TARGET_MEMORY, GetMemoryDebugTarget()) ' Add default rules @@ -478,9 +492,7 @@ Public Class LogConfig ''' ''' Reconfigures and re-adds all loggers, optionally adding the debug rule. ''' - ''' Adds the Debug rule if true. - ''' Adds the Trace rule if true. - Private Sub ReloadConfig(Optional Debug As Boolean = False, Optional Trace As Boolean = False) + Private Sub ReloadConfig() Dim oLogger = GetLogger() ' Clear Logging Rules @@ -489,15 +501,22 @@ Public Class LogConfig ' Add default rules AddDefaultRules(_config) + ' Add json rule, if configured + If _EnableJsonLogging = True Then + oLogger.Info("JSON Logging is now Enabled.") + _config.AddRule(LogLevel.Debug, LogLevel.Error, TARGET_JSON) + End If + ' Add debug rule, if configured - If Debug = True Then + If _EnableDebugLogging = True Then _config.AddRule(LogLevel.Debug, LogLevel.Error, TARGET_DEBUG) oLogger.Info("DEBUG Logging is now Enabled.") Else oLogger.Debug("DEBUG Logging is now Disabled.") End If - If Trace = True Then + ' Add trace rule, if configured + If _EnableTraceLogging = True Then _config.AddRule(LogLevel.Trace, LogLevel.Error, TARGET_TRACE) End If @@ -506,6 +525,29 @@ Public Class LogConfig End Sub #Region "Log Targets" + Private Function GetJsonLogTarget(basePath As String) As FileTarget + Dim oJsonLayout = New Layouts.JsonLayout + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("level", "${level}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("message", "${message}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("date", "${shortdate}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("product", "${var:product}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("suffix", "${var:suffix}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("module", "${event-properties:item=ModuleName}")) + oJsonLayout.Attributes.Add(New Layouts.JsonAttribute("exception", "${exception:format=Message,StackTrace:innerFormat=Message:maxInnerExceptionLevel=3}")) + + Dim jsonLog As New FileTarget() With { + .FileName = Path.Combine(basePath, FILE_NAME_FORMAT_JSON), + .Name = TARGET_JSON, + .Layout = oJsonLayout, + .MaxArchiveFiles = MAX_ARCHIVE_FILES_DEFAULT, + .ArchiveEvery = ARCHIVE_EVERY, + .KeepFileOpen = KEEP_FILES_OPEN, + .Encoding = Text.Encoding.Unicode + } + + Return jsonLog + End Function + Private Function GetDefaultLogTarget(basePath As String) As FileTarget Dim defaultLog As New FileTarget() With { .FileName = Path.Combine(basePath, FILE_NAME_FORMAT_DEFAULT), @@ -565,9 +607,9 @@ Public Class LogConfig End Function Private Function GetTraceLogTarget(basePath As String) As FileTarget - Dim debugLog As New FileTarget() With { + Dim traceLog As New FileTarget() With { .FileName = Path.Combine(basePath, FILE_NAME_FORMAT_TRACE), - .Name = TARGET_DEBUG, + .Name = TARGET_TRACE, .Layout = LOG_FORMAT_DEBUG, .MaxArchiveFiles = MAX_ARCHIVE_FILES_DEBUG_DETAIL, .ArchiveEvery = ARCHIVE_EVERY, @@ -578,18 +620,7 @@ Public Class LogConfig .Encoding = Text.Encoding.Unicode } - Return debugLog + Return traceLog End Function - - 'Private Function GetMemoryDebugTarget() As MemoryTarget - ' Dim memoryLog As New MemoryTarget() With { - ' .Layout = LOG_FORMAT_DEBUG, - ' .Name = TARGET_MEMORY, - ' .OptimizeBufferReuse = True, - ' .MaxLogsCount = MAX_MEMORY_LOG_COUNT - ' } - - ' Return memoryLog - 'End Function #End Region End Class diff --git a/Logging/My Project/AssemblyInfo.vb b/Logging/My Project/AssemblyInfo.vb index 196b58c3..b416a8b8 100644 --- a/Logging/My Project/AssemblyInfo.vb +++ b/Logging/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + @@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - - + + diff --git a/Messaging/Messaging.vbproj b/Messaging/Messaging.vbproj index 76b42b35..699ccaad 100644 --- a/Messaging/Messaging.vbproj +++ b/Messaging/Messaging.vbproj @@ -98,6 +98,10 @@ True + + + + diff --git a/Messaging/My Project/AssemblyInfo.vb b/Messaging/My Project/AssemblyInfo.vb index c306c7fc..1c0d3e79 100644 --- a/Messaging/My Project/AssemblyInfo.vb +++ b/Messaging/My Project/AssemblyInfo.vb @@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices - + diff --git a/Messaging/WCF/Binding.vb b/Messaging/WCF/Binding.vb new file mode 100644 index 00000000..7ff1cf49 --- /dev/null +++ b/Messaging/WCF/Binding.vb @@ -0,0 +1,31 @@ +Imports System.Net +Imports System.ServiceModel +Imports System.Xml + +Namespace WCF + Public Class Binding + Public Shared Function GetBinding(Optional AuthenticationMode As TcpClientCredentialType = TcpClientCredentialType.Windows) As NetTcpBinding + Return New NetTcpBinding() With { + .MaxReceivedMessageSize = Constants.ChannelSettings.MAX_RECEIVED_MESSAGE_SIZE, + .MaxBufferSize = Constants.ChannelSettings.MAX_BUFFER_SIZE, + .MaxBufferPoolSize = Constants.ChannelSettings.MAX_BUFFER_POOL_SIZE, + .TransferMode = TransferMode.Streamed, + .Security = New NetTcpSecurity() With { + .Mode = SecurityMode.Transport, + .Transport = New TcpTransportSecurity() With { + .ClientCredentialType = AuthenticationMode + } + }, + .ReaderQuotas = New XmlDictionaryReaderQuotas() With { + .MaxArrayLength = Constants.ChannelSettings.MAX_ARRAY_LENGTH, + .MaxStringContentLength = Constants.ChannelSettings.MAX_STRING_CONTENT_LENGTH + } + } + End Function + + Public Shared Function GetAddress(pHost As String, pPort As Integer, pName As String) As Uri + Return New Uri($"net.tcp://{pHost}:{pPort}/DigitalData/Services/{pName}") + End Function + End Class + +End Namespace \ No newline at end of file diff --git a/Messaging/WCF/Channel.vb b/Messaging/WCF/Channel.vb new file mode 100644 index 00000000..5d05e590 --- /dev/null +++ b/Messaging/WCF/Channel.vb @@ -0,0 +1,52 @@ +Imports System.ServiceModel +Imports System.Xml +Imports DigitalData.Modules.Base +Imports DigitalData.Modules.Logging + +Namespace WCF + Public Class Channel(Of TChannel As IClientChannel) + Inherits BaseClass + + Private ReadOnly ChannelFactory As ChannelFactory(Of TChannel) + + Public Event Reconnect As EventHandler + + Public Sub New(pLogConfig As LogConfig, pServerAddress As ServerAddress, Optional pName As String = "Main") + MyBase.New(pLogConfig) + ChannelFactory = GetChannelFactory(pServerAddress, pName) + End Sub + + ''' + ''' Creates a channel and adds a Faulted-Handler + ''' + ''' A channel object + Public Function GetChannel() As TChannel + Try + Logger.Debug("Creating channel.") + Dim oChannel = ChannelFactory.CreateChannel() + + AddHandler oChannel.Faulted, Sub() RaiseEvent Reconnect(Me, Nothing) + + Return oChannel + Catch ex As Exception + Logger.Error(ex) + Throw ex + End Try + End Function + + ''' + ''' Creates and returns a channel factory with the supplied name and address + ''' + ''' The service name, will be: net.tcp://ip:port/DigitalData/Services/[name] + ''' The service address, in the form of ip address and port + ''' + Private Function GetChannelFactory(pAddress As ServerAddress, pName As String) As ChannelFactory(Of TChannel) + Dim oBinding = Binding.GetBinding() + Dim oAddress = New EndpointAddress(Binding.GetAddress(pAddress.Host, pAddress.Port, pName)) + Dim oFactory = New ChannelFactory(Of TChannel)(oBinding, oAddress) + Return oFactory + End Function + + + End Class +End Namespace diff --git a/Messaging/WCF/Constants.vb b/Messaging/WCF/Constants.vb new file mode 100644 index 00000000..3f34b90f --- /dev/null +++ b/Messaging/WCF/Constants.vb @@ -0,0 +1,20 @@ +Namespace WCF + Public Class Constants + Public Const DEFAULT_SERVICE_PORT = 9000 + + ''' + ''' Infos about MaxBufferSize and MaxBufferPoolSize + ''' https://social.msdn.microsoft.com/Forums/vstudio/en-US/d6e234d3-942f-4e9d-8470-32618d3f3212/maxbufferpoolsize-vs-maxbuffersize?forum=wcf + ''' + Public Class ChannelSettings + Public Const MAX_RECEIVED_MESSAGE_SIZE = 2147483647 ' 1GB + Public Const MAX_BUFFER_SIZE = 104857600 ' 100MB + Public Const MAX_BUFFER_POOL_SIZE = 1048576 ' 1MB + + Public Const MAX_CONNECTIONS = 500 + Public Const MAX_ARRAY_LENGTH = 2147483647 + Public Const MAX_STRING_CONTENT_LENGTH = 2147483647 + End Class + End Class + +End Namespace diff --git a/Messaging/WCF/ServerAddress.vb b/Messaging/WCF/ServerAddress.vb new file mode 100644 index 00000000..aa63cac7 --- /dev/null +++ b/Messaging/WCF/ServerAddress.vb @@ -0,0 +1,7 @@ +Namespace WCF + Public Structure ServerAddress + Public Host As String + Public Port As Integer + End Structure + +End Namespace \ No newline at end of file diff --git a/Windream/Windream.vb b/Windream/Windream.vb index d7f5f53f..71bcec9e 100644 --- a/Windream/Windream.vb +++ b/Windream/Windream.vb @@ -637,6 +637,7 @@ Public Class Windream Return False End Try End Function + ''' ''' Archives windream object immediately ''' @@ -653,7 +654,7 @@ Public Class Windream End Try End Function - Public Function NewFolder(Path As String, pExtension As String) As Boolean + Public Function NewFolder(Path As String) As Boolean If Not TestSessionLoggedIn() Then Return False End If @@ -664,13 +665,11 @@ Public Class Windream Dim oFolderObject As WMObject Dim oCurrentPath As String = String.Empty - For Each oFolder In oFolders - If oFolder.ToString.EndsWith(pExtension) Then - Exit For - ElseIf oFolder = String.Empty Then + If oFolder = String.Empty Then Continue For End If + oCurrentPath = Combine(oCurrentPath, oFolder) If TestFolderExists(oCurrentPath) = False Then @@ -706,13 +705,13 @@ Public Class Windream Public Function NewFileStream(ByVal FilenameSource As String, ByVal FilenameTarget As String, ByVal WMObjecttypeName As String) As Boolean NewDocumentID = 0 - Dim oExtension As String = Path.GetExtension(FilenameSource) If Not TestSessionLoggedIn() Then Return False End If Dim oTargetDrive As String = Path.GetDirectoryName(FilenameTarget) + FilenameTarget = GetNormalizedPath(FilenameTarget, True) _logger.Debug($"Preparing to stream file from {FilenameSource} to {FilenameTarget}") @@ -721,7 +720,7 @@ Public Class Windream Dim oFileIO As WMFileIO Dim oWMStream As WMStream - NewFolder(FilenameTarget, oExtension) + NewFolder(oTargetDrive) 'Indexierungsdialog der Session unterdrücken Session.SwitchEvents(Constants.COM_EVENT_SESSION_NEED_INDEX, False) @@ -777,7 +776,6 @@ Public Class Windream oWMStream.Close() _logger.Debug("Saving new object") - oWMObject.aObjectType = GetObjectByName(WMObjecttypeName, WMEntityObjectType) oWMObject.Save() @@ -817,24 +815,20 @@ Public Class Windream End Try End Function - Public Function GetNormalizedPath(Path As String, pCleanPath As Boolean) As String - _logger.Debug("Normalizing Path: [{0}]", Path) - Dim oNormalizedPath As String = Path - If pCleanPath = True Then - oNormalizedPath = Language.Utils.RemoveInvalidCharacters(Path) - _logger.Debug("path after RemoveInvalidCharacters: [{0}]", oNormalizedPath) - End If - Try - ' Convert any forward slashes / and double slashes \\ into backslashes \ - ' See: https://stackoverflow.com/questions/3144492/how-do-i-get-nets-path-combine-to-convert-forward-slashes-to-backslashes - If IsPathRooted(oNormalizedPath) Then - oNormalizedPath = GetFullPath(oNormalizedPath) - End If + Public Function GetNormalizedPath(pPath As String, pCleanPath As Boolean) As String + _logger.Debug("Normalizing Path: [{0}]", pPath) + Dim oNormalizedPath As String = pPath + If pCleanPath = True Then + oNormalizedPath = Utils.RemoveInvalidCharacters(pPath) + _logger.Debug("Path after RemoveInvalidCharacters: [{0}]", oNormalizedPath) + End If + + Try ' Remove Driveletter, eg. W:\ If oNormalizedPath.StartsWith($"{ClientDriveLetter}:\") Then oNormalizedPath = oNormalizedPath.Substring(ClientDriveLetter.Length + 2) - _logger.Debug($"path after replaced ClientDriveLetter: [{oNormalizedPath}]") + _logger.Debug($"Path after replaced ClientDriveLetter: [{oNormalizedPath}]") End If ' Remove Windream Base Path, eg. \\windream\objects\ @@ -845,22 +839,41 @@ Public Class Windream ' Handle misconfigured drive-letter If oNormalizedPath.Contains(":") Then - _logger.Warn($"oNormalizedPath still contains a drive name!!") + _logger.Warn($"NormalizedPath [{oNormalizedPath}] still contains a drive name!!") _logger.Warn($"Check Your config ClientDriveLetter [{ClientDriveLetter}] // ClientBasePath [{ClientBasePath}]") oNormalizedPath = oNormalizedPath.Substring(3) End If + + ' Convert any forward slashes / and double slashes \\ into backslashes \ + ' See: https://stackoverflow.com/questions/3144492/how-do-i-get-nets-path-combine-to-convert-forward-slashes-to-backslashes + If IsPathRooted(oNormalizedPath) Then + ' This breaks because it converts the path "\SomeFolder" into "C:\SomeFolder" LOL + 'oNormalizedPath = GetFullPath(oNormalizedPath) + ' Lets just be pragmatic here + oNormalizedPath = oNormalizedPath.Replace("\\", "\") + oNormalizedPath = oNormalizedPath.Replace("/", "\") + + _logger.Debug("Path after converting slashes: [{0}]", oNormalizedPath) + End If + If oNormalizedPath.StartsWith("\") = False Then oNormalizedPath = $"\{oNormalizedPath}" End If - _logger.Debug($"oNormalizedPath: [{oNormalizedPath}]") + + _logger.Debug($"NormalizedPath: [{oNormalizedPath}]") Return oNormalizedPath Catch ex As Exception - _logger.Warn($"Unexpected error in GetNormalizedPath - oNormalizedPath [{oNormalizedPath}] - Error: [{ex.Message}]") + _logger.Warn($"Unexpected error in GetNormalizedPath - NormalizedPath [{oNormalizedPath}] - Error: [{ex.Message}]") Return "" End Try End Function + Public Function GetAbsolutePath(pPath As String) As String + Dim oNormalizedPath = GetNormalizedPath(pPath, False) + Return $"\\windream\objects{oNormalizedPath}" + End Function + ''' ''' Returns the result of a search file '''