MS: Emailservice und Logging

This commit is contained in:
2020-01-06 13:00:25 +01:00
parent bc18b693bb
commit f20d0e5edd
6 changed files with 272 additions and 21 deletions

View File

@@ -150,7 +150,17 @@ Public Class ImportZUGFeRDFiles
Return oEmailData
End Function
Private Sub AddToEmailQueue(MessageId As String, BodyText As String, EmailData As EmailData)
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
@@ -182,6 +192,7 @@ Public Class ImportZUGFeRDFiles
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 "
@@ -195,7 +206,73 @@ Public Class ImportZUGFeRDFiles
_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_HSITORY WHERE EMAIL_MSG_ID = '{MessageId}'"
Dim oHistoryID = _mssql.GetScalarValue(osql)
osql = $"select * from TBEDM_EMAIL_QUEUE where REFERENCE_ID = {oHistoryID} and EMAIL_ADRESS = '{oEmailTo}' and EMAIL_SUBJ = '{oSubject}'"
Dim oDTResult As DataTable = _mssql.GetDatatable(osql)
If IsNumeric(oHistoryID) And oDTResult.Rows.Count = 0 Then
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] ([REMINDER_TYPE_ID],[SENDING_PROFILE],
,[REFERENCE_ID]
,[REFERENCE_STRING]
,[EMAIL_ADRESS]
,[EMAIL_SUBJ]
,[EMAIL_BODY]
,[COMMENT]
,[ADDED_WHO])
VALUES
(99
,{oAccountId}
,{oHistoryID}
,'{MessageId}'
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{SourceProcedure}'
,'{oCreatedWho}'"
_mssql.ExecuteNonQuery(oInsert)
Else
If oDTResult.Rows.Count = 0 Then
_logger.Debug("Email has already been sent!!")
Else
_logger.Debug("Could not get oHistoryID!!")
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
@@ -562,8 +639,8 @@ Public Class ImportZUGFeRDFiles
Dim oBody = EMAIL_MD5_ERROR
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "MD5HashException")
AddRejectedState(oFileGroupId, "MD5HashException", "Die gesendete Rechnung wurde bereits verarbeitet!", "")
Catch ex As InvalidFerdException
_logger.Error(ex)
@@ -572,7 +649,8 @@ Public Class ImportZUGFeRDFiles
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_INVALID_DOCUMENT
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "InvalidFerdException")
AddRejectedState(oFileGroupId, "InvalidFerdException", "Inkorrekte Formate", "")
Catch ex As TooMuchFerdsException
_logger.Error(ex)
@@ -581,7 +659,8 @@ Public Class ImportZUGFeRDFiles
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_TOO_MUCH_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "TooMuchFerdsException")
AddRejectedState(oFileGroupId, "TooMuchFerdsException", "Email enthielt mehr als ein ZUGFeRD-Dokument", "")
Catch ex As NoFerdsException
_logger.Error(ex)
@@ -590,7 +669,8 @@ Public Class ImportZUGFeRDFiles
_firebird.ExecuteNonQuery(oSQL)
Dim oBody = EMAIL_NO_FERDS
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
AddToEmailQueueMSSQL(oFileGroupId, oBody, oEmailData, "NoFerdsException")
AddRejectedState(oFileGroupId, "NoFerdsException", " Email enthielt keine ZUGFeRD-Dokumente", "")
Catch ex As MissingValueException
_logger.Error(ex)
@@ -604,14 +684,16 @@ Public Class ImportZUGFeRDFiles
Dim oBody = CreateBodyForMissingProperties(ex.File.Name, oMissingProperties)
Dim oEmailData = MoveAndRenameEmailToRejected(oArgs, oFileGroupId)
AddToEmailQueue(oFileGroupId, oBody, oEmailData)
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()