This commit is contained in:
SchreiberM 2023-01-03 16:03:51 +01:00
commit 3183b0ed31
26 changed files with 391 additions and 138 deletions

View File

@ -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

View File

@ -100,7 +100,6 @@
<Compile Include="Dispatcher.vb" />
<Compile Include="Exceptions.vb" />
<Compile Include="Adapters\Firebird.vb" />
<Compile Include="Helpers.vb" />
<Compile Include="IDatabase.vb" />
<Compile Include="Adapters\ODBC.vb" />
<Compile Include="Adapters\Oracle.vb" />

View File

@ -1,10 +0,0 @@
Public Class Helpers
Public Shared Function MaybeEscapeSQLCommand(pSQLCommand As String) As String
End Function
End Class

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Database")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("2.3.0.0")>
<Assembly: AssemblyTrademark("2.3.1.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.3.0.0")>
<Assembly: AssemblyFileVersion("2.3.0.0")>
<Assembly: AssemblyVersion("2.3.1.0")>
<Assembly: AssemblyFileVersion("2.3.1.0")>

View File

@ -109,11 +109,21 @@ Public Class File
''' <summary>
''' Adds file version string to given filename `Destination` if that file already exists.
''' </summary>
''' <param name="Destination"></param>
''' <returns></returns>
Public Function GetVersionedFilename(Destination As String) As String
''' <param name="pFilePath">Filepath to check</param>
''' <returns>Versioned string</returns>
Public Function GetVersionedFilename(pFilePath As String) As String
Return GetVersionedFilenameWithFilecheck(pFilePath, Function(pPath As String) IO.File.Exists(pFilePath))
End Function
''' <summary>
''' Adds file version string to given filename `Destination` if that file already exists.
''' </summary>
''' <param name="pFilePath">Filepath to check</param>
''' <param name="pFileExistsAction">Custom action to check for file existence</param>
''' <returns>Versioned string</returns>
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

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Filesystem")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.4.0.0")>
<Assembly: AssemblyTrademark("1.4.1.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.4.0.0")>
<Assembly: AssemblyFileVersion("1.4.0.0")>
<Assembly: AssemblyVersion("1.4.1.0")>
<Assembly: AssemblyFileVersion("1.4.1.0")>

View File

@ -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

View File

@ -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)

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Interfaces")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.9.0.0")>
<Assembly: AssemblyTrademark("1.10.0.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.9.0.0")>
<Assembly: AssemblyFileVersion("1.9.0.0")>
<Assembly: AssemblyVersion("1.10.0.0")>
<Assembly: AssemblyFileVersion("1.10.0.0")>

View File

@ -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
''' <summary>
@ -89,14 +105,14 @@ Public Class ZUGFeRDInterface
''' </summary>
''' <param name="Path"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
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
''' <summary>
@ -104,14 +120,14 @@ Public Class ZUGFeRDInterface
''' </summary>
''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
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
''' <summary>
@ -120,7 +136,7 @@ Public Class ZUGFeRDInterface
''' <param name="pStream"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns>The embedded xml data as an XPath document</returns>
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
''' <param name="pPath"></param>
''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns>The embedded xml data as an XPath document</returns>
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

View File

@ -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
''' <summary>
''' Document version, eg. ZUGFeRD Schema version
''' </summary>
Public Specification As String
End Class

View File

@ -116,9 +116,9 @@
</Compile>
</ItemGroup>
<ItemGroup>
<Reference Include="DigitalData.Modules.Language, Version=1.6.2.0, Culture=neutral, processorArchitecture=MSIL">
<Reference Include="DigitalData.Modules.Language, Version=1.7.0.0, Culture=neutral, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>..\Interfaces\bin\Debug\DigitalData.Modules.Language.dll</HintPath>
<HintPath>..\Language\bin\Debug\DigitalData.Modules.Language.dll</HintPath>
</Reference>
<Reference Include="FirebirdSql.Data.FirebirdClient, Version=7.5.0.0, Culture=neutral, PublicKeyToken=3750abcc3150b00c, processorArchitecture=MSIL">
<HintPath>..\packages\FirebirdSql.Data.FirebirdClient.7.5.0\lib\net452\FirebirdSql.Data.FirebirdClient.dll</HintPath>

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.11.0.0")>
<Assembly: AssemblyTrademark("1.12.0.1")>
<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("1.11.0.0")>
<Assembly: AssemblyFileVersion("1.11.0.0")>
<Assembly: AssemblyVersion("1.12.0.1")>
<Assembly: AssemblyFileVersion("1.12.0.1")>

View File

@ -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)

View File

@ -20,9 +20,9 @@
Public Const EMAIL_MD5_ERROR = "<p>Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.</p>"
Public Const EMAIL_TOO_MUCH_FERDS = "<p>Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.</p>"
Public Const EMAIL_TOO_MUCH_FERDS = "<p>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</p>"
Public Const EMAIL_NO_FERDS = "<p>Ihre Email enthielt keine ZUGFeRD-Dokumente.</p>"
Public Const EMAIL_NO_FERDS = "<p>Ihre Email ({0}) enthielt keine ZUGFeRD-Dokumente.</p>"
Public Const EMAIL_FILE_SIZE_REACHED = "
<p>Die von Ihnen gesendete Rechnung oder einer der Rechnungs-Anhänge überschreitet die erlaubte Größe von <strong>{0} MB</strong>.</p>
@ -32,13 +32,13 @@
"
Public Const EMAIL_INVALID_DOCUMENT = "
<p>Ihre Email enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
<p>Ihre Email ({0}) enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.</p>
<p>Mögliche Gründe für ein inkorrektes Format:<ul>
<li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p>
"
Public Const EMAIL_UNSUPPORTED_DOCUMENT = "
<p>Ihre Email enthielt ein ZUGFeRD Dokument ({0}), welches zur Zeit noch nicht unsterstützt wird.</p>
<p>Ihre Email ({0}) enthielt ein ZUGFeRD Format ({1}), welches zur Zeit noch nicht freigeschaltet ist.</p>
"
End Class

View File

@ -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,

View File

@ -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

View File

@ -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
''' <returns>True, if debug log will be written. False otherwise.</returns>
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
''' <summary>
''' Reconfigures and re-adds all loggers, optionally adding the debug rule.
''' </summary>
''' <param name="Debug">Adds the Debug rule if true.</param>
''' <param name="Trace">Adds the Trace rule if true.</param>
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

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Logging")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("2.6.0.0")>
<Assembly: AssemblyTrademark("2.6.2.0")>
<Assembly: ComVisible(False)>
@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.6.0.0")>
<Assembly: AssemblyFileVersion("2.6.0.0")>
<Assembly: AssemblyVersion("2.6.2.0")>
<Assembly: AssemblyFileVersion("2.6.2.0")>

View File

@ -98,6 +98,10 @@
<DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile>
<Compile Include="MailSender.vb" />
<Compile Include="WCF\Binding.vb" />
<Compile Include="WCF\Channel.vb" />
<Compile Include="WCF\Constants.vb" />
<Compile Include="WCF\ServerAddress.vb" />
</ItemGroup>
<ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx">

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Messaging")>
<Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.8.0.0")>
<Assembly: AssemblyTrademark("1.9.0.0")>
<Assembly: ComVisible(False)>

31
Messaging/WCF/Binding.vb Normal file
View File

@ -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

52
Messaging/WCF/Channel.vb Normal file
View File

@ -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
''' <summary>
''' Creates a channel and adds a Faulted-Handler
''' </summary>
''' <returns>A channel object</returns>
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
''' <summary>
''' Creates and returns a channel factory with the supplied name and address
''' </summary>
''' <param name="pName">The service name, will be: net.tcp://ip:port/DigitalData/Services/[name]</param>
''' <param name="pAddress">The service address, in the form of ip address and port</param>
''' <returns></returns>
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

View File

@ -0,0 +1,20 @@
Namespace WCF
Public Class Constants
Public Const DEFAULT_SERVICE_PORT = 9000
''' <summary>
''' Infos about MaxBufferSize and MaxBufferPoolSize
''' https://social.msdn.microsoft.com/Forums/vstudio/en-US/d6e234d3-942f-4e9d-8470-32618d3f3212/maxbufferpoolsize-vs-maxbuffersize?forum=wcf
''' </summary>
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

View File

@ -0,0 +1,7 @@
Namespace WCF
Public Structure ServerAddress
Public Host As String
Public Port As Integer
End Structure
End Namespace

View File

@ -637,6 +637,7 @@ Public Class Windream
Return False
End Try
End Function
''' <summary>
''' Archives windream object immediately
''' </summary>
@ -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
''' <summary>
''' Returns the result of a search file
''' </summary>