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 pSqlCommandObject.CommandTimeout = pTimeout
Using oAdapter As New SqlDataAdapter(pSqlCommandObject) 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) oAdapter.Fill(oTable)
End Using End Using
@ -427,7 +427,7 @@ Public Class MSSQLServer
Dim oTransaction As SqlTransaction = MaybeGetTransaction(pSqlConnection, pTransactionMode, pTransaction) Dim oTransaction As SqlTransaction = MaybeGetTransaction(pSqlConnection, pTransactionMode, pTransaction)
Try 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.Connection = pSqlConnection
pSqlCommandObject.Transaction = oTransaction pSqlCommandObject.Transaction = oTransaction
@ -517,6 +517,9 @@ Public Class MSSQLServer
Dim oResult As Object = Nothing Dim oResult As Object = Nothing
Try Try
Logger.Debug("GetScalarValueWithConnectionObject: Running Query [{0}] with Parameters [{1}]", pSqlCommandObject, GetParameterListAsString(pSqlCommandObject))
pSqlCommandObject.Connection = pSqlConnection pSqlCommandObject.Connection = pSqlConnection
pSqlCommandObject.CommandTimeout = pTimeout pSqlCommandObject.CommandTimeout = pTimeout
pSqlCommandObject.Transaction = oTransaction pSqlCommandObject.Transaction = oTransaction
@ -601,4 +604,13 @@ Public Class MSSQLServer
Dim res = command.EndExecuteNonQuery(result) Dim res = command.EndExecuteNonQuery(result)
Logger.Info("Finished executing Async database operation: {0}", command.CommandText) Logger.Info("Finished executing Async database operation: {0}", command.CommandText)
End Sub 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 End Class

View File

@ -100,7 +100,6 @@
<Compile Include="Dispatcher.vb" /> <Compile Include="Dispatcher.vb" />
<Compile Include="Exceptions.vb" /> <Compile Include="Exceptions.vb" />
<Compile Include="Adapters\Firebird.vb" /> <Compile Include="Adapters\Firebird.vb" />
<Compile Include="Helpers.vb" />
<Compile Include="IDatabase.vb" /> <Compile Include="IDatabase.vb" />
<Compile Include="Adapters\ODBC.vb" /> <Compile Include="Adapters\ODBC.vb" />
<Compile Include="Adapters\Oracle.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: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Database")> <Assembly: AssemblyProduct("Modules.Database")>
<Assembly: AssemblyCopyright("Copyright © 2022")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("2.3.0.0")> <Assembly: AssemblyTrademark("2.3.1.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.3.0.0")> <Assembly: AssemblyVersion("2.3.1.0")>
<Assembly: AssemblyFileVersion("2.3.0.0")> <Assembly: AssemblyFileVersion("2.3.1.0")>

View File

@ -109,11 +109,21 @@ Public Class File
''' <summary> ''' <summary>
''' Adds file version string to given filename `Destination` if that file already exists. ''' Adds file version string to given filename `Destination` if that file already exists.
''' </summary> ''' </summary>
''' <param name="Destination"></param> ''' <param name="pFilePath">Filepath to check</param>
''' <returns></returns> ''' <returns>Versioned string</returns>
Public Function GetVersionedFilename(Destination As String) As String 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 Try
Dim oFileName As String = Destination Dim oFileName As String = pFilePath
Dim oFinalFileName = oFileName Dim oFinalFileName = oFileName
Dim oDestinationDir = Path.GetDirectoryName(oFileName) Dim oDestinationDir = Path.GetDirectoryName(oFileName)
@ -131,7 +141,7 @@ Public Class File
' Shorten the filename (only filename, without extension or version) ' 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. ' 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. ' 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("Filename is too long. Filename will be cut to prevent further errors.")
_Logger.Info("Original Filename is: {0}", oFileNameWithoutExtension) _Logger.Info("Original Filename is: {0}", oFileNameWithoutExtension)
Dim oNewLength As Integer = Math.Round(oFileNameWithoutExtension.Length / 2) 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("Intermediate Filename is {0}", oFinalFileName)
_Logger.Debug("File version: {0}", oFileVersion) _Logger.Debug("File version: {0}", oFileVersion)
oFileVersion += 1 oFileVersion += 1
Loop While (IO.File.Exists(oFinalFileName)) Loop While pFileExistsAction(oFinalFileName) = True
_Logger.Debug("Final Filename is {0}", oFinalFileName) _Logger.Debug("Final Filename is {0}", oFinalFileName)
Return oFinalFileName Return oFinalFileName
Catch ex As Exception 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) _Logger.Error(ex)
Return Destination Return pFilePath
End Try End Try
End Function End Function
@ -195,6 +205,8 @@ Public Class File
oStringVersion = 1 oStringVersion = 1
End If End If
_Logger.Debug("Versioned: String [{0}], Version [{1}]", pString, oStringVersion)
Return New Tuple(Of String, Integer)(pString, oStringVersion) Return New Tuple(Of String, Integer)(pString, oStringVersion)
End Function End Function

View File

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

View File

@ -193,6 +193,8 @@ Public Class ActiveDirectoryInterface
.FirebirdSyskey = oMap.FirebirdSyskey, .FirebirdSyskey = oMap.FirebirdSyskey,
.MSSQLColumn = oMap.MSSQLColumn .MSSQLColumn = oMap.MSSQLColumn
}) })
Else
_logger.Debug("Attribute [{0}] is empty.", oMap.AttributeName)
End If End If
Next Next
Else Else

View File

@ -8,6 +8,7 @@ Public Class ADUser
Public Property GivenName As String Public Property GivenName As String
Public Property Middlename As String Public Property Middlename As String
Public Property Email As String Public Property Email As String
Public Property Language As String
Public CustomAttributes As List(Of CustomAttribute) Public CustomAttributes As List(Of CustomAttribute)

View File

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

View File

@ -12,6 +12,13 @@ Public Class ZUGFeRDInterface
Private ReadOnly _logger As Logger Private ReadOnly _logger As Logger
Private ReadOnly _Options As ZugferdOptions 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 { 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,
@ -35,6 +42,15 @@ Public Class ZUGFeRDInterface
Public Class ZugferdOptions Public Class ZugferdOptions
Public Property AllowFacturX_Filename As Boolean = True Public Property AllowFacturX_Filename As Boolean = True
Public Property AllowXRechnung_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 End Class
''' <summary> ''' <summary>
@ -89,14 +105,14 @@ Public Class ZUGFeRDInterface
''' </summary> ''' </summary>
''' <param name="Path"></param> ''' <param name="Path"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As Tuple(Of String, Object) Public Function ExtractZUGFeRDFileWithGDPicture(Path As String) As ZugferdResult
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Path) Dim oResult = ValidateZUGFeRDFileWithGDPicture(Path)
If IsNothing(oXmlDocument.Item2) Then If IsNothing(oResult.SchemaObject) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If End If
Return SerializeZUGFeRDDocument(oXmlDocument) Return SerializeZUGFeRDDocument(oResult)
End Function End Function
''' <summary> ''' <summary>
@ -104,14 +120,14 @@ Public Class ZUGFeRDInterface
''' </summary> ''' </summary>
''' <param name="Stream"></param> ''' <param name="Stream"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As Tuple(Of String, Object) Public Function ExtractZUGFeRDFileWithGDPicture(Stream As Stream) As ZugferdResult
Dim oXmlDocument = ValidateZUGFeRDFileWithGDPicture(Stream) Dim oResult = ValidateZUGFeRDFileWithGDPicture(Stream)
If IsNothing(oXmlDocument.Item2) Then If IsNothing(oResult.SchemaObject) Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei.")
End If End If
Return SerializeZUGFeRDDocument(oXmlDocument) Return SerializeZUGFeRDDocument(oResult)
End Function End Function
''' <summary> ''' <summary>
@ -120,7 +136,7 @@ Public Class ZUGFeRDInterface
''' <param name="pStream"></param> ''' <param name="pStream"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns>The embedded xml data as an XPath document</returns> ''' <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) Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Try Try
@ -148,7 +164,7 @@ Public Class ZUGFeRDInterface
''' <param name="pPath"></param> ''' <param name="pPath"></param>
''' <exception cref="ZUGFeRDExecption"></exception> ''' <exception cref="ZUGFeRDExecption"></exception>
''' <returns>The embedded xml data as an XPath document</returns> ''' <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) Dim oEmbedExtractor = New PDFEmbeds(_logConfig)
Try Try
@ -170,7 +186,7 @@ Public Class ZUGFeRDInterface
End Try End Try
End Function 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 If pResults Is Nothing Then
Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.") Throw New ZUGFeRDExecption(ErrorType.NoZugferd, "Datei ist keine ZUGFeRD Datei, weil die Attachments nicht gelesen werden konnten.")
End If End If
@ -200,7 +216,10 @@ Public Class ZUGFeRDInterface
Try Try
Using oStream As New MemoryStream(oAllowedResult.FileContents) 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 End Using
Catch ex As ZUGFeRDExecption Catch ex As ZUGFeRDExecption
@ -214,44 +233,59 @@ Public Class ZUGFeRDInterface
End Try End Try
End Function 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 Try
Dim oNavigator As XPathNavigator = pDocument.Item2.CreateNavigator() Dim oNavigator As XPathNavigator = pResult.XPathObject.CreateNavigator()
Dim oReader As XmlReader Dim oReader As XmlReader
Dim oResult = Nothing
Dim oTypes As New List(Of Type) From { Dim oObject As Object = Nothing
GetType(ZUGFeRD.Version1_0.CrossIndustryDocumentType), Dim oSpecification As String = Nothing
GetType(ZUGFeRD.Version2_0.CrossIndustryInvoiceType),
GetType(ZUGFeRD.Version2_1_1.CrossIndustryInvoiceType),
GetType(ZUGFeRD.Version2_2_FacturX.CrossIndustryInvoiceType)
}
For Each oType In oTypes Dim oAllowedTypes As New Dictionary(Of String, Type)
_logger.Debug("Trying Type [{0}]", oType.FullName)
Dim oSerializer As New XmlSerializer(oType) 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 Try
oReader = oNavigator.ReadSubtree() 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 Exit For
Catch ex As Exception 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.Debug(ex.Message)
_logger.Error(ex.InnerException?.Message) _logger.Error(ex.InnerException?.Message)
End Try End Try
Next 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.") Throw New ApplicationException("No Types matched the given document. Document could not be serialized.")
End If End If
Return oResult pResult.Specification = oSpecification
pResult.SchemaObject = oObject
Return pResult
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _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 Try
End Function End Function

View File

@ -1,8 +1,14 @@
Public Class XmlItemProperty Public Class XmlItemProperty
Public IsRequired As Boolean
Public IsGrouped As Boolean
Public TableName As String Public TableName As String
Public TableColumn As String Public TableColumn As String
Public Description As String Public Description As String
Public IsRequired As Boolean
Public IsGrouped As Boolean
Public GroupScope As String Public GroupScope As String
''' <summary>
''' Document version, eg. ZUGFeRD Schema version
''' </summary>
Public Specification As String
End Class End Class

View File

@ -116,9 +116,9 @@
</Compile> </Compile>
</ItemGroup> </ItemGroup>
<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> <SpecificVersion>False</SpecificVersion>
<HintPath>..\Interfaces\bin\Debug\DigitalData.Modules.Language.dll</HintPath> <HintPath>..\Language\bin\Debug\DigitalData.Modules.Language.dll</HintPath>
</Reference> </Reference>
<Reference Include="FirebirdSql.Data.FirebirdClient, Version=7.5.0.0, Culture=neutral, PublicKeyToken=3750abcc3150b00c, processorArchitecture=MSIL"> <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> <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: AssemblyCompany("Digital Data")>
<Assembly: AssemblyProduct("Modules.Jobs")> <Assembly: AssemblyProduct("Modules.Jobs")>
<Assembly: AssemblyCopyright("Copyright © 2022")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.11.0.0")> <Assembly: AssemblyTrademark("1.12.0.1")>
<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("1.11.0.0")> <Assembly: AssemblyVersion("1.12.0.1")>
<Assembly: AssemblyFileVersion("1.11.0.0")> <Assembly: AssemblyFileVersion("1.12.0.1")>

View File

@ -1,5 +1,6 @@
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Language
Imports System.Data Imports System.Data
Imports System.IO Imports System.IO
Imports System.Data.SqlClient Imports System.Data.SqlClient
@ -164,10 +165,19 @@ Public Class EmailFunctions
_logger.Debug("Got Email Data for FileId {0}", MessageId) _logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1) 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 { Return New EmailData() With {
.From = oRow.Item("EMAIL_FROM"), .From = oFrom,
.Attachment = oRow.Item("EMAIL_ATTMT1"), .Attachment = oAttachment,
.Subject = oRow.Item("EMAIL_SUBJECT") .Subject = oSubject
} }
Catch ex As Exception Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId) _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_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 = " 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> <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 = " 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> <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> <li>Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)</li>
</ul></p> </ul></p>
" "
Public Const EMAIL_UNSUPPORTED_DOCUMENT = " 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 End Class

View File

@ -206,7 +206,9 @@ Public Class ImportZUGFeRDFiles
' different versions of ZUGFeRD and the type is unknown at compile-time. ' 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 ' 17.11.2022: oDocument is now a Tuple of (String, Object), to be able to return the filename
' of the extracted xml file. ' 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 ' Start a global group counter for each file
Dim oGlobalGroupCounter = 0 Dim oGlobalGroupCounter = 0
@ -283,7 +285,8 @@ Public Class ImportZUGFeRDFiles
' Check the document against the configured property map and return: ' Check the document against the configured property map and return:
' - a List of valid properties ' - a List of valid properties
' - a List of missing 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) _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. ' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but unsupported format", oFBTransaction) 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 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) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "UnsupportedFerdException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "UnsupportedFerdException", "Nicht unterstütztes Datenformat", "", oSQLTransaction) 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. ' That 's why we set it to String.Empty here.
Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oFBTransaction) Create_HistoryEntry(oMessageId, String.Empty, "REJECTED - ZUGFeRD yes but incorrect format", oFBTransaction)
Dim oBody = EmailStrings.EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_INVALID_DOCUMENT, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "InvalidFerdException", "Inkorrekte Formate", "", oSQLTransaction) 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) 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 oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_TOO_MUCH_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "", oSQLTransaction) 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) Create_HistoryEntry(oMessageId, oMD5CheckSum, "REJECTED - no ZUGFeRD-Document in email", oFBTransaction)
Dim oBody = EmailStrings.EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId) Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oMessageId)
Dim oBody = String.Format(EmailStrings.EMAIL_NO_FERDS, oEmailData.Subject)
_email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal) _email.AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException", _EmailOutAccountId, oArgs.NamePortal)
AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction) AddRejectedState(oMessageId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "", oSQLTransaction)
@ -576,6 +583,26 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Sub 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( Private Sub MoveFiles(
Args As WorkerArgs, Args As WorkerArgs,
MessageId As String, MessageId As String,

View File

@ -26,4 +26,6 @@ Public Class WorkerArgs
Public AllowFacturX As Boolean = True Public AllowFacturX As Boolean = True
Public AllowXRechnung As Boolean = True Public AllowXRechnung As Boolean = True
Public AllowZugferd10 As Boolean = True
Public AllowZugferd2x As Boolean = True
End Class 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_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_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_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_DEFAULT As String = "defaultTarget"
Private Const TARGET_ERROR_EX As String = "errorExceptionTarget" Private Const TARGET_ERROR_EX As String = "errorExceptionTarget"
Private Const TARGET_ERROR As String = "errorTarget" Private Const TARGET_ERROR As String = "errorTarget"
Private Const TARGET_DEBUG As String = "debugTarget" Private Const TARGET_DEBUG As String = "debugTarget"
Private Const TARGET_TRACE As String = "traceTarget" Private Const TARGET_TRACE As String = "traceTarget"
Private Const TARGET_JSON As String = "jsonTarget"
'Private Const TARGET_MEMORY As String = "memoryTarget" 'Private Const TARGET_MEMORY As String = "memoryTarget"
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}"
@ -101,8 +103,9 @@ Public Class LogConfig
Private ReadOnly _basePath As String = _failSafePath Private ReadOnly _basePath As String = _failSafePath
Private _config As LoggingConfiguration Private _config As LoggingConfiguration
Private _isDebug As Boolean = False Private _EnableDebugLogging As Boolean = False
Private _isTrace As Boolean = False Private _EnableTraceLogging As Boolean = False
Private _EnableJsonLogging As Boolean = False
#End Region #End Region
#Region "Public Properties" #Region "Public Properties"
@ -137,21 +140,31 @@ Public Class LogConfig
''' <returns>True, if debug log will be written. False otherwise.</returns> ''' <returns>True, if debug log will be written. False otherwise.</returns>
Public Property Debug As Boolean Public Property Debug As Boolean
Get Get
Return _isDebug Return _EnableDebugLogging
End Get End Get
Set(isDebug As Boolean) Set(value As Boolean)
_isDebug = isDebug _EnableDebugLogging = value
ReloadConfig(isDebug, _isTrace) ReloadConfig()
End Set End Set
End Property End Property
Public Property Trace As Boolean Public Property Trace As Boolean
Get Get
Return _isTrace Return _EnableTraceLogging
End Get End Get
Set(isTrace As Boolean) Set(value As Boolean)
_isTrace = isTrace _EnableTraceLogging = value
ReloadConfig(_isDebug, isTrace) 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 Set
End Property End Property
@ -443,6 +456,7 @@ Public Class LogConfig
_config.AddTarget(TARGET_DEFAULT, GetDefaultLogTarget(_basePath)) _config.AddTarget(TARGET_DEFAULT, GetDefaultLogTarget(_basePath))
_config.AddTarget(TARGET_DEBUG, GetDebugLogTarget(_basePath)) _config.AddTarget(TARGET_DEBUG, GetDebugLogTarget(_basePath))
_config.AddTarget(TARGET_TRACE, GetTraceLogTarget(_basePath)) _config.AddTarget(TARGET_TRACE, GetTraceLogTarget(_basePath))
_config.AddTarget(TARGET_JSON, GetJsonLogTarget(_basePath))
'_config.AddTarget(TARGET_MEMORY, GetMemoryDebugTarget()) '_config.AddTarget(TARGET_MEMORY, GetMemoryDebugTarget())
' Add default rules ' Add default rules
@ -478,9 +492,7 @@ Public Class LogConfig
''' <summary> ''' <summary>
''' Reconfigures and re-adds all loggers, optionally adding the debug rule. ''' Reconfigures and re-adds all loggers, optionally adding the debug rule.
''' </summary> ''' </summary>
''' <param name="Debug">Adds the Debug rule if true.</param> Private Sub ReloadConfig()
''' <param name="Trace">Adds the Trace rule if true.</param>
Private Sub ReloadConfig(Optional Debug As Boolean = False, Optional Trace As Boolean = False)
Dim oLogger = GetLogger() Dim oLogger = GetLogger()
' Clear Logging Rules ' Clear Logging Rules
@ -489,15 +501,22 @@ Public Class LogConfig
' Add default rules ' Add default rules
AddDefaultRules(_config) 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 ' Add debug rule, if configured
If Debug = True Then If _EnableDebugLogging = True Then
_config.AddRule(LogLevel.Debug, LogLevel.Error, TARGET_DEBUG) _config.AddRule(LogLevel.Debug, LogLevel.Error, TARGET_DEBUG)
oLogger.Info("DEBUG Logging is now Enabled.") oLogger.Info("DEBUG Logging is now Enabled.")
Else Else
oLogger.Debug("DEBUG Logging is now Disabled.") oLogger.Debug("DEBUG Logging is now Disabled.")
End If End If
If Trace = True Then ' Add trace rule, if configured
If _EnableTraceLogging = True Then
_config.AddRule(LogLevel.Trace, LogLevel.Error, TARGET_TRACE) _config.AddRule(LogLevel.Trace, LogLevel.Error, TARGET_TRACE)
End If End If
@ -506,6 +525,29 @@ Public Class LogConfig
End Sub End Sub
#Region "Log Targets" #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 Private Function GetDefaultLogTarget(basePath As String) As FileTarget
Dim defaultLog As New FileTarget() With { Dim defaultLog As New FileTarget() With {
.FileName = Path.Combine(basePath, FILE_NAME_FORMAT_DEFAULT), .FileName = Path.Combine(basePath, FILE_NAME_FORMAT_DEFAULT),
@ -565,9 +607,9 @@ Public Class LogConfig
End Function End Function
Private Function GetTraceLogTarget(basePath As String) As FileTarget 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), .FileName = Path.Combine(basePath, FILE_NAME_FORMAT_TRACE),
.Name = TARGET_DEBUG, .Name = TARGET_TRACE,
.Layout = LOG_FORMAT_DEBUG, .Layout = LOG_FORMAT_DEBUG,
.MaxArchiveFiles = MAX_ARCHIVE_FILES_DEBUG_DETAIL, .MaxArchiveFiles = MAX_ARCHIVE_FILES_DEBUG_DETAIL,
.ArchiveEvery = ARCHIVE_EVERY, .ArchiveEvery = ARCHIVE_EVERY,
@ -578,18 +620,7 @@ Public Class LogConfig
.Encoding = Text.Encoding.Unicode .Encoding = Text.Encoding.Unicode
} }
Return debugLog Return traceLog
End Function 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 Region
End Class End Class

View File

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

View File

@ -98,6 +98,10 @@
<DesignTimeSharedInput>True</DesignTimeSharedInput> <DesignTimeSharedInput>True</DesignTimeSharedInput>
</Compile> </Compile>
<Compile Include="MailSender.vb" /> <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>
<ItemGroup> <ItemGroup>
<EmbeddedResource Include="My Project\Resources.resx"> <EmbeddedResource Include="My Project\Resources.resx">

View File

@ -13,7 +13,7 @@ Imports System.Runtime.InteropServices
<Assembly: AssemblyCompany("")> <Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("Messaging")> <Assembly: AssemblyProduct("Messaging")>
<Assembly: AssemblyCopyright("Copyright © 2022")> <Assembly: AssemblyCopyright("Copyright © 2022")>
<Assembly: AssemblyTrademark("1.8.0.0")> <Assembly: AssemblyTrademark("1.9.0.0")>
<Assembly: ComVisible(False)> <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 Return False
End Try End Try
End Function End Function
''' <summary> ''' <summary>
''' Archives windream object immediately ''' Archives windream object immediately
''' </summary> ''' </summary>
@ -653,7 +654,7 @@ Public Class Windream
End Try End Try
End Function 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 If Not TestSessionLoggedIn() Then
Return False Return False
End If End If
@ -664,13 +665,11 @@ Public Class Windream
Dim oFolderObject As WMObject Dim oFolderObject As WMObject
Dim oCurrentPath As String = String.Empty Dim oCurrentPath As String = String.Empty
For Each oFolder In oFolders For Each oFolder In oFolders
If oFolder.ToString.EndsWith(pExtension) Then If oFolder = String.Empty Then
Exit For
ElseIf oFolder = String.Empty Then
Continue For Continue For
End If End If
oCurrentPath = Combine(oCurrentPath, oFolder) oCurrentPath = Combine(oCurrentPath, oFolder)
If TestFolderExists(oCurrentPath) = False Then 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 Public Function NewFileStream(ByVal FilenameSource As String, ByVal FilenameTarget As String, ByVal WMObjecttypeName As String) As Boolean
NewDocumentID = 0 NewDocumentID = 0
Dim oExtension As String = Path.GetExtension(FilenameSource)
If Not TestSessionLoggedIn() Then If Not TestSessionLoggedIn() Then
Return False Return False
End If End If
Dim oTargetDrive As String = Path.GetDirectoryName(FilenameTarget) Dim oTargetDrive As String = Path.GetDirectoryName(FilenameTarget)
FilenameTarget = GetNormalizedPath(FilenameTarget, True) FilenameTarget = GetNormalizedPath(FilenameTarget, True)
_logger.Debug($"Preparing to stream file from {FilenameSource} to {FilenameTarget}") _logger.Debug($"Preparing to stream file from {FilenameSource} to {FilenameTarget}")
@ -721,7 +720,7 @@ Public Class Windream
Dim oFileIO As WMFileIO Dim oFileIO As WMFileIO
Dim oWMStream As WMStream Dim oWMStream As WMStream
NewFolder(FilenameTarget, oExtension) NewFolder(oTargetDrive)
'Indexierungsdialog der Session unterdrücken 'Indexierungsdialog der Session unterdrücken
Session.SwitchEvents(Constants.COM_EVENT_SESSION_NEED_INDEX, False) Session.SwitchEvents(Constants.COM_EVENT_SESSION_NEED_INDEX, False)
@ -777,7 +776,6 @@ Public Class Windream
oWMStream.Close() oWMStream.Close()
_logger.Debug("Saving new object") _logger.Debug("Saving new object")
oWMObject.aObjectType = GetObjectByName(WMObjecttypeName, WMEntityObjectType) oWMObject.aObjectType = GetObjectByName(WMObjecttypeName, WMEntityObjectType)
oWMObject.Save() oWMObject.Save()
@ -817,24 +815,20 @@ Public Class Windream
End Try End Try
End Function End Function
Public Function GetNormalizedPath(Path As String, pCleanPath As Boolean) As String Public Function GetNormalizedPath(pPath As String, pCleanPath As Boolean) As String
_logger.Debug("Normalizing Path: [{0}]", Path) _logger.Debug("Normalizing Path: [{0}]", pPath)
Dim oNormalizedPath As String = Path Dim oNormalizedPath As String = pPath
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
If pCleanPath = True Then
oNormalizedPath = Utils.RemoveInvalidCharacters(pPath)
_logger.Debug("Path after RemoveInvalidCharacters: [{0}]", oNormalizedPath)
End If
Try
' Remove Driveletter, eg. W:\ ' Remove Driveletter, eg. W:\
If oNormalizedPath.StartsWith($"{ClientDriveLetter}:\") Then If oNormalizedPath.StartsWith($"{ClientDriveLetter}:\") Then
oNormalizedPath = oNormalizedPath.Substring(ClientDriveLetter.Length + 2) oNormalizedPath = oNormalizedPath.Substring(ClientDriveLetter.Length + 2)
_logger.Debug($"path after replaced ClientDriveLetter: [{oNormalizedPath}]") _logger.Debug($"Path after replaced ClientDriveLetter: [{oNormalizedPath}]")
End If End If
' Remove Windream Base Path, eg. \\windream\objects\ ' Remove Windream Base Path, eg. \\windream\objects\
@ -845,22 +839,41 @@ Public Class Windream
' Handle misconfigured drive-letter ' Handle misconfigured drive-letter
If oNormalizedPath.Contains(":") Then 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}]") _logger.Warn($"Check Your config ClientDriveLetter [{ClientDriveLetter}] // ClientBasePath [{ClientBasePath}]")
oNormalizedPath = oNormalizedPath.Substring(3) oNormalizedPath = oNormalizedPath.Substring(3)
End If 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 If oNormalizedPath.StartsWith("\") = False Then
oNormalizedPath = $"\{oNormalizedPath}" oNormalizedPath = $"\{oNormalizedPath}"
End If End If
_logger.Debug($"oNormalizedPath: [{oNormalizedPath}]")
_logger.Debug($"NormalizedPath: [{oNormalizedPath}]")
Return oNormalizedPath Return oNormalizedPath
Catch ex As Exception 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 "" Return ""
End Try End Try
End Function End Function
Public Function GetAbsolutePath(pPath As String) As String
Dim oNormalizedPath = GetNormalizedPath(pPath, False)
Return $"\\windream\objects{oNormalizedPath}"
End Function
''' <summary> ''' <summary>
''' Returns the result of a search file ''' Returns the result of a search file
''' </summary> ''' </summary>