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
Imports GdPicture14
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 last row.", MessageId)
End If
_logger.Debug("Got Email Data for FileId {0}", MessageId)
oRow = oDatatable.Rows.Item(oDatatable.Rows.Count - 1)
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, pEmailData As EmailData, SourceProcedure As String)
If pEmailData 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 = pEmailData.From
Dim oAttachment = pEmailData.Attachment
If oAttachment <> String.Empty Then
_logger.Debug($"Attachment_String [{oAttachment}]!")
If IO.File.Exists(oAttachment) = False Then
_logger.Info($"Attachment.File [{oAttachment}] is not existing!!!")
End If
End If
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]
,EMAIL_ATTMT1)
VALUES
(77
,{oAccountId}
,{oHistoryID}
,'{MessageId}'
,77
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{SourceProcedure}'
,'{oCreatedWho}'
,'{oAttachment}')"
_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
Public Sub Start(Arguments As Object) Implements IJob.Start
Dim oArgs As WorkerArgs = Arguments
Dim oPropertyExtractor = New PropertyValues(_logConfig)
Dim oAttachmentExtractor = New PDFAttachments(_logConfig)
_logger.Debug("Starting Job {0}", [GetType].Name)
_logger.Debug("Registering GDPicture License")
If _mssql IsNot Nothing Then
Try
Dim oSQL = "SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'"
Dim oLicenseKey As String = _mssql.GetScalarValue(oSQL)
Dim oLicenseManager As New LicenseManager
oLicenseManager.RegisterKEY(oLicenseKey)
Catch ex As Exception
_logger.Error(ex)
_logger.Warn("GDPicture License could not be retrieved! Query failed! Exiting job.")
Exit Sub
End Try
Else
_logger.Warn("GDPicture License could not be retrieved! MSSQL is not enabled! Exiting job.")
Exit Sub
End If
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)) = _zugferd.FileGroup.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 oEmailAttachmentFiles As New List(Of FileInfo)
Dim oEmbeddedAttachmentFiles As New List(Of PDFAttachments.AttachmentResult)
Dim oMessageId As String = oFileGroup.Key
Dim oMissingProperties As New List(Of String)
Dim oMD5CheckSum As String = String.Empty
_logger.NewBlock($"Message Id {oMessageId}")
_logger.Info("Start processing file group {0}", oMessageId)
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)
oEmailAttachmentFiles.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.")
oEmailAttachmentFiles.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
' Extract all attachments other than the zugferd-invoice.xml
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
oEmbeddedAttachmentFiles.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($"There is already an identical invoice! - HistoryID [{HISTORY_ID}]")
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
' --- BEGIN Check Property Values
'' PropertyMap items with `IsGrouped = False` are handled normally
'Dim oDefaultProperties As Dictionary(Of String, XmlItemProperty) = oArgs.PropertyMap.
' Where(Function(Item) Item.Value.IsGrouped = True).
' 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 ('{oMessageId}', '{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 ('{oMessageId}', '{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
'--- END Check Property Values
' Check the document against the configured property map and return:
' - a List of valid properties
' - a List of missing properties
Dim oCheckResult = _zugferd.PropertyValues.CheckPropertyValues(oDocument, oArgs.PropertyMap, oMessageId)
If oCheckResult.MissingProperties.Count > 0 Then
Throw New MissingValueException(oFile)
End If
For Each oProperty In oCheckResult.ValidProperties
Dim oGroupCounterValue = Nothing
If oProperty.GroupCounter > -1 Then
oGroupCounterValue = oProperty.GroupCounter
End If
Dim oCommand = $"INSERT INTO {oProperty.TableName} (REFERENCE_GUID, ITEM_DESCRIPTION, ITEM_VALUE, GROUP_COUNTER) VALUES ('{oMessageId}', '{oProperty.Description}', '{oProperty.Value}', {oGroupCounterValue})"
_logger.Debug("Mapping Property [{0}] to value [{1}] . Will be inserted into table {2}", oProperty.Description, oProperty.Value, oProperty.TableName)
' 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
'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 ('{oMessageId}', '{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 = '{oMessageId}'"
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, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MD5HashException")
AddRejectedState(oMessageId, "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, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "InvalidFerdException")
AddRejectedState(oMessageId, "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, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "TooMuchFerdsException")
AddRejectedState(oMessageId, "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, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "NoFerdsException")
AddRejectedState(oMessageId, "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, oMessageId)
AddToEmailQueueMSSQL(oMessageId, oBody, oEmailData, "MissingValueException")
AddRejectedState(oMessageId, "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(oMessageId, "UnexpectedException", "", ex.Message)
Finally
oConnection.Close()
' Move all files of the current group
Try
MoveFiles(oArgs, oMessageId, oFileGroupFiles, oEmailAttachmentFiles, oEmbeddedAttachmentFiles, oMoveDirectory)
_logger.Info("Finished processing file group {0}", oMessageId)
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, MessageId As String, Files As List(Of FileInfo), AttachmentFiles As List(Of FileInfo), EmbeddedAttachments As List(Of PDFAttachments.AttachmentResult), MoveDirectory As String)
Dim oFinalMoveDirectory As String = MoveDirectory
Dim oAttachmentDirectory As String = Path.Combine(MoveDirectory, Args.AttachmentsSubDirectory)
' Create directories if they don't exist
If Not Directory.Exists(oFinalMoveDirectory) Then
Try
Directory.CreateDirectory(oFinalMoveDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
If Not Directory.Exists(oAttachmentDirectory) And AttachmentFiles.Count > 0 Then
Try
Directory.CreateDirectory(oAttachmentDirectory)
Catch ex As Exception
_logger.Error(ex)
End Try
End If
' Move PDF/A Files
For Each oFile In Files
Try
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
' Move non-PDF/A Email Attachments/Files
For Each oFile In AttachmentFiles
Try
Dim oFileName = _filesystem.GetVersionedFilename(Path.Combine(oAttachmentDirectory, oFile.Name))
_filesystem.MoveTo(oFile.FullName, oFileName, oAttachmentDirectory)
_logger.Info("Finished processing file {0}", oFile.Name)
_logger.Info("Attachment moved to {0}", oFileName)
Catch ex As Exception
_logger.Warn("Could not move attachment {0}", oFile.FullName)
_logger.Error(ex)
End Try
Next
' Write Embedded Files to disk
For Each oResult In EmbeddedAttachments
Try
Dim oFileName As String = $"{MessageId}~{oResult.FileName}"
Dim oFilePath As String = Path.Combine(oAttachmentDirectory, oFileName)
Using oWriter As New FileStream(oFilePath, FileMode.Create)
oWriter.Write(oResult.FileContents, 0, oResult.FileContents.Length)
End Using
Catch ex As Exception
_logger.Warn("Could not save embedded attachment {0}", oResult.FileName)
_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