WIP: Comservice & Zugferd

DDZUGFeRDService/ThreadRunner.vb

@@ -19,6 +19,7 @@ Public Class ThreadRunner
     Private _watchDirectories As List(Of String)
     Private _successDirectory As String
     Private _errorDirectory As String
+    Private _originalEmailDirectory As String
     Private _zugferd As ZUGFeRDInterface
     Private _jobArguments As WorkerArgs
 
@@ -38,20 +39,27 @@ Public Class ThreadRunner
         _logger.Debug("Checking SuccessDirectory {0}", args.SuccessDirectory)
         If Not Directory.Exists(args.SuccessDirectory) Then
             _logger.Warn("SuccessDirectory {0} does not exist!", args.SuccessDirectory)
-            'Throw New DirectoryNotFoundException("SuccessDirectory: " & args.SuccessDirectory)
         End If
 
         _logger.Debug("Checking ErrorDirectory {0}", args.ErrorDirectory)
         If Not Directory.Exists(args.ErrorDirectory) Then
             _logger.Warn("ErrorDirectory {0} does not exist!", args.ErrorDirectory)
-            'Throw New DirectoryNotFoundException("ErrorDirectory: " & args.ErrorDirectory)
+        End If
+
+        _logger.Debug("Checking Original Email Directory {0}", args.OriginalEmailDirectory)
+        If Not Directory.Exists(args.OriginalEmailDirectory) Then
+            _logger.Warn("OriginalEmailDirectory {0} does not exist!", args.OriginalEmailDirectory)
+        End If
+
+        _logger.Debug("Checking Rejected Email Directory {0}", args.RejectedEmailDirectory)
+        If Not Directory.Exists(args.RejectedEmailDirectory) Then
+            _logger.Warn("RejectedEmailDirectory {0} does not exist!", args.RejectedEmailDirectory)
         End If
 
         For Each oDirectory In args.WatchDirectories
             _logger.Debug("Checking WatchDirectory {0}", oDirectory)
             If Not Directory.Exists(oDirectory) Then
                 _logger.Warn("WatchDirectory {0} does not exist!", oDirectory)
-                'Throw New DirectoryNotFoundException("WatchDirectory: " & oDirectory)
             End If
         Next
 
@@ -125,6 +133,12 @@ Public Class ThreadRunner
                 Case ZUGFERD_ERROR
                     args.ErrorDirectory = row.Item("FOLDER_PATH")
 
+                Case ZUGFERD_EML
+                    args.OriginalEmailDirectory = row.Item("FOLDER_PATH")
+
+                Case ZUGFERD_REJECTED_EML
+                    args.RejectedEmailDirectory = row.Item("FOLDER_PATH")
+
             End Select
         Next
 

DD_CommunicationService/MyComService.vb

@@ -80,7 +80,7 @@ Public Class MyComService
                 Dim oEMAILACCOUNT_ID, oGUID, oJOB_ID As Integer
                 For Each oEmail_Row As DataRow In oDT_EMAIL_QUEUE.Rows
                     oEMAILACCOUNT_ID = oEmail_Row.Item("EMAIL_ACCOUNT_ID")
-                    Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType As String
+                    Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment As String
                     Dim oACCOUNT_MATCH As Boolean = False
                     For Each oAccountRow As DataRow In oDT_EMAIL_ACCOUNT.Rows
                         If oAccountRow.Item("GUID") = oEMAILACCOUNT_ID Then
@@ -118,6 +118,15 @@ Public Class MyComService
                     oSubject = oEmail_Row.Item("EMAIL_SUBJ")
                     oBody = oEmail_Row.Item("EMAIL_BODY")
                     oJOB_ID = oEmail_Row.Item("JOB_ID")
+
+                    If IsNothing(oEmail_Row.Item("EMAIL_ATTMT1")) Then
+                        oAttachment = String.Empty
+                    Else
+                        oAttachment = oEmail_Row.Item("EMAIL_ATTMT1")
+                    End If
+
+                    _Logger.Debug("Email Attachment is: {0}", oAttachment.ToString)
+
                     Dim link As String = "pmo://" & oJOB_ID & "-" & oEmail_Row.Item("REFERENCE1")
                     If oBody.Contains("[%PMOLINK_GER]") Then
                         oBody = oBody.Replace("[%PMOLINK_GER]", "<a href=""" & link & """>hier</a>")
@@ -127,7 +136,9 @@ Public Class MyComService
                         oBody = oBody.Replace("[%PMOLINK_US]", "<a href=""" & link & """>here</a>")
                     End If
 
-                    If _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEDMI_ComService") = True Then
+
+
+                    If _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEDMI_ComService", oAttachment) = True Then
                         Dim upd = "UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP WHERE GUID = " & oGUID
                         _firebird.ExecuteNonQuery(upd)
                     End If

Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb

@@ -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
+    Private Function GetEmailDataForMessageId(MessageId As String) As EmailData
-        Dim oSQL = $"SELECT EMAIL_FROM FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
+        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
+    Private Function GetOriginalEmailPath(OriginalEmailDirectory As String, MessageId As String) As String
-        Dim oSQL = $"SELECT EMAIL_ATTMT1 FROM TBEDM_EMAIL_PROFILER_HISTORY WHERE EMAIL_MSGID = '{FileGuid}'"
+        Dim oAttachmentDirectory = OriginalEmailDirectory
-        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 = ""
         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 oEmailAddress = EmailData.From
-            Dim oOriginalFilename = GetOriginalFileNameForMessageId(MessageId)
+            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()
 

Message/Email.vb

@@ -152,14 +152,16 @@ Public Class Email
                     oTextBodyPart.ContentType = New ContentType("text", "html", "utf-8")
 
                     oTextBodyPart.ContentTransferEncoding = ContentTransferEncoding.QuotedPrintable
-                    Dim formattedBody = "<font face=""Tahoma"">" & mailBody & "<br><br>>> Service: " & SENDER_INSTANCE & "<br>" &
+                    Dim formattedBody = mailBody
-                                               ">> DateTime: " & My.Computer.Clock.LocalTime.ToShortDateString.ToString("dd.MM.yyyy") & " " &
+
-                    My.Computer.Clock.LocalTime.ToLongTimeString.ToString("H:mm:ss") & "</font>"
                     Dim thisDate1 As Date = #6/10/2011#
                     Console.WriteLine("Today is " + thisDate1.ToString("MMMM dd, yyyy") + ".")
                     oTextBodyPart.Body = formattedBody
                     oMessage.BodyParts.Add(oTextBodyPart)
+
                     If attment <> String.Empty Then
+                        _logger.Debug("Attachment Path is: {0}", attment)
+
                         If System.IO.File.Exists(attment) Then
                             Dim attachment1 As New Attachment(attment)
                             If attment.ToLower.EndsWith("pdf") Then

ZUGFeRDTest/Form1.vb

@@ -38,6 +38,11 @@ Public Class Form1
                 Case ZUGFERD_ERROR
                     args.ErrorDirectory = row.Item("FOLDER_PATH")
 
+                Case ZUGFERD_EML
+                    args.OriginalEmailDirectory = row.Item("FOLDER_PATH")
+
+                Case ZUGFERD_REJECTED_EML
+                    args.RejectedEmailDirectory = row.Item("FOLDER_PATH")
             End Select
         Next