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 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 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 _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 _Logger.Info("Starting {0}", ServiceName) ' === 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 Protected Overrides Sub OnStop() Try _Logger.Warn("Service {0} was stopped.", ServiceName) Catch ex As Exception _Logger.Error(ex) End Try End Sub End Class