From f20d0e5edd919f103341d7e9df5486a9c023a062 Mon Sep 17 00:00:00 2001 From: Digital Data - Marlon Schreiber Date: Mon, 6 Jan 2020 13:00:25 +0100 Subject: [PATCH] MS: Emailservice und Logging --- DDEmailService/EmailService.vb | 18 ++- DDEmailService/ProjectInstaller.Designer.vb | 1 + Modules.Config/ConfigManager.vb | 39 ++++- .../EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb | 98 +++++++++++-- Modules.Logging/LogConfig.vb | 2 +- Modules.Messaging/Email.vb | 135 ++++++++++++++++++ 6 files changed, 272 insertions(+), 21 deletions(-) diff --git a/DDEmailService/EmailService.vb b/DDEmailService/EmailService.vb index 4e09adce..57352603 100644 --- a/DDEmailService/EmailService.vb +++ b/DDEmailService/EmailService.vb @@ -64,6 +64,7 @@ Public Class EmailService End If If My.Settings.SQLSERVER_CS_TEST <> String.Empty Then + _MSSQL_Test = New MSSQLServer(_LogConfig, My.Settings.SQLSERVER_CS_TEST) If _MSSQL_Test.DBInitialized = False Then @@ -128,7 +129,7 @@ Public Class EmailService Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs) If Not _EmailQueue.IsBusy Then _EmailQueue.RunWorkerAsync() - _Logger.Info("Worker is ready, executing.") + _Logger.Debug("Worker is ready, executing.") Else _Logger.Info("Worker is busy, skipping execution.") End If @@ -137,17 +138,17 @@ Public Class EmailService Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs) Try If _Firebird?._DBInitialized Then - _Logger.Info("Starting Firebird Sending") + _Logger.Debug("Starting Firebird Sending") SendEmailFrom(DatabaseType.Firebird, Nothing) End If If _MSSQL?.DBInitialized Then - _Logger.Info("Starting MSSQL Sending") + _Logger.Debug("Starting MSSQL Sending") SendEmailFrom(DatabaseType.MSSQL, _MSSQL) End If If _MSSQL_Test?.DBInitialized Then - _Logger.Info("Starting MSSQL Test Sending") + _Logger.Debug("Starting MSSQL Test Sending") SendEmailFrom(DatabaseType.MSSQL, _MSSQL_Test) End If Catch ex As Exception @@ -197,7 +198,7 @@ Public Class EmailService End If If oEmailQueue.Rows.Count = 0 Then - _Logger.Info("Email Queue is empty. Exiting.") + _Logger.Debug("Email Queue is empty. Exiting.") Return False End If @@ -295,9 +296,10 @@ Public Class EmailService End If Dim oEmailSent As Boolean = False - oEmailSent = _Email.NewEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oAttachment) + oEmailSent = _Email.New_EmailISoft(oSubject, oBody, oEmailTo, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oAttachment) If oEmailSent Then + Select Case Database Case DatabaseType.Firebird oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" @@ -312,12 +314,14 @@ Public Class EmailService End If MSSQLInstance.NewExecutenonQuery(oSQL) End Select + _Logger.Info($"Email has been send to: {oEmailTo} - Subject: {oSubject}") + Threading.Thread.Sleep(500) End If Next Return True Catch ex As Exception - _Logger.Warn("Error in SendEmailFromFirebird. Email was not sent.") + _Logger.Warn("Error in SendEmailFrom. Email was not sent.") _Logger.Error(ex) Return False End Try diff --git a/DDEmailService/ProjectInstaller.Designer.vb b/DDEmailService/ProjectInstaller.Designer.vb index 899afad2..53b05190 100644 --- a/DDEmailService/ProjectInstaller.Designer.vb +++ b/DDEmailService/ProjectInstaller.Designer.vb @@ -32,6 +32,7 @@ ' 'ServiceInstaller1 ' + Me.ServiceInstaller1.Description = "Sends all emails from Digital Data Modules" Me.ServiceInstaller1.DisplayName = "Digital Data Email Service" Me.ServiceInstaller1.ServiceName = "DDEmailService" ' diff --git a/Modules.Config/ConfigManager.vb b/Modules.Config/ConfigManager.vb index 11d1bdfd..ac5151d2 100644 --- a/Modules.Config/ConfigManager.vb +++ b/Modules.Config/ConfigManager.vb @@ -16,6 +16,7 @@ Public Class ConfigManager(Of T) Private ReadOnly _UserConfigPath As String Private ReadOnly _ComputerDirectory As String Private ReadOnly _ComputerConfigPath As String + Private ReadOnly _AppConfigPath As String Private ReadOnly _TestMode As Boolean = False @@ -56,6 +57,11 @@ Public Class ConfigManager(Of T) Return _ComputerConfigPath End Get End Property + Public ReadOnly Property AppConfigPath As String + Get + Return _AppConfigPath + End Get + End Property ''' ''' Creates a new instance of the ConfigManager @@ -65,7 +71,7 @@ Public Class ConfigManager(Of T) ''' The path to check for a user config file, eg. AppData (Usually Application.UserAppDataPath or Application.LocalUserAppDataPath) ''' The path to check for a computer config file, eg. ProgramData (Usually Application.CommonAppDataPath) ''' Override values from ComputerConfig with UserConfig - Public Sub New(LogConfig As LogConfig, UserConfigPath As String, ComputerConfigPath As String, Optional ForceUserConfig As Boolean = False) + Public Sub New(LogConfig As LogConfig, UserConfigPath As String, ComputerConfigPath As String, ApplicationStartupPath As String, Optional ForceUserConfig As Boolean = False) _LogConfig = LogConfig _Logger = LogConfig.GetLogger() _File = New Filesystem.File(_LogConfig) @@ -80,6 +86,7 @@ Public Class ConfigManager(Of T) _UserConfigPath = Path.Combine(_UserDirectory, USER_CONFIG_NAME) _ComputerConfigPath = Path.Combine(_ComputerDirectory, COMPUTER_CONFIG_NAME) + _AppConfigPath = Path.Combine(ApplicationStartupPath, "AppConfig.xml") Config = LoadConfig() End Sub @@ -89,8 +96,8 @@ Public Class ConfigManager(Of T) ''' ''' LogConfig instance ''' The path to check for a user config file, eg. AppData (Usually Application.UserAppDataPath or Application.LocalUserAppDataPath) - Public Sub New(LogConfig As LogConfig, ConfigPath As String) - MyClass.New(LogConfig, ConfigPath, ConfigPath, ForceUserConfig:=True) + Public Sub New(LogConfig As LogConfig, ConfigPath As String, ApplicationStartupPath As String) + MyClass.New(LogConfig, ConfigPath, ConfigPath, ApplicationStartupPath, ForceUserConfig:=True) End Sub ''' @@ -155,13 +162,35 @@ Public Class ConfigManager(Of T) Private Function LoadConfig() As T ' first create an empty/default config object Dim oConfig = Activator.CreateInstance(_BlueprintType) - ' then Try to load computer config - oConfig = LoadComputerConfig(oConfig) + + oConfig = LoadAppConfig(oConfig) + If oConfig Is Nothing Then + oConfig = Activator.CreateInstance(_BlueprintType) + ' then Try to load computer config + oConfig = LoadComputerConfig(oConfig) + End If + ' now try to load userconfig oConfig = LoadUserConfig(oConfig) Return oConfig End Function + Private Function LoadAppConfig(ByVal Config As T) As T + If File.Exists(_AppConfigPath) Then + Try + Dim oAppConfig = ReadFromFile(_AppConfigPath) + CopyValues(oAppConfig, Config) + Catch ex As Exception + _Logger.Error(ex) + _Logger.Warn("ApplicationConfig could not be loaded!") + End Try + Else + _Logger.Debug("ApplicationConfig does not exist.") + _ForceUserConfig = True + Return Nothing + End If + Return Config + End Function Private Function LoadComputerConfig(ByVal Config As T) As T If File.Exists(_ComputerConfigPath) Then diff --git a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb index b88dd7e3..5e6c0404 100644 --- a/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb +++ b/Modules.Jobs/EDMI/ZUGFeRD/ImportZUGFeRDFiles.vb @@ -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() diff --git a/Modules.Logging/LogConfig.vb b/Modules.Logging/LogConfig.vb index b8a27d41..c9e5e25d 100644 --- a/Modules.Logging/LogConfig.vb +++ b/Modules.Logging/LogConfig.vb @@ -156,7 +156,7 @@ Public Class LogConfig End Get Set(isDebug As Boolean) Me.isDebug = isDebug - GetLogger().Info("=> Debug is now {0}", isDebug) + 'GetLogger().Debug("=> Debug is now {0}", isDebug) ReloadConfig(isDebug) End Set End Property diff --git a/Modules.Messaging/Email.vb b/Modules.Messaging/Email.vb index 7c89afe0..de8a6dc1 100644 --- a/Modules.Messaging/Email.vb +++ b/Modules.Messaging/Email.vb @@ -360,7 +360,142 @@ Public Class Email End Try End Function + Public Function New_EmailISoft(ByVal mailSubject As String, ByVal mailBody As String, mailto As String, + mailfrom As String, mailsmtp As String, mailport As Integer, mailUser As String, mailPW As String, + AUTH_TYPE As String, SENDER_INSTANCE As String, Optional attment As String = "") + Try + ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12 + _logger.Debug($"in Email_Send_Independentsoft..") + Dim empfaenger As String() + If mailto.Contains(";") Then + empfaenger = mailto.Split(";") + Else + ReDim Preserve empfaenger(0) + empfaenger(0) = mailto + End If + Dim _error As Boolean = False + 'Für jeden Empfänger eine Neue Mail erzeugen + For Each _mailempfaenger As String In empfaenger + _logger.Debug($"Working on email for {_mailempfaenger}..") + Try + Dim message As New Message() + message.From = New Mailbox(mailfrom, mailfrom) + message.[To].Add(New Mailbox(_mailempfaenger)) + message.Subject = mailSubject + _logger.Debug($"Message created..") + Dim textBodyPart As New BodyPart() + textBodyPart.ContentType = New ContentType("text", "html", "utf-8") + textBodyPart.ContentTransferEncoding = ContentTransferEncoding.QuotedPrintable + textBodyPart.Body = mailBody + message.BodyParts.Add(textBodyPart) + If attment <> String.Empty Then + If System.IO.File.Exists(attment) Then + Dim attachment1 As New Independentsoft.Email.Mime.Attachment(attment) + If attment.ToLower.EndsWith("pdf") Then + attachment1.ContentType = New ContentType("application", "pdf") + ElseIf attment.ToLower.EndsWith("jpg") Then + attachment1.ContentType = New ContentType("application", "jpg") + ElseIf attment.ToLower.EndsWith("docx") Then + attachment1.ContentType = New ContentType("application", "MS-word") + End If + message.BodyParts.Add(attachment1) + Else + _logger.Warn($"Attachment {attment.ToString} is not existing!") + End If + End If + Dim client As Independentsoft.Email.Smtp.SmtpClient + Try + client = New Independentsoft.Email.Smtp.SmtpClient(mailsmtp, mailport) + Catch ex As Exception + _logger.Warn("clsEmail.Create Client: " & ex.Message) + _error = True + Continue For + End Try + Try + client.Connect() + Catch ex As Exception + _logger.Warn("clsEmail.Client.Connect1: " & ex.Message) + _logger.Debug("Error in ClientConnect - but still trying to send") + _error = True + ' Continue For + End Try + _logger.Debug("Connected to Client!") + If AUTH_TYPE = "SSL" Then + client.EnableSsl = True + 'client.ValidateRemoteCertificate = True + _logger.Debug("Authentification via SSL.") + ElseIf AUTH_TYPE = "TLS" Then + ' client.ValidateRemoteCertificate = False + client.StartTls() + client.EnableSsl = False + _logger.Debug("Authentification via TLS. SSL disabled") + Else + client.EnableSsl = False + _logger.Debug("Authentification NONE. SSL disabled") + End If + Try + client.Connect() + Catch ex As Exception + _logger.Warn("clsEmail.Client.Connect: " & ex.Message) + _error = True + ' Continue For + End Try + Try + If mailsmtp.Contains("office365.com") Then + client.Login(mailUser, mailPW, AuthenticationType.None) + Else + client.Login(mailUser, mailPW) + End If + + _logger.Debug("Logged in!") + Catch ex As Exception + Try + If mailsmtp.Contains("office365.com") Then + client.Login(mailUser, mailPW, AuthenticationType.Login) + Else + client.Login(mailUser, mailPW, AuthenticationType.Anonymous) + End If + + Catch ex1 As Exception + Try + client.Login(mailUser, mailPW, AuthenticationType.Login) + Catch ex2 As Exception + _logger.Warn("clsEmail.Client.Login: " & ex.Message) + _error = True + client.Disconnect() + Continue For + End Try + End Try + End Try + Try + client.Send(message) + _logger.Info("Message to " & _mailempfaenger & " has been send.") + _error = False + Catch ex As Exception + _logger.Warn("clsEmail.Client.Send: " & ex.Message) + _error = True + client.Disconnect() + Continue For + End Try + client.Disconnect() + + Catch ex As Exception + _logger.Error(ex) + _error = True + End Try + Next + + If _error = True Then + Return False + Else + Return True + End If + Catch ex As Exception + _logger.Error(ex) + Return False + End Try + End Function Public Function DELETE_EMAIL(POLLTYPE As String, msgid As String, MYMAIL_SERVER As String, MYMAIL_PORT As Integer, MYMAIL_USER As String, MYMAIL_USER_PW As String) Try If POLLTYPE = "POP" Then