WIP: Comservice & Zugferd
This commit is contained in:
@@ -1,4 +1,5 @@
|
||||
Imports System.Collections.Generic
|
||||
Imports System.Data
|
||||
Imports System.IO
|
||||
Imports System.Linq
|
||||
Imports System.Text.RegularExpressions
|
||||
@@ -14,6 +15,8 @@ Public Class ImportZUGFeRDFiles
|
||||
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"
|
||||
|
||||
Private _logger As Logger
|
||||
Private _logConfig As LogConfig
|
||||
@@ -25,16 +28,26 @@ Public Class ImportZUGFeRDFiles
|
||||
Public WatchDirectories As List(Of String)
|
||||
Public SuccessDirectory As String
|
||||
Public ErrorDirectory As String
|
||||
Public OriginalEmailDirectory As String
|
||||
Public RejectedEmailDirectory As String
|
||||
Public PropertyMap As Dictionary(Of String, XmlItemProperty)
|
||||
|
||||
Public Sub New()
|
||||
WatchDirectories = New List(Of String)
|
||||
SuccessDirectory = Nothing
|
||||
ErrorDirectory = Nothing
|
||||
OriginalEmailDirectory = Nothing
|
||||
RejectedEmailDirectory = Nothing
|
||||
PropertyMap = New Dictionary(Of String, XmlItemProperty)
|
||||
End Sub
|
||||
End Class
|
||||
|
||||
Public Class EmailData
|
||||
Public Attachment As String
|
||||
Public Subject As String
|
||||
Public From As String
|
||||
End Class
|
||||
|
||||
Public Class XmlItemProperty
|
||||
Public TableName As String
|
||||
Public Description As String
|
||||
@@ -54,36 +67,35 @@ Public Class ImportZUGFeRDFiles
|
||||
Return oRandomValue
|
||||
End Function
|
||||
|
||||
Private Function GetEmailAddressForMessageId(FileGuid As String) As String
|
||||
Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
|
||||
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 emailAddress = _firebird.GetScalarValue(oSQL)
|
||||
Dim oDatatable = _firebird.GetDatatable(oSQL)
|
||||
Dim oRow As DataRow
|
||||
|
||||
_logger.Debug("Got Email Address for FileId {0}: {1}", FileGuid, emailAddress)
|
||||
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
|
||||
|
||||
Return emailAddress
|
||||
_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 Address for FileId {0}", FileGuid)
|
||||
_logger.Warn("Could not fetch Email Data for FileId {0}", MessageId)
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Function GetOriginalFileNameForMessageId(FileGuid As String) As String
|
||||
Dim oSQL = $"SELECT EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
|
||||
Try
|
||||
Dim originalFilename = _firebird.GetScalarValue(oSQL)
|
||||
|
||||
_logger.Debug("Got Original Filename for FileId {0}: {1}", FileGuid, originalFilename)
|
||||
|
||||
Return originalFilename
|
||||
Catch ex As Exception
|
||||
_logger.Warn("Could not fetch Original Filename for FileId {0}", FileGuid)
|
||||
Return Nothing
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Function GetOriginalEmailPath(MessageId As String)
|
||||
Dim oAttachmentDirectory = ""
|
||||
Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
|
||||
Dim oAttachmentDirectory = OriginalEmailDirectory
|
||||
Dim oAttachmentFile = MessageId & ".eml"
|
||||
Dim oAttachmentPath = Path.Combine(oAttachmentDirectory, oAttachmentFile)
|
||||
|
||||
@@ -94,7 +106,33 @@ Public Class ImportZUGFeRDFiles
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Sub AddToEmailQueue(MessageId As String, BodyText As String)
|
||||
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 = GetEmailPathWithSubjectAsName(Args.RejectedEmailDirectory, oEmailData.Subject)
|
||||
|
||||
Try
|
||||
File.Move(oSource, oDestination)
|
||||
oEmailData.Attachment = oDestination
|
||||
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 AddToEmailQueue(MessageId As String, BodyText As String, EmailData As EmailData)
|
||||
Try
|
||||
Dim oJobId = RandomValue(1, 10000)
|
||||
Dim oReference = MessageId
|
||||
@@ -102,10 +140,9 @@ Public Class ImportZUGFeRDFiles
|
||||
Dim oSubject = "Your email was rejected"
|
||||
Dim oAccountId = 1
|
||||
Dim oCreatedWho = "ZUGFeRD Service"
|
||||
Dim oAttachment = ""
|
||||
|
||||
Dim oEmailAddress = GetEmailAddressForMessageId(MessageId)
|
||||
Dim oOriginalFilename = GetOriginalFileNameForMessageId(MessageId)
|
||||
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)
|
||||
@@ -114,8 +151,6 @@ Public Class ImportZUGFeRDFiles
|
||||
oEmailTo = oEmailAddress
|
||||
End If
|
||||
|
||||
oAttachment = GetOriginalEmailPath(MessageId)
|
||||
|
||||
_logger.Debug("Generated Email:")
|
||||
_logger.Debug("To: {0}", oEmailTo)
|
||||
_logger.Debug("Subject: {0}", oSubject)
|
||||
@@ -294,21 +329,24 @@ Public Class ImportZUGFeRDFiles
|
||||
oMoveDirectory = args.ErrorDirectory
|
||||
|
||||
Dim oBody = "<p>Your email contained more than one ZUGFeRD-Document.</p>"
|
||||
AddToEmailQueue(oFileGroupId, oBody)
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As NoFerdsException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = args.ErrorDirectory
|
||||
|
||||
Dim oBody = "<p>Your email contained no ZUGFeRD-Documents.</p>"
|
||||
AddToEmailQueue(oFileGroupId, oBody)
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Catch ex As MissingValueException
|
||||
_logger.Error(ex)
|
||||
|
||||
oMoveDirectory = args.ErrorDirectory
|
||||
|
||||
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
|
||||
AddToEmailQueue(oFileGroupId, oBody)
|
||||
Dim oEmailData = MoveAndRenameEmailToRejected(args, oFileGroupId)
|
||||
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
|
||||
Finally
|
||||
oConnection.Close()
|
||||
|
||||
|
||||
Reference in New Issue
Block a user