This commit is contained in:
Digital Data - Marlon Schreiber 2019-05-10 14:46:26 +02:00
commit 252a8dffae
6 changed files with 174 additions and 57 deletions

View File

@ -1,9 +1,9 @@
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Class Form1 Partial Class Form1
Inherits System.Windows.Forms.Form Inherits System.Windows.Forms.Form
'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. 'Das Formular überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
<System.Diagnostics.DebuggerNonUserCode()> _ <System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try Try
If disposing AndAlso components IsNot Nothing Then If disposing AndAlso components IsNot Nothing Then
@ -20,7 +20,7 @@ Partial Class Form1
'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich. 'Hinweis: Die folgende Prozedur ist für den Windows Form-Designer erforderlich.
'Das Bearbeiten ist mit dem Windows Form-Designer möglich. 'Das Bearbeiten ist mit dem Windows Form-Designer möglich.
'Das Bearbeiten mit dem Code-Editor ist nicht möglich. 'Das Bearbeiten mit dem Code-Editor ist nicht möglich.
<System.Diagnostics.DebuggerStepThrough()> _ <System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent() Private Sub InitializeComponent()
Me.OpenFileDialog1 = New System.Windows.Forms.OpenFileDialog() Me.OpenFileDialog1 = New System.Windows.Forms.OpenFileDialog()
Me.Button1 = New System.Windows.Forms.Button() Me.Button1 = New System.Windows.Forms.Button()
@ -54,7 +54,7 @@ Partial Class Form1
' '
'Button2 'Button2
' '
Me.Button2.Location = New System.Drawing.Point(12, 41) Me.Button2.Location = New System.Drawing.Point(12, 122)
Me.Button2.Name = "Button2" Me.Button2.Name = "Button2"
Me.Button2.Size = New System.Drawing.Size(221, 23) Me.Button2.Size = New System.Drawing.Size(221, 23)
Me.Button2.TabIndex = 2 Me.Button2.TabIndex = 2
@ -63,7 +63,7 @@ Partial Class Form1
' '
'Button3 'Button3
' '
Me.Button3.Location = New System.Drawing.Point(12, 70) Me.Button3.Location = New System.Drawing.Point(12, 151)
Me.Button3.Name = "Button3" Me.Button3.Name = "Button3"
Me.Button3.Size = New System.Drawing.Size(221, 23) Me.Button3.Size = New System.Drawing.Size(221, 23)
Me.Button3.TabIndex = 3 Me.Button3.TabIndex = 3
@ -72,7 +72,7 @@ Partial Class Form1
' '
'Button4 'Button4
' '
Me.Button4.Location = New System.Drawing.Point(12, 112) Me.Button4.Location = New System.Drawing.Point(12, 193)
Me.Button4.Name = "Button4" Me.Button4.Name = "Button4"
Me.Button4.Size = New System.Drawing.Size(221, 23) Me.Button4.Size = New System.Drawing.Size(221, 23)
Me.Button4.TabIndex = 4 Me.Button4.TabIndex = 4
@ -82,7 +82,7 @@ Partial Class Form1
'txtMD5Checksum 'txtMD5Checksum
' '
Me.txtMD5Checksum.DataBindings.Add(New System.Windows.Forms.Binding("Text", Global.ZUGFeRDTest.My.MySettings.Default, "MD5Cheksum", True, System.Windows.Forms.DataSourceUpdateMode.OnPropertyChanged)) Me.txtMD5Checksum.DataBindings.Add(New System.Windows.Forms.Binding("Text", Global.ZUGFeRDTest.My.MySettings.Default, "MD5Cheksum", True, System.Windows.Forms.DataSourceUpdateMode.OnPropertyChanged))
Me.txtMD5Checksum.Location = New System.Drawing.Point(12, 141) Me.txtMD5Checksum.Location = New System.Drawing.Point(12, 222)
Me.txtMD5Checksum.Name = "txtMD5Checksum" Me.txtMD5Checksum.Name = "txtMD5Checksum"
Me.txtMD5Checksum.Size = New System.Drawing.Size(360, 20) Me.txtMD5Checksum.Size = New System.Drawing.Size(360, 20)
Me.txtMD5Checksum.TabIndex = 5 Me.txtMD5Checksum.TabIndex = 5

View File

@ -54,24 +54,28 @@ Public Class Form1
Return args Return args
End Function End Function
Private Function LoadPropertyMapFor(args As WorkerArgs, specification As String) Private Function LoadPropertyMapFor(Args As WorkerArgs, Specification As String)
Dim oSQL As String = $"SELECT * FROM TBEDM_XML_ITEMS WHERE SPECIFICATION = '{specification}' AND ACTIVE = True" Dim oSQL As String = $"SELECT * FROM TBEDM_XML_ITEMS WHERE SPECIFICATION = '{Specification}' AND ACTIVE = True"
Dim oResult As DataTable = _firebird.GetDatatable(oSQL) Dim oResult As DataTable = _firebird.GetDatatable(oSQL)
For Each row As DataRow In oResult.Rows For Each oRow As DataRow In oResult.Rows
Dim xmlPath = row.Item("XML_PATH") Dim xmlPath = oRow.Item("XML_PATH")
Dim tableName = row.Item("TABLE_NAME") Dim tableName = oRow.Item("TABLE_NAME")
Dim description = row.Item("DESCRIPTION") Dim description = oRow.Item("DESCRIPTION")
Dim isRequired = row.Item("IS_REQUIRED") Dim isRequired = oRow.Item("IS_REQUIRED")
Dim isGrouped = oRow.Item("IS_GROUPED")
Dim groupScope = oRow.Item("GROUP_SCOPE")
args.PropertyMap.Add(xmlPath, New XmlItemProperty() With { Args.PropertyMap.Add(xmlPath, New XmlItemProperty() With {
.Description = description, .Description = description,
.TableName = tableName, .TableName = tableName,
.IsRequired = isRequired .IsRequired = isRequired,
.IsGrouped = isGrouped,
.GroupScope = groupScope
}) })
Next Next
Return args Return Args
End Function End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

View File

@ -2,8 +2,10 @@
Imports System.Data Imports System.Data
Imports System.IO Imports System.IO
Imports System.Linq Imports System.Linq
Imports System.Reflection
Imports System.Security.Cryptography Imports System.Security.Cryptography
Imports System.Text.RegularExpressions Imports System.Text.RegularExpressions
Imports System.Xml
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Jobs.Exceptions Imports DigitalData.Modules.Jobs.Exceptions
@ -226,7 +228,7 @@ Public Class ImportZUGFeRDFiles
Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value
Dim oFileGroupId As String = oFileGroup.Key Dim oFileGroupId As String = oFileGroup.Key
Dim oMissingProperties As New List(Of String) Dim oMissingProperties As New List(Of String)
Dim oMD5CheckSum As String Dim oMD5CheckSum As String = String.Empty
_logger.NewBlock($"Message Id {oFileGroupId}") _logger.NewBlock($"Message Id {oFileGroupId}")
_logger.Info("Start processing file group {0}", oFileGroupId) _logger.Info("Start processing file group {0}", oFileGroupId)
@ -253,24 +255,23 @@ Public Class ImportZUGFeRDFiles
_logger.Warn("File is not a valid ZUGFeRD document! Skipping.") _logger.Warn("File is not a valid ZUGFeRD document! Skipping.")
Continue For Continue For
End Try End Try
oMD5CheckSum = checkMD5(oFile.FullName)
If oMD5CheckSum <> "" Then oMD5CheckSum = CreateMD5(oFile.FullName)
If oMD5CheckSum <> String.Empty Then
Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}')" Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}')"
Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction) Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction)
If Not IsNothing(oMD5DT) Then If Not IsNothing(oMD5DT) Then
If oMD5DT.Rows.Count = 1 Then If oMD5DT.Rows.Count = 1 Then
'Hier muss noch gepüft werden ob die Rechnung schon mal abgelehnt wurde?! 'TODO: Hier muss noch gepüft werden ob die Rechnung schon mal abgelehnt wurde?!
Throw New MD5HashException() Throw New MD5HashException()
End If End If
Else Else
_logger.Info("Be careful: oExistsDT is nothing!") _logger.Warn("Be careful: oExistsDT is nothing!")
End If End If
Else Else
_logger.Info("Be careful: oMD5CheckSum is nothing!") _logger.Warn("Be careful: oMD5CheckSum is nothing!")
End If End If
' Check if there are more than one ZUGFeRD files ' Check if there are more than one ZUGFeRD files
If oZUGFeRDCount = 1 Then If oZUGFeRDCount = 1 Then
Throw New TooMuchFerdsException() Throw New TooMuchFerdsException()
@ -279,24 +280,98 @@ Public Class ImportZUGFeRDFiles
' Since extraction went well, increase the amount of ZUGFeRD files ' Since extraction went well, increase the amount of ZUGFeRD files
oZUGFeRDCount += 1 oZUGFeRDCount += 1
For Each Item As KeyValuePair(Of String, XmlItemProperty) In args.PropertyMap ' PropertyMap items with `IsGrouped = False` are handled normally
Dim propertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key) Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = args.PropertyMap.
Dim propertyDescripton As String = Item.Value.Description Where(Function(Item As KeyValuePair(Of String, XmlItemProperty))
Return Item.Value.IsGrouped = False
End Function).
ToDictionary(Function(Item) Item.Key,
Function(Item) Item.Value)
If String.IsNullOrEmpty(propertyValue) Then ' PropertyMap items with `IsGrouped = True` are grouped by group scope
Dim oGroupedProperties = args.PropertyMap.
Where(Function(Item) Item.Value.IsGrouped = True).
ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope
Function(Item) Item)
' Iterate through groups to get group scope and group items
For Each oGroup In oGroupedProperties
Dim oGroupScope = oGroup.Key
Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
Dim oRowCount = 0
' get properties as a nested object, see `oPropertyList`
For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
Dim oPropertyValues As List(Of Object) = PropertyValues.GetPropValues(oDocument, oProperty.Key)
oPropertyList.Add(oProperty.Value, oPropertyValues)
' check the first batch of values to determine the row count
If oRowCount = 0 Then
oRowCount = oPropertyValues.Count
End If
Next
' Structure of oPropertyList
' [ # Propertyname # Row 1 # Row 2
' PositionsMenge: [BilledQuantity1, BilledQuantity2, ...],
' PositionsSteuersatz: [ApplicablePercent1, ApplicablePercent2, ...],
' ...
' ]
For oRowIndex = 0 To oRowCount - 1
For Each oColumn As KeyValuePair(Of XmlItemProperty, List(Of Object)) In oPropertyList
Dim oTableName As String = oColumn.Key.TableName
Dim oPropertyDescription As String = oColumn.Key.Description
Dim oPropertyValue = oColumn.Value.Item(oRowIndex)
Dim oRowCounter = oRowIndex + 1
If String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired Then
_logger.Warn("Property {0} is empty or not found. Continuing with Empty String.", oPropertyDescription)
oMissingProperties.Add(oPropertyDescription)
Else
_logger.Warn("Property {0} is empty or not found. Continuing with Empty String.", oPropertyDescription)
End If
oPropertyDescription = String.Empty
End If
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}', {oRowCounter})"
_logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2} with RowCounter {3}", oPropertyDescription, oPropertyValue, oTableName, oRowCounter)
' Insert into SQL Server
If args.InsertIntoSQLServer = True Then
Dim oResult = _mssql.NewExecutenonQuery(oCommand)
If oResult = False Then
_logger.Warn("SQL Command was not successful. Check the log.")
End If
End If
' Insert into Firebird
_firebird.ExecuteNonQueryWithConnection(oCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
Next
Next
Next
' Iterate through default properties
For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
Dim oPropertyValue As String = PropertyValues.GetPropValue(oDocument, Item.Key)
Dim oPropertyDescription As String = Item.Value.Description
If String.IsNullOrEmpty(oPropertyValue) Then
If Item.Value.IsRequired Then If Item.Value.IsRequired Then
_logger.Warn("Property {0} is empty but marked as required! Skipping.", propertyDescripton) _logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription)
oMissingProperties.Add(propertyDescripton) oMissingProperties.Add(oPropertyDescription)
Continue For Continue For
Else Else
_logger.Debug("Property {0} is empty or not found. Skipping.", propertyDescripton) _logger.Debug("Property {0} is empty or not found. Skipping.", oPropertyDescription)
Continue For Continue For
End If End If
End If End If
Dim oTableName = Item.Value.TableName Dim oTableName = Item.Value.TableName
Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{propertyDescripton}', '{propertyValue}')" Dim oCommand = $"INSERT INTO {oTableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE) VALUES ('{oFileGroupId}', '{oPropertyDescription}', '{oPropertyValue}')"
_logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2}", propertyDescripton, propertyValue, oTableName) _logger.Debug("Mapping Property {0} to value {1}. Will be inserted into table {2}", oPropertyDescription, oPropertyValue, oTableName)
' Insert into SQL Server ' Insert into SQL Server
If args.InsertIntoSQLServer = True Then If args.InsertIntoSQLServer = True Then
@ -322,10 +397,11 @@ Public Class ImportZUGFeRDFiles
'If no errors occurred... 'If no errors occurred...
'Log the History 'Log the History
If oMD5CheckSum <> "" Then If oMD5CheckSum <> String.Empty Then
Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oFileGroupId}', '{oMD5CheckSum}')" Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oFileGroupId}', '{oMD5CheckSum}')"
_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction) _firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
End If End If
'commit the transaction 'commit the transaction
oTransaction.Commit() oTransaction.Commit()
Catch ex As MD5HashException Catch ex As MD5HashException
@ -333,7 +409,7 @@ Public Class ImportZUGFeRDFiles
oMoveDirectory = args.ErrorDirectory oMoveDirectory = args.ErrorDirectory
Dim oBody = "<p>The invoice attached to Your email has already been worked in our system.</p>" Dim oBody = "<p>The invoice attached to your email has already been processed in our system.</p>"
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId) Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData) AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As TooMuchFerdsException Catch ex As TooMuchFerdsException
@ -360,6 +436,11 @@ Public Class ImportZUGFeRDFiles
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties) Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId) Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData) AddToEmailQueue(oFileGroupId, oBody, oEmailData)
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
oMoveDirectory = args.ErrorDirectory
Finally Finally
oConnection.Close() oConnection.Close()
@ -384,7 +465,6 @@ Public Class ImportZUGFeRDFiles
End Try End Try
End Sub End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String)) Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>" Dim oBody = $"<p>The following file is not ZUGFeRD-compliant: {OriginalFilename}</p>"
@ -400,24 +480,23 @@ Public Class ImportZUGFeRDFiles
Return oBody Return oBody
End Function End Function
Private Function checkMD5(ByVal filename As String) As String Private Function CreateMD5(ByVal Filename As String) As String
Try Try
Dim MD5 As New MD5CryptoServiceProvider Dim oMD5 As New MD5CryptoServiceProvider
Dim Hash As Byte() Dim oHash As Byte()
Dim Result As String = "" Dim oHashString As String
Dim Tmp As String = "" Dim oResult As String = ""
Dim FN As New FileStream(filename, FileMode.Open, FileAccess.Read, FileShare.Read, 8192) Using oFileStream As New FileStream(Filename, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
MD5.ComputeHash(FN) oHash = oMD5.ComputeHash(oFileStream)
FN.Close() oHashString = BitConverter.ToString(oHash)
End Using
Hash = MD5.Hash oResult = oHashString.Replace("-", "")
Result = Strings.Replace(BitConverter.ToString(Hash), "-", "") Return oResult
Return Result
Catch ex As Exception Catch ex As Exception
_logger.Error(ex) _logger.Error(ex)
Return "" Return ""
End Try End Try
End Function End Function
End Class End Class

View File

@ -1,13 +1,24 @@
Imports System.Reflection Imports System.Collections.Generic
Imports System.Reflection
Imports System.Text.RegularExpressions Imports System.Text.RegularExpressions
Public Class PropertyValues Public Class PropertyValues
Private Shared _indexPattern = "\((\d+)\)" Private Shared _indexPattern = "\((\d+)\)"
Private Shared _indexRegex As Regex = New Regex(_indexPattern) Private Shared _indexRegex As New Regex(_indexPattern)
Public Shared Function GetPropValues(Obj As Object, PropertyName As String)
Dim oResult As Object = GetPropValue(Obj, PropertyName)
' Wrap the result of `GetPropValue` in a list if a single Value is returned
If TypeOf oResult Is List(Of Object) Then
Return oResult
Else
Return New List(Of Object) From {oResult}
End If
End Function
Public Shared Function GetPropValue(Obj As Object, PropertyName As String) Public Shared Function GetPropValue(Obj As Object, PropertyName As String)
Dim oNameParts As String() = PropertyName.Split("."c) Dim oNameParts As String() = PropertyName.Split("."c)
Dim oIndexReplaceRegex = "\(\d+\)"
If IsNothing(Obj) Then If IsNothing(Obj) Then
Return Nothing Return Nothing
@ -34,15 +45,37 @@ Public Class PropertyValues
Return Nothing Return Nothing
End If End If
Obj = oInfo.GetValue(Obj, Nothing) If IsNothing(oInfo.GetValue(Obj, Nothing)) Then
If IsNothing(Obj) Then
Return Nothing Return Nothing
End If End If
Obj = oInfo.GetValue(Obj, Nothing)
If oHasIndex Then If oHasIndex Then
Obj = Obj(0) Obj = Obj(0)
End If End If
If IsArray(Obj) And Not oHasIndex Then
Dim oCurrentPart As String = oPart
Dim oSplitString As String() = New String() {"." & oCurrentPart & "."}
Dim oPathFragments = PropertyName.Split(oSplitString, StringSplitOptions.None)
Dim oResults As New List(Of Object)
' if path has no more subitems, return an empty list
If oPathFragments.Length = 1 Then
Return oResults
End If
For Each oArrayItem In Obj
Dim oResult = GetPropValue(oArrayItem, oPathFragments(1))
If Not IsNothing(oResult) Then
oResults.Add(oResult)
End If
Next
Return oResults
End If
Next Next
Return Obj Return Obj
@ -67,6 +100,4 @@ Public Class PropertyValues
Private Shared Function HasIndex(Prop As String) As Boolean Private Shared Function HasIndex(Prop As String) As Boolean
Return Regex.IsMatch(Prop, _indexPattern) Return Regex.IsMatch(Prop, _indexPattern)
End Function End Function
End Class End Class

View File

@ -2,4 +2,6 @@
Public TableName As String Public TableName As String
Public Description As String Public Description As String
Public IsRequired As Boolean Public IsRequired As Boolean
Public IsGrouped As Boolean
Public GroupScope As String
End Class End Class

View File

@ -118,6 +118,7 @@
<Reference Include="System.ServiceModel" /> <Reference Include="System.ServiceModel" />
<Reference Include="System.Transactions" /> <Reference Include="System.Transactions" />
<Reference Include="System.Xml" /> <Reference Include="System.Xml" />
<Reference Include="System.XML.Linq" />
</ItemGroup> </ItemGroup>
<Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" /> <Import Project="$(MSBuildToolsPath)\Microsoft.VisualBasic.targets" />
</Project> </Project>