From 165ade98f298087ee8950c0da5c594f6b159437e Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Thu, 13 Oct 2022 16:35:10 +0200 Subject: [PATCH] EmailService: Big update --- Services.EmailService/DDEmailService.vbproj | 16 +- .../EmailService.Designer.vb | 10 +- Services.EmailService/EmailService.vb | 462 +++++++++++------- Services.EmailService/EmailServiceOld.vb | 419 ++++++++++++++++ 4 files changed, 715 insertions(+), 192 deletions(-) create mode 100644 Services.EmailService/EmailServiceOld.vb diff --git a/Services.EmailService/DDEmailService.vbproj b/Services.EmailService/DDEmailService.vbproj index 3fecaf99..3c5add8c 100644 --- a/Services.EmailService/DDEmailService.vbproj +++ b/Services.EmailService/DDEmailService.vbproj @@ -47,6 +47,9 @@ On + + ..\..\DDModules\Base\bin\Debug\DigitalData.Modules.Base.dll + ..\..\DDModules\Config\bin\Debug\DigitalData.Modules.Config.dll @@ -109,6 +112,13 @@ + + EmailService.vb + + + Component + + True @@ -120,12 +130,6 @@ Component - - Component - - - EmailService.vb - True diff --git a/Services.EmailService/EmailService.Designer.vb b/Services.EmailService/EmailService.Designer.vb index 4b562e79..8d2aed7d 100644 --- a/Services.EmailService/EmailService.Designer.vb +++ b/Services.EmailService/EmailService.Designer.vb @@ -1,11 +1,11 @@ Imports System.ServiceProcess - _ + Partial Class EmailService Inherits System.ServiceProcess.ServiceBase 'UserService überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. - _ + Protected Overrides Sub Dispose(ByVal disposing As Boolean) Try If disposing AndAlso components IsNot Nothing Then @@ -17,8 +17,8 @@ Partial Class EmailService End Sub ' Der Haupteinstiegspunkt für den Prozess - _ - _ + + Shared Sub Main() Dim ServicesToRun() As System.ServiceProcess.ServiceBase @@ -39,7 +39,7 @@ Partial Class EmailService ' Hinweis: Die folgende Prozedur ist für den Komponenten-Designer erforderlich. ' Das Bearbeiten ist mit dem Komponenten-Designer möglich. ' Das Bearbeiten mit dem Code-Editor ist nicht möglich. - _ + Private Sub InitializeComponent() components = New System.ComponentModel.Container() Me.ServiceName = "Service1" diff --git a/Services.EmailService/EmailService.vb b/Services.EmailService/EmailService.vb index eb8d95e2..f62b5179 100644 --- a/Services.EmailService/EmailService.vb +++ b/Services.EmailService/EmailService.vb @@ -1,11 +1,10 @@ -Imports System.ComponentModel +Imports System.Timers +Imports System.IO +Imports System.ComponentModel Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports DigitalData.Modules.Messaging -Imports DigitalData.Modules.Filesystem Imports DigitalData.Modules.Language -Imports System.Timers -Imports System.IO Imports DigitalData.Modules.Encryption Public Class EmailService @@ -18,8 +17,9 @@ Public Class EmailService Private _EmailQueue As BackgroundWorker Private _QueueTimer As Timer Private _AnyDatabaseInitialized As Boolean = False - Private _limilab As DigitalData.Modules.Messaging.Limilab - Private _messageSend As Boolean = False + Private _limilab As Limilab + Private _MailSender As MailSender + Private ReadOnly _messageSend As Boolean = False Private Enum DatabaseType Firebird @@ -29,38 +29,26 @@ Public Class EmailService Protected Overrides Sub OnStart(ByVal args() As String) Try ' === Initialize Logger === - _LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "EmailService") - _LogConfig.Debug = My.Settings.DEBUG + Dim oLogPath = Path.Combine(My.Application.Info.DirectoryPath, "Log") + _LogConfig = New LogConfig(LogConfig.PathType.CustomPath, oLogPath, Nothing, "Digital Data", "EmailService") With { + .Debug = My.Settings.DEBUG + } - _Logger = _LogConfig.GetLogger() - Try - Dim directory As New IO.DirectoryInfo(_LogConfig.LogDirectory) - - For Each file As IO.FileInfo In directory.GetFiles - If (Now - file.CreationTime).Days > 29 Then - file.Delete() - Else - Exit For - End If + Dim oCurrentDomain As AppDomain + AddHandler oCurrentDomain.UnhandledException, AddressOf AppDomain_UnhandledException + _Logger = _LogConfig.GetLogger() - Next - Catch ex As Exception - - End Try _Logger.Info("Starting {0}", ServiceName) ' === Inititalize Encryption === - _Logger.NewBlock("Inititalize Encryption") - + _Logger.Debug("Inititalize Encryption") _Encryption = New EncryptionLegacy() - _Logger.EndBlock() - ' === Initialize Databases === - _Logger.NewBlock("Inititalize Databases") + _Logger.Info("Inititalize Databases") If My.Settings.FB_ConnString <> String.Empty Then _Firebird = New Firebird(_LogConfig, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) @@ -89,13 +77,12 @@ Public Class EmailService _AnyDatabaseInitialized = _Firebird?._DBInitialized Or _MSSQL?.DBInitialized Or _MSSQL_Test?.DBInitialized - _Logger.EndBlock() - ' === Initialize Email === - _Logger.NewBlock("Inititalize Email") + _Logger.Debug("Inititalize Email") _limilab = New Limilab(_LogConfig) + _MailSender = New MailSender(_LogConfig) _Logger.EndBlock() @@ -141,13 +128,23 @@ Public Class EmailService End Try End Sub + Private Sub AppDomain_UnhandledException(sender As Object, e As UnhandledExceptionEventArgs) + Dim oException As Exception = e.ExceptionObject + _Logger.Error(oException) + End Sub + Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs) - If Not _EmailQueue.IsBusy Then - _EmailQueue.RunWorkerAsync() - _Logger.Debug("Worker is ready, executing.") - Else - _Logger.Info("Worker is busy, skipping execution.") - End If + Try + If Not _EmailQueue.IsBusy Then + _EmailQueue.RunWorkerAsync() + _Logger.Debug("Worker is ready, executing.") + Else + _Logger.Info("Worker is busy, skipping execution.") + End If + Catch ex As Exception + _Logger.Warn("Error while starting the Worker!") + _Logger.Error(ex) + End Try End Sub Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs) @@ -171,11 +168,24 @@ Public Class EmailService End Try End Sub - Private Function SendEmailFrom(Database As DatabaseType, MSSQLInstance As MSSQLServer) + Private Class EmailAccount + Public Guid As Integer + Public Sender As String + Public Server As String + Public Port As String + Public Username As String + Public Password As String + Public AuthType As String + + Public AddedWhen As String + Public ErrorMessage As String + End Class + + Private Function GetAccounts(Database As DatabaseType, MSSQLInstance As MSSQLServer) As List(Of EmailAccount) Try Dim oSQL As String = String.Empty - Dim oEmailAccounts As DataTable - Dim oEmailQueue As DataTable + Dim oEmailAccounts As DataTable = Nothing + Dim oAccounts As New List(Of EmailAccount) Select Case Database Case DatabaseType.Firebird @@ -189,20 +199,94 @@ Public Class EmailService If IsNothing(oEmailAccounts) Then _Logger.Warn("Error in TBEDM_EMAIL_ACCOUNT Query. Exiting.") _Logger.Warn("Query: {0}", oSQL) - Return False + Return Nothing End If If oEmailAccounts.Rows.Count = 0 Then + _Logger.Warn("No Active Email Accounts Configured! Exiting.") + Return Nothing + End If + + _Logger.Debug("Found [{0}] active Accounts.", oEmailAccounts.Rows.Count) + + For Each oRow As DataRow In oEmailAccounts.Rows + Dim oAccount As EmailAccount = Nothing + + Select Case Database + Case DatabaseType.Firebird + oAccount = New EmailAccount With { + .Guid = oRow.Item("GUID"), + .Sender = oRow.Item("EMAIL_FROM"), + .Server = oRow.Item("SERVER_OUT"), + .Port = oRow.Item("PORT_OUT"), + .Username = oRow.Item("EMAIL_USER"), + .Password = oRow.Item("EMAIL_PW"), + .AuthType = oRow.Item("AUTH_TYPE"), + .AddedWhen = "" + } + + Case DatabaseType.MSSQL + oAccount = New EmailAccount With { + .Guid = oRow.Item("GUID"), + .Sender = oRow.Item("EMAIL_FROM"), + .Server = oRow.Item("EMAIL_SMTP"), + .Port = oRow.Item("PORT"), + .Username = oRow.Item("EMAIL_USER"), + .Password = oRow.Item("EMAIL_PW"), + .AuthType = oRow.Item("AUTH_TYPE"), + .AddedWhen = oRow.Item("ADDED_WHEN").ToString, + .ErrorMessage = oRow.ItemEx("ERROR_MSG", String.Empty) + } + + End Select + + If oAccount Is Nothing Then + _Logger.Warn("Account could not be created. Unknown Database type.") + Continue For + End If + + Dim oPasswordPlain = _Encryption.DecryptData(oAccount.Password) + + If IsNothing(oPasswordPlain) Then + _Logger.Warn("Could not decrypt email password for Account [{0}]. Skipping.", oAccount.Sender) + Continue For + End If + + oAccount.Password = oPasswordPlain + oAccounts.Add(oAccount) + + Next + + Return oAccounts + Catch ex As Exception + _Logger.Warn("Error while getting Accounts!") + _Logger.Error(ex) + Return Nothing + End Try + End Function + + Private Function SendEmailFrom(Database As DatabaseType, MSSQLInstance As MSSQLServer) + Try + Dim oSQL As String = String.Empty + Dim oEmailAccounts As List(Of EmailAccount) = GetAccounts(Database, MSSQLInstance) + Dim oEmailQueue As DataTable = Nothing + + If IsNothing(oEmailAccounts) Then + _Logger.Warn("Error in getting Accounts Query. Exiting.") + Return False + End If + + If oEmailAccounts.Count = 0 Then _Logger.Warn("No Active Email Accounts Configured! Exiting.") Return False End If Select Case Database Case DatabaseType.Firebird - oSQL = "SELECT * FROM TBEDM_EMAIL_QUEUE WHERE EMAIL_SENT IS NULL and EMAIL_TO <> ''" + oSQL = "SELECT * FROM TBEDM_EMAIL_QUEUE WHERE EMAIL_SENT IS NULL and EMAIL_TO <> '' ORDER BY EMAIL_ACCOUNT_ID, CREATEDWHEN DESC" oEmailQueue = _Firebird.GetDatatable(oSQL) Case DatabaseType.MSSQL - oSQL = "SELECT * FROM TBEMLP_EMAIL_OUT WHERE EMAIL_SENT IS NULL and EMAIL_ADRESS <> ''" + oSQL = "SELECT * FROM TBEMLP_EMAIL_OUT WHERE EMAIL_SENT IS NULL and EMAIL_ADRESS <> '' ORDER BY SENDING_PROFILE, ADDED_WHEN DESC" oEmailQueue = MSSQLInstance.GetDatatable(oSQL) End Select @@ -217,168 +301,182 @@ Public Class EmailService Return False End If - Dim oEmailTo, oSubject, oBody As String - Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment, ofromName, oErrorMsg, oMailADDED - Dim oAccountId, oGuid, oJobId As Integer + Dim oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oErrorMsg, oMailADDED + Dim oGuid, oJobId As Integer - For Each oEmailToRow As DataRow In oEmailQueue.Rows - Dim oAccountMatch As Boolean = False - Dim oComment As String = String.Empty + For Each oAccount In oEmailAccounts - Select Case Database - Case DatabaseType.Firebird - oAccountId = oEmailToRow.Item("EMAIL_ACCOUNT_ID") - Case DatabaseType.MSSQL - oAccountId = oEmailToRow.Item("SENDING_PROFILE") - End Select - oErrorMsg = "" - For Each oAccountRow As DataRow In oEmailAccounts.Rows - If oAccountRow.Item("GUID") = oAccountId Then - oAccountMatch = True + Try + _Logger.Debug("Sending mails for Account [{0}]", oAccount.Guid) + + Dim oAccountQueue As DataRow() + + Select Case Database + Case DatabaseType.Firebird + oAccountQueue = oEmailQueue.Select($"EMAIL_ACCOUNT_ID = {oAccount.Guid}") + Case Else + oAccountQueue = oEmailQueue.Select($"SENDING_PROFILE = {oAccount.Guid}") + End Select + + ' No mails for this profile + If oAccountQueue.Count = 0 Then + _Logger.Debug("No mails for Account [{0}]", oAccount.Guid) + Continue For + End If + + _Logger.Debug("Preparing to send [{0}] mails..", oAccountQueue.Count) + + ' ======= Connect to server ======= + + Dim oResult = _MailSender.ConnectToServer(oAccount.Server, oAccount.Port, oAccount.Username, oAccount.Password, oAccount.AuthType) + + If oResult = False Then + _Logger.Warn("Could not connect to server. Skipping.") + Continue For + + End If + + ' ======= Connect to server ======= + + Dim oSuccessfulSent As New List(Of String) + Dim oFailedSent As New List(Of String) + Dim oTotalSent As New List(Of String) + + For Each oRow As DataRow In oAccountQueue + 'Dim oAccountMatch As Boolean = False + Dim oComment As String = String.Empty + oErrorMsg = "" + + Dim oAttachment = String.Empty + Dim oEmailTo = String.Empty + Dim oSubject = String.Empty + Dim oBody = String.Empty + Dim oAddedWhen = Now Select Case Database Case DatabaseType.Firebird - oMailFrom = oAccountRow.Item("EMAIL_FROM") - ofromName = oMailFrom - oMailSMTP = oAccountRow.Item("SERVER_OUT") - oMailport = oAccountRow.Item("PORT_OUT") - oMailUser = oAccountRow.Item("EMAIL_USER") - oAuthType = oAccountRow.Item("AUTH_TYPE") - oMailPW = oAccountRow.Item("EMAIL_PW") - oMailADDED = "" + oGuid = oRow.Item("GUID") + + oEmailTo = oRow.Item("EMAIL_TO") + _Logger.Debug("EMAIL_TO: {0}", oEmailTo) + + oSubject = oRow.Item("EMAIL_SUBJ") + _Logger.Debug("EMAIL_SUBJ: {0}", oSubject) + + oBody = oRow.Item("EMAIL_BODY") + _Logger.Debug("EMAIL_BODY: {0}", oBody) + + oJobId = oRow.Item("JOB_ID") + _Logger.Debug("JOB_ID: {0}", oJobId) + + oAttachment = oRow.ItemEx("EMAIL_ATTMT1", String.Empty) Case DatabaseType.MSSQL - oMailFrom = oAccountRow.Item("EMAIL_FROM") - ofromName = oAccountRow.Item("EMAIL_FROM_NAME") - oMailSMTP = oAccountRow.Item("EMAIL_SMTP") - oMailport = oAccountRow.Item("PORT") - oMailUser = oAccountRow.Item("EMAIL_USER") - oAuthType = oAccountRow.Item("AUTH_TYPE") - oMailPW = oAccountRow.Item("EMAIL_PW") - oMailADDED = oAccountRow.Item("ADDED_WHEN").ToString - Try - oErrorMsg = IIf(IsDBNull(oAccountRow.Item("ERROR_MSG")), "", oAccountRow.Item("ERROR_MSG")) - Catch ex As Exception - oErrorMsg = "" - End Try + oGuid = oRow.ItemEx("GUID", 0) - End Select + oEmailTo = oRow.ItemEx("EMAIL_ADRESS", String.Empty) + _Logger.Debug($"EMAIL_ADRESS: {oEmailTo}") - Dim oPasswordPlain = _Encryption.DecryptData(oMailPW) - If Not IsNothing(oPasswordPlain) Then - oMailPW = oPasswordPlain - Else - _Logger.Warn("Could not decrypt email password. Exiting.") - Return False - End If - End If - Next + oSubject = oRow.ItemEx("EMAIL_SUBJ", String.Empty) + _Logger.Debug($"EMAIL_SUBJ: {oSubject}") - If IsNothing(oMailFrom) Or IsNothing(oMailPW) Then - If oAccountMatch Then - _Logger.Warn("Account credentials are empty. Exiting.") - Else - _Logger.Warn("Account credentials are empty and account with Id {0} does not match the configuration. Exiting.", oAccountId) - End If + oBody = oRow.ItemEx("EMAIL_BODY", String.Empty) + _Logger.Debug($"EMAIL_BODY: {oBody}") - Return False - End If - If oErrorMsg <> String.Empty Then + oJobId = oRow.ItemEx("REFERENCE_ID", 0) + _Logger.Debug($"REFERENCE_ID: {oJobId}") - End If + oAddedWhen = oRow.ItemEx("ADDED_WHEN", Now) - Select Case Database - Case DatabaseType.Firebird - oGuid = oEmailToRow.Item("GUID") - oEmailTo = oEmailToRow.Item("EMAIL_TO") - _Logger.Debug("oEmailTo: {0}", oEmailTo) - oSubject = oEmailToRow.Item("EMAIL_SUBJ") - _Logger.Debug("oSubject: {0}", oSubject) - oBody = oEmailToRow.Item("EMAIL_BODY") - _Logger.Debug("oBody: {0}", oBody) - oJobId = oEmailToRow.Item("JOB_ID") - _Logger.Debug("oJOB_ID: {0}", oJobId) - oAttachment = Utils.NotNull(oEmailToRow.Item("EMAIL_ATTMT1"), String.Empty) + oAttachment = oRow.ItemEx("EMAIL_ATTMT1", String.Empty) + End Select - Case DatabaseType.MSSQL - oGuid = oEmailToRow.Item("GUID") - oEmailTo = oEmailToRow.Item("EMAIL_ADRESS") - _Logger.Debug($"oEmailTo: {oEmailTo}") - oSubject = oEmailToRow.Item("EMAIL_SUBJ") - _Logger.Debug($"oSubject: {oSubject}") - oBody = oEmailToRow.Item("EMAIL_BODY") - _Logger.Debug($"oBody: {oBody}") - oJobId = oEmailToRow.Item("REFERENCE_ID") - _Logger.Debug($"oJOB_ID: {oJobId}") - oAttachment = Utils.NotNull(oEmailToRow.Item("EMAIL_ATTMT1"), String.Empty) - End Select + If oAttachment <> String.Empty Then + If oAttachment.ToString.Contains("\") Then + If File.Exists(oAttachment) = False Then + _Logger.Warn($"Email Attachment [{oAttachment}] not existing!") + oComment = $"Email Attachment [{oAttachment}] not existing!" + oAttachment = String.Empty + Else + _Logger.Debug("Email Attachment is: {0}", oAttachment) + End If + End If + + End If + + Dim oAddresses As List(Of String) = oEmailTo.Split(";").ToList() + Dim oAttachments As New List(Of String) From {oAttachment} + Dim oMessageSent = _MailSender.SendMail(oAddresses, oAccount.Sender, oSubject, oBody, oAddedWhen, oAttachments, False) + + + If oMessageSent Then + oTotalSent.Add(oEmailTo) + oSuccessfulSent.Add(oEmailTo) + + Select Case Database + Case DatabaseType.Firebird + oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + _Firebird.ExecuteNonQuery(oSQL) + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + MSSQLInstance.ExecuteNonQuery(oSQL) + End Select + _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo}") - If oAttachment <> String.Empty Then - If oAttachment.ToString.Contains("\") Then - If IO.File.Exists(oAttachment) = False Then - _Logger.Warn($"Email Attachment [{oAttachment}] not existing!") - oComment = $"Email Attachment [{oAttachment}] not existing!" - oAttachment = String.Empty Else - _Logger.Debug("Email Attachment is: {0}", oAttachment) + oTotalSent.Add(oEmailTo) + oFailedSent.Add(oEmailTo) + + Select Case Database + + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET ERROR_TIMESTAMP = GETDATE(),ERROR_MSG = '{_limilab.ErrorMessage}' WHERE GUID = {oGuid} " + MSSQLInstance.ExecuteNonQuery(oSQL) + If _messageSend = True Then + Select Case Database + Case DatabaseType.Firebird + oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + _Firebird.ExecuteNonQuery(oSQL) + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + MSSQLInstance.ExecuteNonQuery(oSQL) + End Select + _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo} - althogh there was an error in connection close!") + + End If + + End Select End If - End If - End If + Next ' Account Queue - _messageSend = _limilab.NewSMTPEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oMailADDED, oAttachment) + Dim oDisconnected = _MailSender.DisconnectFromServer() + If oDisconnected = False Then + _Logger.Warn("Error while disconnecting from Server. Continuing.") + End If - If _messageSend Then + _Logger.Info("Sent [{0}] mails for account [{1}]", oTotalSent.Count, oAccount.Guid) + _Logger.Info("Successful: [{0}], Failed: [{1}]", oSuccessfulSent.Count, oFailedSent.Count) + Catch ex As Exception - Select Case Database - Case DatabaseType.Firebird - oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" - If oSQL.Contains(",COMMENT = ''") Then - oSQL.Replace(",COMMENT = ''", "") - End If - _Firebird.ExecuteNonQuery(oSQL) - Case DatabaseType.MSSQL - oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " - If oSQL.Contains(",COMMENT = ''") Then - oSQL.Replace(",COMMENT = ''", "") - End If - MSSQLInstance.ExecuteNonQuery(oSQL) - End Select - _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo}") - Threading.Thread.Sleep(500) - Else - Select Case Database - 'Case DatabaseType.Firebird - ' oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" - ' If oSQL.Contains(",COMMENT = ''") Then - ' oSQL.Replace(",COMMENT = ''", "") - ' End If - ' _Firebird.ExecuteNonQuery(oSQL) - Case DatabaseType.MSSQL - oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET ERROR_TIMESTAMP = GETDATE(),ERROR_MSG = '{_limilab.ErrorMessage}' WHERE GUID = {oGuid} " - MSSQLInstance.ExecuteNonQuery(oSQL) - If _messageSend = True Then - Select Case Database - Case DatabaseType.Firebird - oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" - If oSQL.Contains(",COMMENT = ''") Then - oSQL.Replace(",COMMENT = ''", "") - End If - _Firebird.ExecuteNonQuery(oSQL) - Case DatabaseType.MSSQL - oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " - If oSQL.Contains(",COMMENT = ''") Then - oSQL.Replace(",COMMENT = ''", "") - End If - MSSQLInstance.ExecuteNonQuery(oSQL) - End Select - _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo} - althogh there was an error in connection close!") + _Logger.Warn("Could not send mails for account [{0}]", oAccount.Guid) + _Logger.Error(ex) - End If + End Try - End Select - End If - Next + Next ' Accounts Return True Catch ex As Exception @@ -397,6 +495,7 @@ Public Class EmailService _Logger.Error(e.Error) End If Catch ex As Exception + _Logger.Warn("Error while processing result of Worker!") _Logger.Error(e.Error) End Try End Sub @@ -405,6 +504,7 @@ Public Class EmailService Try _Logger.Warn("Service {0} was stopped.", ServiceName) Catch ex As Exception + _Logger.Warn("Error while stopping service!") _Logger.Error(ex) End Try End Sub diff --git a/Services.EmailService/EmailServiceOld.vb b/Services.EmailService/EmailServiceOld.vb new file mode 100644 index 00000000..47f3a320 --- /dev/null +++ b/Services.EmailService/EmailServiceOld.vb @@ -0,0 +1,419 @@ +Imports System.ComponentModel +Imports DigitalData.Modules.Logging +Imports DigitalData.Modules.Database +Imports DigitalData.Modules.Messaging +Imports DigitalData.Modules.Filesystem +Imports DigitalData.Modules.Language +Imports System.Timers +Imports System.IO +Imports DigitalData.Modules.Encryption + +Public Class EmailServiceOld + Private _Logger As Logger + Private _LogConfig As LogConfig + Private _Firebird As Firebird + Private _MSSQL As MSSQLServer + Private _MSSQL_Test As MSSQLServer + Private _Encryption As EncryptionLegacy + Private _EmailQueue As BackgroundWorker + Private _QueueTimer As Timer + Private _AnyDatabaseInitialized As Boolean = False + Private _limilab As DigitalData.Modules.Messaging.Limilab + Private _messageSend As Boolean = False + + Private Enum DatabaseType + Firebird + MSSQL + End Enum + + ' Original Line + 'Protected Overrides Sub OnStart(ByVal args() As String) + Protected Sub OnStart(ByVal args() As String) + Try + ' === Initialize Logger === + _LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "EmailService") + _LogConfig.Debug = My.Settings.DEBUG + + _Logger = _LogConfig.GetLogger() + Try + Dim directory As New IO.DirectoryInfo(_LogConfig.LogDirectory) + + For Each file As IO.FileInfo In directory.GetFiles + If (Now - file.CreationTime).Days > 29 Then + file.Delete() + Else + Exit For + End If + + + Next + Catch ex As Exception + + End Try + + ' Original Line + '_Logger.Info("Starting {0}", ServiceName) + _Logger.Info("Starting {0}", "Email Service") + + ' === Inititalize Encryption === + + _Logger.NewBlock("Inititalize Encryption") + + _Encryption = New EncryptionLegacy() + + _Logger.EndBlock() + + ' === Initialize Databases === + + _Logger.NewBlock("Inititalize Databases") + + If My.Settings.FB_ConnString <> String.Empty Then + _Firebird = New Firebird(_LogConfig, My.Settings.FB_ConnString, My.Settings.FB_DATABASE, My.Settings.FB_USER, My.Settings.FB_PW) + + If _Firebird._DBInitialized = False Then + _Logger.Warn("Firebird Connection could not be established. Check the Error Log") + End If + End If + + If My.Settings.SQLSERVER_CS <> String.Empty Then + _MSSQL = New MSSQLServer(_LogConfig, My.Settings.SQLSERVER_CS) + + If _MSSQL.DBInitialized = False Then + _Logger.Warn("MSSQL Connection could not be established. Check the Error Log") + End If + 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 + _Logger.Warn("MSSQL Test Connection could not be established. Check the Error Log") + End If + End If + + _AnyDatabaseInitialized = _Firebird?._DBInitialized Or _MSSQL?.DBInitialized Or _MSSQL_Test?.DBInitialized + + _Logger.EndBlock() + + ' === Initialize Email === + + _Logger.NewBlock("Inititalize Email") + + _limilab = New Limilab(_LogConfig) + + _Logger.EndBlock() + + ' === Initialize Queue === + + _Logger.NewBlock("Inititalize Queue") + + If _AnyDatabaseInitialized Then + _EmailQueue = New BackgroundWorker() With { + .WorkerReportsProgress = True, + .WorkerSupportsCancellation = True + } + + AddHandler _EmailQueue.DoWork, AddressOf EmailQueue_DoWork + AddHandler _EmailQueue.RunWorkerCompleted, AddressOf EmailQueue_Completed + End If + + _Logger.EndBlock() + + ' === Initialize & Start Timer === + + _Logger.NewBlock("Initialize & Start Timer") + + If _AnyDatabaseInitialized Then + _QueueTimer = New Timer With { + .Interval = 60000, + .Enabled = True + } + + AddHandler _QueueTimer.Elapsed, AddressOf QueueTimer_Elapsed + End If + + _Logger.EndBlock() + + ' === Initial Run === + + If _AnyDatabaseInitialized Then + _Logger.Info("Starting Initial Run...") + _EmailQueue.RunWorkerAsync() + End If + Catch ex As Exception + _Logger.Error(ex) + End Try + End Sub + + Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs) + If Not _EmailQueue.IsBusy Then + _EmailQueue.RunWorkerAsync() + _Logger.Debug("Worker is ready, executing.") + Else + _Logger.Info("Worker is busy, skipping execution.") + End If + End Sub + + Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs) + Try + If _Firebird?._DBInitialized Then + _Logger.Debug("Starting Firebird Sending") + SendEmailFrom(DatabaseType.Firebird, Nothing) + End If + + If _MSSQL?.DBInitialized Then + _Logger.Debug("Starting MSSQL Sending") + SendEmailFrom(DatabaseType.MSSQL, _MSSQL) + End If + + If _MSSQL_Test?.DBInitialized Then + _Logger.Debug("Starting MSSQL Test Sending") + SendEmailFrom(DatabaseType.MSSQL, _MSSQL_Test) + End If + Catch ex As Exception + _Logger.Error(ex) + End Try + End Sub + + Private Function SendEmailFrom(Database As DatabaseType, MSSQLInstance As MSSQLServer) + Try + Dim oSQL As String = String.Empty + Dim oEmailAccounts As DataTable + Dim oEmailQueue As DataTable + + Select Case Database + Case DatabaseType.Firebird + oSQL = "SELECT * FROM TBEDM_EMAIL_ACCOUNT WHERE ACTIVE = True" + oEmailAccounts = _Firebird.GetDatatable(oSQL) + Case DatabaseType.MSSQL + oSQL = "SELECT * FROM TBDD_EMAIL_ACCOUNT WHERE ACTIVE = 1" + oEmailAccounts = MSSQLInstance.GetDatatable(oSQL) + End Select + + If IsNothing(oEmailAccounts) Then + _Logger.Warn("Error in TBEDM_EMAIL_ACCOUNT Query. Exiting.") + _Logger.Warn("Query: {0}", oSQL) + Return False + End If + + If oEmailAccounts.Rows.Count = 0 Then + _Logger.Warn("No Active Email Accounts Configured! Exiting.") + Return False + End If + + Select Case Database + Case DatabaseType.Firebird + oSQL = "SELECT * FROM TBEDM_EMAIL_QUEUE WHERE EMAIL_SENT IS NULL and EMAIL_TO <> ''" + oEmailQueue = _Firebird.GetDatatable(oSQL) + Case DatabaseType.MSSQL + oSQL = "SELECT * FROM TBEMLP_EMAIL_OUT WHERE EMAIL_SENT IS NULL and EMAIL_ADRESS <> ''" + oEmailQueue = MSSQLInstance.GetDatatable(oSQL) + End Select + + If IsNothing(oEmailQueue) Then + _Logger.Warn("Error in EmailQueue Query. Exiting.") + _Logger.Warn("Query: {0}", oSQL) + Return False + End If + + If oEmailQueue.Rows.Count = 0 Then + _Logger.Debug("Email Queue is empty. Exiting.") + Return False + End If + + Dim oEmailTo, oSubject, oBody As String + Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment, ofromName, oErrorMsg, oMailADDED + Dim oAccountId, oGuid, oJobId As Integer + + For Each oEmailToRow As DataRow In oEmailQueue.Rows + Dim oAccountMatch As Boolean = False + Dim oComment As String = String.Empty + + Select Case Database + Case DatabaseType.Firebird + oAccountId = oEmailToRow.Item("EMAIL_ACCOUNT_ID") + Case DatabaseType.MSSQL + oAccountId = oEmailToRow.Item("SENDING_PROFILE") + End Select + oErrorMsg = "" + For Each oAccountRow As DataRow In oEmailAccounts.Rows + If oAccountRow.Item("GUID") = oAccountId Then + oAccountMatch = True + + Select Case Database + Case DatabaseType.Firebird + oMailFrom = oAccountRow.Item("EMAIL_FROM") + ofromName = oMailFrom + oMailSMTP = oAccountRow.Item("SERVER_OUT") + oMailport = oAccountRow.Item("PORT_OUT") + oMailUser = oAccountRow.Item("EMAIL_USER") + oAuthType = oAccountRow.Item("AUTH_TYPE") + oMailPW = oAccountRow.Item("EMAIL_PW") + oMailADDED = "" + + Case DatabaseType.MSSQL + oMailFrom = oAccountRow.Item("EMAIL_FROM") + ofromName = oAccountRow.Item("EMAIL_FROM_NAME") + oMailSMTP = oAccountRow.Item("EMAIL_SMTP") + oMailport = oAccountRow.Item("PORT") + oMailUser = oAccountRow.Item("EMAIL_USER") + oAuthType = oAccountRow.Item("AUTH_TYPE") + oMailPW = oAccountRow.Item("EMAIL_PW") + oMailADDED = oAccountRow.Item("ADDED_WHEN").ToString + Try + oErrorMsg = IIf(IsDBNull(oAccountRow.Item("ERROR_MSG")), "", oAccountRow.Item("ERROR_MSG")) + Catch ex As Exception + oErrorMsg = "" + End Try + + End Select + + Dim oPasswordPlain = _Encryption.DecryptData(oMailPW) + If Not IsNothing(oPasswordPlain) Then + oMailPW = oPasswordPlain + Else + _Logger.Warn("Could not decrypt email password. Exiting.") + Return False + End If + End If + Next + + If IsNothing(oMailFrom) Or IsNothing(oMailPW) Then + If oAccountMatch Then + _Logger.Warn("Account credentials are empty. Exiting.") + Else + _Logger.Warn("Account credentials are empty and account with Id {0} does not match the configuration. Exiting.", oAccountId) + End If + + Return False + End If + If oErrorMsg <> String.Empty Then + + End If + + Select Case Database + Case DatabaseType.Firebird + oGuid = oEmailToRow.Item("GUID") + oEmailTo = oEmailToRow.Item("EMAIL_TO") + _Logger.Debug("oEmailTo: {0}", oEmailTo) + oSubject = oEmailToRow.Item("EMAIL_SUBJ") + _Logger.Debug("oSubject: {0}", oSubject) + oBody = oEmailToRow.Item("EMAIL_BODY") + _Logger.Debug("oBody: {0}", oBody) + oJobId = oEmailToRow.Item("JOB_ID") + _Logger.Debug("oJOB_ID: {0}", oJobId) + oAttachment = Utils.NotNull(oEmailToRow.Item("EMAIL_ATTMT1"), String.Empty) + + Case DatabaseType.MSSQL + oGuid = oEmailToRow.Item("GUID") + oEmailTo = oEmailToRow.Item("EMAIL_ADRESS") + _Logger.Debug($"oEmailTo: {oEmailTo}") + oSubject = oEmailToRow.Item("EMAIL_SUBJ") + _Logger.Debug($"oSubject: {oSubject}") + oBody = oEmailToRow.Item("EMAIL_BODY") + _Logger.Debug($"oBody: {oBody}") + oJobId = oEmailToRow.Item("REFERENCE_ID") + _Logger.Debug($"oJOB_ID: {oJobId}") + oAttachment = Utils.NotNull(oEmailToRow.Item("EMAIL_ATTMT1"), String.Empty) + End Select + + If oAttachment <> String.Empty Then + If oAttachment.ToString.Contains("\") Then + If IO.File.Exists(oAttachment) = False Then + _Logger.Warn($"Email Attachment [{oAttachment}] not existing!") + oComment = $"Email Attachment [{oAttachment}] not existing!" + oAttachment = String.Empty + Else + _Logger.Debug("Email Attachment is: {0}", oAttachment) + End If + End If + + End If + + _messageSend = _limilab.NewSMTPEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oMailADDED, oAttachment) + + If _messageSend Then + + Select Case Database + Case DatabaseType.Firebird + oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + _Firebird.ExecuteNonQuery(oSQL) + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + MSSQLInstance.ExecuteNonQuery(oSQL) + End Select + _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo}") + Threading.Thread.Sleep(500) + Else + Select Case Database + 'Case DatabaseType.Firebird + ' oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" + ' If oSQL.Contains(",COMMENT = ''") Then + ' oSQL.Replace(",COMMENT = ''", "") + ' End If + ' _Firebird.ExecuteNonQuery(oSQL) + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET ERROR_TIMESTAMP = GETDATE(),ERROR_MSG = '{_limilab.ErrorMessage}' WHERE GUID = {oGuid} " + MSSQLInstance.ExecuteNonQuery(oSQL) + If _messageSend = True Then + Select Case Database + Case DatabaseType.Firebird + oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + _Firebird.ExecuteNonQuery(oSQL) + Case DatabaseType.MSSQL + oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET EMAIL_SENT = GETDATE(),COMMENT = '{oComment}' WHERE GUID = {oGuid} " + If oSQL.Contains(",COMMENT = ''") Then + oSQL.Replace(",COMMENT = ''", "") + End If + MSSQLInstance.ExecuteNonQuery(oSQL) + End Select + _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo} - althogh there was an error in connection close!") + + End If + + End Select + End If + Next + + Return True + Catch ex As Exception + _Logger.Warn("Error in SendEmailFrom. Email was not sent.") + _Logger.Error(ex) + Return False + End Try + End Function + + Private Sub EmailQueue_Completed(sender As Object, e As RunWorkerCompletedEventArgs) + Try + If e.Cancelled Then + _Logger.Warn("EmailQueue has been cancelled manually!") + ElseIf e.Error IsNot Nothing Then + _Logger.Warn("Unexpected Error in EmailQueue: {0}", e.Error.Message) + _Logger.Error(e.Error) + End If + Catch ex As Exception + _Logger.Error(e.Error) + End Try + End Sub + + 'Original Line + 'Protected Overrides Sub OnStop() + Protected Sub OnStop() + Try + '_Logger.Warn("Service {0} was stopped.", ServiceName) + _Logger.Warn("Service {0} was stopped.", "Email Service") + Catch ex As Exception + _Logger.Error(ex) + End Try + End Sub +End Class