WIP: Comservice & Zugferd

This commit is contained in:
Jonathan Jenne 2019-03-14 17:00:25 +01:00
parent c0d37ef789
commit 62d04a8c21
5 changed files with 109 additions and 39 deletions

View File

@ -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

View File

@ -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

View File

@ -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()

View File

@ -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>" &
">> DateTime: " & My.Computer.Clock.LocalTime.ToShortDateString.ToString("dd.MM.yyyy") & " " &
My.Computer.Clock.LocalTime.ToLongTimeString.ToString("H:mm:ss") & "</font>"
Dim formattedBody = mailBody
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

View File

@ -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