Imports System.Collections.Generic
Imports System.Data
Imports System.IO
Imports System.Linq
Imports System.Reflection
Imports System.Security.Cryptography
Imports System.Text.RegularExpressions
Imports System.Xml
Imports DigitalData.Modules.Filesystem
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Interfaces.Exceptions
Imports DigitalData.Modules.Jobs.Exceptions
Imports DigitalData.Modules.Logging
Imports FirebirdSql.Data.FirebirdClient
Public Class ImportZUGFeRDFiles
Implements IJob
Public Const ZUGFERD_IN = "ZUGFeRD in"
Public Const ZUGFERD_ERROR = "ZUGFeRD Error"
Public Const ZUGFERD_SUCCESS = "ZUGFeRD Success"
Public Const ZUGFERD_EML = "ZUGFeRD Eml"
Public Const ZUGFERD_REJECTED_EML = "ZUGFeRD Eml Rejected"
Public Const ZUGFERD_ATTACHMENTS = "ZUGFeRD Attachments"
Public HISTORY_ID As Integer
Private Const EMAIL_WRAPPING_TEXT = "Sehr geehrte Damen und Herren,
das WISAG-Portal zur Verarbeitung der Eingangsrechnungen im ZUGFeRD-Format konnte die von Ihnen gesandte Rechnung
leider nicht verarbeiten!
Grund: {0}Bitte prüfen Sie die Datei und nehmen Sie bei Bedarf mit uns Kontakt auf.
Vielen Dank für Ihr Verständnis.
Mit freundlichen Grüßen
Ihre IT-Abteilung"
Private Const EMAIL_SUBJECT = "WISAG ZUGFeRD Portal: Beleg abgelehnt"
Private Const EMAIL_MISSINGPROPERTIES_1 = "
Die angehängte Datei entspricht nicht dem WISAG ZUGFeRD-Format: {0}
"
Private Const EMAIL_MISSINGPROPERTIES_2 = "Die folgenden Eigenschaften wurden als ERFORDERLICH eingestuft, wurden aber nicht gefunden:
"
Private Const EMAIL_MD5_ERROR = "Die von Ihnen gesendete Rechnung wurde bereits von unserem System verarbeitet.
"
Private Const EMAIL_TOO_MUCH_FERDS = "Ihre Email enthielt mehr als ein ZUGFeRD-Dokument.
"
Private Const EMAIL_NO_FERDS = "Ihre Email enthielt keine ZUGFeRD-Dokumente.
"
Private Const EMAIL_INVALID_DOCUMENT = """
Ihre Email enthielt ein ZUGFeRD Dokument, welches aber inkorrekt formatiert wurde.
Mögliche Gründe für ein inkorrektes Format:
- Betrags-Werte weisen ungültiges Format auf (25,01 anstatt 25.01)
"""
' List of allowed extensions for PDF/A Attachments
Private AllowedExtensions = New List(Of String) From {"docx", "doc", "pdf", "xls", "xlsx", "ppt", "pptx", "txt"}
Private _logger As Logger
Private _logConfig As LogConfig
Private _zugferd As ZUGFeRDInterface
Private _firebird As Firebird
Private _filesystem As Filesystem.File
Private _mssql As MSSQLServer
Public Sub New(LogConfig As LogConfig, Firebird As Firebird, Optional MSSQL As MSSQLServer = Nothing)
_logConfig = LogConfig
_logger = LogConfig.GetLogger()
_firebird = Firebird
_filesystem = New Filesystem.File(_logConfig)
_zugferd = New ZUGFeRDInterface(_logConfig)
_mssql = MSSQL
End Sub
Private Function RandomValue(lowerBound As Integer, upperBound As Integer) As Integer
Dim oRandomValue = CInt(Math.Floor((upperBound - lowerBound + 1) * Rnd())) + lowerBound
Return oRandomValue
End Function
Private Function GetEmailDataForMessageId(MessageId As String) As EmailData
Dim oSQL = $"SELECT EMAIL_FROM, EMAIL_SUBJECT, EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Try
Dim oDatatable = _firebird.GetDatatable(oSQL)
Dim oRow As DataRow
If oDatatable.Rows.Count = 0 Then
_logger.Warn("Got no results for MessageId {0}", MessageId)
Return Nothing
ElseIf oDatatable.Rows.Count > 1 Then
_logger.Warn("Got too many results for MessageId {0}. Using first row.", MessageId)
End If
_logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(0)
Return New EmailData() With {
.From = oRow.Item("EMAIL_FROM"),
.Attachment = oRow.Item("EMAIL_ATTMT1"),
.Subject = oRow.Item("EMAIL_SUBJECT")
}
Catch ex As Exception
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
Return Nothing
End Try
End Function
Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
Dim oAttachmentDirectory = OriginalEmailDirectory
Dim oAttachmentFile = MessageId & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
If IO.File.Exists(oAttachmentPath) Then
Return oAttachmentPath
Else
Return String.Empty
End If
End Function
Private Function GetEmailPathWithSubjectAsName(RejectedEmailDirectory As String, UncleanedSubject As String) As String
Dim oCleanSubject = String.Join("", UncleanedSubject.Split(Path.GetInvalidPathChars()))
Dim oAttachmentDirectory = RejectedEmailDirectory
Dim oAttachmentFile = oCleanSubject & ".eml"
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
Return oAttachmentPath
End Function
Private Function MoveAndRenameEmailToRejected(Args As WorkerArgs, MessageId As String) As EmailData
Dim oEmailData = GetEmailDataForMessageId(MessageId)
Dim oSource = GetOriginalEmailPath(Args.OriginalEmailDirectory, MessageId)
Dim oDestination As String
' If oEmailData is Nothing, TBEDM_EMAIL_PROFILER_HISTORY for MessageId was not found.
' This only should happen when testing and db-tables are deleted frequently
If oEmailData Is Nothing Then
oDestination = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, MessageId)
Else
oDestination = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
End If
_logger.Debug("Destination for eml file is {0}", oDestination)
Dim oFinalFileName = _filesystem.GetVersionedFilename(oDestination)
_logger.Debug("Versioned filename for eml file is {0}", oFinalFileName)
If oEmailData Is Nothing Then
_logger.Warn("Could not get Email Data from database. File {0} will not be moved!", oSource)
Return Nothing
End If
Try
_logger.Info("Moving email from {0} to {1}", oSource, oFinalFileName)
IO.File.Move(oSource, oFinalFileName)
oEmailData.Attachment = oFinalFileName
Catch ex As Exception
_logger.Warn("File {0} could not be moved! Original Filename will be used!", oSource)
_logger.Error(ex)
oEmailData.Attachment = oSource
End Try
Return oEmailData
End Function
Private Sub AddRejectedState(oMessageID As String, oTitle As String, oTitle1 As String, oComment As String)
Try
Dim oSQL = $"EXEC PRCUST_ADD_HISTORY_STATE '{oMessageID}','{oTitle}','{oTitle1}','{oComment}'"
_mssql.NewExecutenonQuery(oSQL)
'@MessageID VARCHAR(250), @TITLE1 VARCHAR(250), @TITLE2 VARCHAR(250)
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Private Sub AddToEmailQueueFB(MessageId As String, BodyText As String, EmailData As EmailData)
If EmailData Is Nothing Then
_logger.Warn("EmailData is empty. Email will not be sent!")
Exit Sub
End If
Try
Dim oJobId = RandomValue(1, 10000)
Dim oReference = MessageId
Dim oEmailTo = ""
Dim oSubject = EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EMAIL_WRAPPING_TEXT, BodyText)
Dim oEmailAddress = EmailData.From
Dim oAttachment = EmailData.Attachment
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId)
oEmailTo = String.Empty
Else
oEmailTo = oEmailAddress
End If
_logger.Debug("Generated Email:")
_logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject)
_logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE1 = '{oReference} and EMAIL_TO = ''{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
Dim oDTResult As DataTable = _firebird.GetDatatable(osql)
If oDTResult.Rows.Count = 0 Then
Dim oSQLInsert = $"INSERT INTO TBEDM_EMAIL_QUEUE "
oSQLInsert &= "(JOB_ID, REFERENCE1, EMAIL_ACCOUNT_ID, EMAIL_TO, EMAIL_SUBJ, EMAIL_BODY, CREATEDWHO, EMAIL_ATTMT1) VALUES "
oSQLInsert &= $"({oJobId}, '{oReference}', {oAccountId}, '{oEmailTo}', '{oSubject}', '{oFinalBodyText.Replace("'", "''")}', '{oCreatedWho}', '{oAttachment}')"
_firebird.ExecuteNonQuery(oSQLInsert)
_logger.Debug("Email Queue updated for MessageId {0}.", MessageId, oEmailTo)
Else
_logger.Debug("Email has already been sent!!")
End If
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Private Sub AddToEmailQueueMSSQL(MessageId As String, BodyText As String, EmailData As EmailData, SourceProcedure As String)
If EmailData Is Nothing Then
_logger.Warn("EmailData is empty. Email will not be sent!")
Exit Sub
End If
Try
Dim oJobId = RandomValue(1, 10000)
Dim oReference = MessageId
Dim oEmailTo = ""
Dim oSubject = EMAIL_SUBJECT
Dim oAccountId = 1
Dim oCreatedWho = "ZUGFeRD Service"
Dim oFinalBodyText = String.Format(EMAIL_WRAPPING_TEXT, BodyText)
Dim oEmailAddress = EmailData.From
Dim oAttachment = EmailData.Attachment
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_logger.Warn("Could not find email-address for MessageId {0}", MessageId)
oEmailTo = String.Empty
Else
oEmailTo = oEmailAddress
End If
_logger.Debug("Generated Email:")
_logger.Debug("To: {0}", oEmailTo)
_logger.Debug("Subject: {0}", oSubject)
_logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim oHistoryID = _mssql.GetScalarValue(osql)
'osql = $"select * from TBEMLP_EMAIL_OUT where REFERENCE_ID = {oHistoryID} and EMAIL_ADRESS = '{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
'Dim oDTResult As DataTable = _mssql.GetDatatable(osql)
If IsNumeric(oHistoryID) Then
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] (
[REMINDER_TYPE_ID]
,[SENDING_PROFILE]
,[REFERENCE_ID]
,[REFERENCE_STRING]
,[WF_ID]
,[EMAIL_ADRESS]
,[EMAIL_SUBJ]
,[EMAIL_BODY]
,[COMMENT]
,[ADDED_WHO])
VALUES
(77
,{oAccountId}
,{oHistoryID}
,'{MessageId}'
,77
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{SourceProcedure}'
,'{oCreatedWho}')"
_mssql.ExecuteNonQuery(oInsert)
Else
'If oDTResult.Rows.Count = 0 Then
' _logger.Debug("Email has already been sent!!")
'Else
_logger.Warn("Could not get oHistoryID in AddToEmailQueueMSSQL!!")
' End If
End If
Catch ex As Exception
_logger.Error(ex)
End Try
End Sub
Private Function GetMessageIdFromFileName(Filename As String) As String
' Regex to find MessageId
' See also: https://stackoverflow.com/questions/3968500/regex-to-validate-a-message-id-as-per-rfc2822
Dim oRegex = "(((([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(""(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21\x23-\x5B\x5D-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*""))@(([a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*)|(\[(([\x01-\x08\x0B\x0C\x0E-\x1F\x7F]|[\x21-\x5A\x5E-\x7E])|(\\[\x01-\x09\x0B\x0C\x0E-\x7F]))*\]))))~.+"
Dim oMatch = Regex.Match(Filename, oRegex, RegexOptions.IgnoreCase)
If oMatch.Success Then
Dim oMessageId = oMatch.Groups(1).Value
Return oMessageId
Else
Return Nothing
End If
End Function
Private Function GroupFiles(Files As List(Of FileInfo)) As Dictionary(Of String, List(Of FileInfo))
Dim oGrouped As New Dictionary(Of String, List(Of FileInfo))
If Files.Count = 0 Then
Return oGrouped
End If
For Each oFile In Files
Dim oMessageId = GetMessageIdFromFileName(oFile.Name)
If oMessageId Is Nothing Then
_logger.Warn("File {0} did not have the required filename-format!", oMessageId)
Continue For
End If
If oGrouped.ContainsKey(oMessageId) Then
oGrouped.Item(oMessageId).Add(oFile)
Else
oGrouped.Add(oMessageId, New List(Of FileInfo) From {oFile})
End If
Next
Return oGrouped
End Function
Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments
Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFAttachments(_logConfig, oArgs.GDPictureKey)
_logger.Debug("Starting Job {0}", [GetType].Name)
Try
For Each oPath As String In oArgs.WatchDirectories
Dim oDirInfo As New DirectoryInfo(oPath)
_logger.Debug($"Start processing directory {oDirInfo.FullName}")
If oDirInfo.Exists Then
' Filter out *.lock files
Dim oFiles As List(Of FileInfo) = oDirInfo.
GetFiles().
Where(Function(f) Not f.Name.EndsWith(".lock")).
ToList()
Dim oFileCount = oFiles.Count
Dim oCurrentFileCount = 0
If oFileCount = 0 Then
_logger.Debug("No files to process.")
Continue For
Else
_logger.Info("Found {0} files", oFileCount)
End If
' Group files by messageId
Dim oGrouped As Dictionary(Of String, List(Of FileInfo)) = GroupFiles(oFiles)
_logger.Info("Found {0} file groups", oGrouped.Count)
' Process each file group together
For Each oFileGroup In oGrouped
' Start a new transaction for each file group.
' This way we can rollback database changes for the whole filegroup in case something goes wrong.
Dim oConnection As FbConnection = _firebird.GetConnection()
Dim oTransaction As FbTransaction = oConnection.BeginTransaction()
' Count the amount of ZUGFeRD files
Dim oZUGFeRDCount As Integer = 0
' Set the default Move Directory
Dim oMoveDirectory As String = oArgs.SuccessDirectory
' Create file lists
Dim oFileGroupFiles As List(Of FileInfo) = oFileGroup.Value
Dim oFileAttachmentFiles As New List(Of FileInfo)
Dim oFileGroupId As String = oFileGroup.Key
Dim oMissingProperties As New List(Of String)
Dim oMD5CheckSum As String = String.Empty
_logger.NewBlock($"Message Id {oFileGroupId}")
_logger.Info("Start processing file group {0}", oFileGroupId)
Try
For Each oFile In oFileGroupFiles
Dim oDocument As CrossIndustryDocumentType
' Start a global group counter for each file
Dim oGlobalGroupCounter = 0
' Clear missing properties for the new file
oMissingProperties = New List(Of String)
oCurrentFileCount += 1
' Only pdf files are allowed from here on
If Not oFile.Name.EndsWith(".pdf") Then
_logger.Debug("Skipping non-pdf file {0}", oFile.Name)
oFileAttachmentFiles.Add(oFile)
Continue For
End If
_logger.Info("Start processing file {0}", oFile.Name)
Try
oDocument = _zugferd.ExtractZUGFeRDFile(oFile.FullName)
Catch ex As ZUGFeRDExecption
Select Case ex.ErrorType
Case ZUGFeRDInterface.ErrorType.NoZugferd
_logger.Warn("File is not a valid ZUGFeRD document! Skipping.")
oFileAttachmentFiles.Add(oFile)
Continue For
Case ZUGFeRDInterface.ErrorType.NoValidZugferd
_logger.Warn("File is an Incorrectly formatted ZUGFeRD document!")
Throw New InvalidFerdException()
Case Else
_logger.Warn("Unexpected Error occurred while extracting ZUGFeRD Information from file {0}", oFile.FullName)
Throw ex
End Select
End Try
Dim oAttachments = oAttachmentExtractor.Extract(oFile.FullName, AllowedExtensions)
If oAttachments Is Nothing Then
_logger.Warn("Attachments for file [{0}] could not be extracted", oFile.FullName)
Else
oFileAttachmentFiles.AddRange(oFileGroupFiles)
oFileAttachmentFiles.AddRange(oAttachments)
End If
oMD5CheckSum = CreateMD5(oFile.FullName)
If oMD5CheckSum <> String.Empty Then
Dim oCheckCommand = $"SELECT * FROM TBEDM_ZUGFERD_HISTORY_IN WHERE GUID = (SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE UPPER(MD5HASH) = UPPER('{oMD5CheckSum}'))"
Dim oMD5DT As DataTable = _firebird.GetDatatable(oCheckCommand, Firebird.TransactionMode.ExternalTransaction)
If Not IsNothing(oMD5DT) Then
If oMD5DT.Rows.Count = 1 Then
Dim oRejected As Boolean
Try
oRejected = CBool(oMD5DT.Rows(0).Item("REJECTED"))
Catch ex As Exception
_logger.Warn("Error while converting REJECTED: " & ex.Message)
oRejected = False
End Try
If oRejected = False Then
HISTORY_ID = oMD5DT.Rows(0).Item("GUID")
Throw New MD5HashException()
Else
_logger.Info("ZuGFeRDFile already has been worked, but formerly obviously was rejected!")
End If
End If
Else
_logger.Warn("Be careful: oExistsDT is nothing!")
End If
Else
_logger.Warn("Be careful: oMD5CheckSum is nothing!")
End If
' Check if there are more than one ZUGFeRD files
If oZUGFeRDCount = 1 Then
Throw New TooMuchFerdsException()
End If
' Since extraction went well, increase the amount of ZUGFeRD files
oZUGFeRDCount += 1
' PropertyMap items with `IsGrouped = False` are handled normally
Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap.
Where(Function(Item As KeyValuePair(Of String, XmlItemProperty))
Return Item.Value.IsGrouped = False
End Function).
ToDictionary(Function(Item) Item.Key,
Function(Item) Item.Value)
_logger.Debug("Found {0} default properties.", oDefaultProperties.Count)
' PropertyMap items with `IsGrouped = True` are grouped by group scope
Dim oGroupedProperties = oArgs.PropertyMap.
Where(Function(Item) Item.Value.IsGrouped = True).
ToLookup(Function(Item) Item.Value.GroupScope, ' Lookup key is group scope
Function(Item) Item)
_logger.Debug("Found {0} properties grouped in {1} group(s)", oArgs.PropertyMap.Count - oDefaultProperties.Count, oGroupedProperties.Count)
' Iterate through groups to get group scope and group items
For Each oGroup In oGroupedProperties
Dim oGroupScope As String = oGroup.Key
Dim oPropertyList As New Dictionary(Of XmlItemProperty, List(Of Object))
Dim oRowCount = 0
_logger.Debug("Fetching Property values for group {0}.", oGroupScope)
' get properties as a nested object, see `oPropertyList`
For Each oProperty As KeyValuePair(Of String, XmlItemProperty) In oGroup
Dim oPropertyValues As List(Of Object)
Try
oPropertyValues = oPropertyExtractor.GetPropValue(oDocument, oProperty.Key)
Catch ex As Exception
_logger.Warn("Unknown error occurred while fetching property [{0}] in group [{1}]:", oProperty.Value.Description, oGroupScope)
_logger.Error(ex)
oPropertyValues = New List(Of Object)
End Try
' Flatten result value
oPropertyValues = oPropertyExtractor.GetFinalPropValue(oPropertyValues)
' Add to list
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
_logger.Debug("Processing row {0}", oRowIndex)
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 oRowCounter = oRowIndex + oGlobalGroupCounter + 1
' Returns nothing if oColumn.Value contains an empty list
Dim oPropertyValue = oColumn.Value.ElementAtOrDefault(oRowIndex)
_logger.Debug("Processing property {0}.", oPropertyDescription)
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If oColumn.Key.IsRequired Then
_logger.Warn("Property [{0}] is empty or not found but is required. Continuing with Empty String.", oPropertyDescription)
oMissingProperties.Add(oPropertyDescription)
Else
_logger.Debug("Property [{0}] is empty or not found. Continuing with Empty String.", oPropertyDescription)
End If
oPropertyValue = String.Empty
End If
_logger.Debug("Property {0} has value '{1}'", oPropertyDescription, oPropertyValue)
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 oArgs.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
oGlobalGroupCounter += oRowCount
Next
' Iterate through default properties
For Each Item As KeyValuePair(Of String, XmlItemProperty) In oDefaultProperties
Dim oPropertyValueList As List(Of Object)
Dim oPropertyDescription As String = Item.Value.Description
Dim oPropertyValue As Object = Nothing
Try
oPropertyValueList = oPropertyExtractor.GetPropValue(oDocument, Item.Key)
Catch ex As Exception
_logger.Warn("Unknown error occurred while fetching property {0} in group {1}:", oPropertyDescription, Item.Value.GroupScope)
_logger.Error(ex)
oPropertyValueList = New List(Of Object)
End Try
Try
If IsNothing(oPropertyValueList) Then
oPropertyValue = Nothing
ElseIf TypeOf oPropertyValueList Is List(Of Object) Then
Select Case oPropertyValueList.Count
Case 0
oPropertyValue = Nothing
Case Else
Dim oList As List(Of Object) = DirectCast(oPropertyValueList, List(Of Object))
oPropertyValue = oList.Item(0)
' This should hopefully show config errors
If TypeOf oPropertyValue Is List(Of Object) Then
_logger.Warn("Property with Description {0} may be configured incorrectly", oPropertyDescription)
oPropertyValue = Nothing
End If
End Select
End If
Catch ex As Exception
_logger.Warn("Unknown error occurred while processing property {0}:", oPropertyDescription)
_logger.Error(ex)
oPropertyValue = Nothing
End Try
If IsNothing(oPropertyValue) OrElse String.IsNullOrEmpty(oPropertyValue) Then
If Item.Value.IsRequired Then
_logger.Warn("Property {0} is empty but marked as required! Skipping.", oPropertyDescription)
oMissingProperties.Add(oPropertyDescription)
Continue For
Else
_logger.Debug("Property [{0}] is empty or not found. Skipping.", oPropertyDescription)
Continue For
End If
End If
Dim oTableName = Item.Value.TableName
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}", oPropertyDescription, oPropertyValue, oTableName)
' Insert into SQL Server
If oArgs.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
If oMissingProperties.Count > 0 Then
Throw New MissingValueException(oFile)
End If
Next
'Check if there are no ZUGFeRD files
If oZUGFeRDCount = 0 Then
Throw New NoFerdsException()
End If
'If no errors occurred...
'Log the History
If oMD5CheckSum <> String.Empty Then
Dim oInsertCommand = $"INSERT INTO TBEDM_ZUGFERD_HISTORY_IN (MESSAGE_ID, MD5HASH) VALUES ('{oFileGroupId}', '{oMD5CheckSum}')"
_firebird.ExecuteNonQueryWithConnection(oInsertCommand, oConnection, Firebird.TransactionMode.ExternalTransaction, oTransaction)
'commit the transaction
oTransaction.Commit()
Try
Dim oSQL = $"SELECT MAX(GUID) FROM TBEDM_ZUGFERD_HISTORY_IN WHERE MESSAGE_ID = '{oFileGroupId}'"
HISTORY_ID = _firebird.GetScalarValue(oSQL)
Catch ex As Exception
HISTORY_ID = 0
End Try
End If
Catch ex As MD5HashException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Already processed (MD5Hash)' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "MD5HashException")
AddRejectedState(oFileGroupId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
Catch ex As InvalidFerdException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - ZUGFeRD yes but incorrect format' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "InvalidFerdException")
AddRejectedState(oFileGroupId, "InvalidFerdException", "Inkorrekte Formate", "")
Catch ex As TooMuchFerdsException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - More than one ZUGFeRD-document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_TOO_MUCH_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "TooMuchFerdsException")
AddRejectedState(oFileGroupId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
Catch ex As NoFerdsException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - no ZUGFeRD-Document in email' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "NoFerdsException")
AddRejectedState(oFileGroupId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
Catch ex As MissingValueException
_logger.Error(ex)
oMoveDirectory = oArgs.ErrorDirectory
Dim oMessage As String = ""
For Each prop In oMissingProperties
oMessage &= $"- {prop}"
Next
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Missing Required Properties: {oMessage}' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "MissingValueException")
AddRejectedState(oFileGroupId, "MissingValueException", "Es fehlten ZugferdSpezifikationen", oMessage)
Catch ex As Exception
_logger.Warn("Unknown Error occurred: {0}", ex.Message)
_logger.Error(ex)
Dim oSQL = $"UPDATE TBEDM_ZUGFERD_HISTORY_IN SET COMMENT = 'REJECTED - Unknown error occured' WHERE GUID = '{HISTORY_ID}'"
_firebird.ExecuteNonQuery(oSQL)
oMoveDirectory = oArgs.ErrorDirectory
AddRejectedState(oFileGroupId, "UnexpectedException", "", ex.Message)
Finally
oConnection.Close()
' Move all files of the current group
Try
MoveFiles(oArgs, oFileGroupFiles, oFileAttachmentFiles, oMoveDirectory)
_logger.Info("Finished processing file group {0}", oFileGroupId)
Catch ex As Exception
_logger.Warn("Could not move files!")
_logger.Error(ex)
Throw ex
Finally
_logger.EndBlock()
End Try
End Try
Next
End If
Next
_logger.Debug("Finishing Job {0}", Me.GetType.Name)
Catch ex As Exception
_logger.Error(ex)
_logger.Info("Job Failed! See error log for details")
End Try
End Sub
Private Sub MoveFiles(Args As WorkerArgs, Files As List(Of FileInfo), AttachmentFiles As List(Of FileInfo), MoveDirectory As String)
For Each oFile In Files
Try
Dim oFinalMoveDirectory As String = MoveDirectory
If AttachmentFiles.Contains(oFile) Then
oFinalMoveDirectory = Path.Combine(MoveDirectory, Args.AttachmentsSubDirectory)
If Not Directory.Exists(oFinalMoveDirectory) Then
Directory.CreateDirectory(oFinalMoveDirectory)
End If
End If
Dim oFileName = _filesystem.GetVersionedFilename(Path.Combine(oFinalMoveDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFileName, oFinalMoveDirectory)
_logger.Info("Finished processing file {0}", oFile.Name)
_logger.Info("File moved to {0}", oFileName)
Catch ex As Exception
_logger.Warn("Could not move file {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
End Sub
Private Function CreateBodyForMissingProperties(OriginalFilename As String, MissingProperties As List(Of String))
Dim oBody = String.Format(EMAIL_MISSINGPROPERTIES_1, OriginalFilename)
If MissingProperties.Count > 0 Then
oBody &= $"{vbNewLine}{vbNewLine}"
oBody &= EMAIL_MISSINGPROPERTIES_2
oBody &= $"{vbNewLine}{vbNewLine}"
For Each prop In MissingProperties
oBody &= $"- {prop}"
Next
End If
Return oBody
End Function
Private Function CreateMD5(ByVal Filename As String) As String
Try
Dim oMD5 As New MD5CryptoServiceProvider
Dim oHash As Byte()
Dim oHashString As String
Dim oResult As String = ""
Using oFileStream As New FileStream(Filename, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
oHash = oMD5.ComputeHash(oFileStream)
oHashString = BitConverter.ToString(oHash)
End Using
oResult = oHashString.Replace("-", "")
Return oResult
Catch ex As Exception
_logger.Error(ex)
Return ""
End Try
End Function
End Class