Imports System.Timers Imports System.IO Imports System.ComponentModel Imports DigitalData.Modules.Base Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports DigitalData.Modules.Messaging Imports DigitalData.Modules.Config Imports FirebirdSql.Data Public Class EmailService Private _Logger As Logger Private _LogConfig As LogConfig Private _ConfigManager As ConfigManager(Of Config) Private _Config As Config 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 _TempFiles As TempFiles Private _AnyDatabaseInitialized As Boolean = False Private _limilab As Limilab Private _MailSender As Mail.MailSender Private _AttachmentByteData As Byte() Private _RecentAttachmentByteData As Byte() Private ReadOnly _messageSend As Boolean = False Private Enum DatabaseType Firebird MSSQL End Enum Protected Overrides Sub OnStart(ByVal args() As String) Try ' === Initialize Logger === Dim oLogPath = Path.Combine(My.Application.Info.DirectoryPath, "Log") _LogConfig = New LogConfig(LogConfig.PathType.CustomPath, oLogPath, Nothing, "Digital Data", "EmailService") ' === Initialize Config === _ConfigManager = New ConfigManager(Of Config)(_LogConfig, My.Application.Info.DirectoryPath) _Config = _ConfigManager.Config _LogConfig.Debug = _Config.Debug Dim oCurrentDomain As AppDomain = AppDomain.CurrentDomain AddHandler oCurrentDomain.UnhandledException, AddressOf AppDomain_UnhandledException _Logger = _LogConfig.GetLogger() _Logger.Info($"DEBUG = {_LogConfig.Debug}") _Logger.Info("Starting {0}", ServiceName) ' === Inititalize Encryption === _Logger.Debug("Inititalize Encryption") _Encryption = New EncryptionLegacy() ' === Initialize Databases === _Logger.Info("Inititalize Databases") If _Config.SQLServerConnectionString <> String.Empty Then _MSSQL = New MSSQLServer(_LogConfig, _Config.SQLServerConnectionString) If _MSSQL.DBInitialized = False Then _Logger.Warn("MSSQL Connection could not be established. Check the Error Log") End If End If If _Config.SQLServerTestConnectionString <> String.Empty Then _MSSQL_Test = New MSSQLServer(_LogConfig, _Config.SQLServerTestConnectionString) 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 _TempFiles = New TempFiles(_LogConfig) _TempFiles.Create() ' === Initialize Email === _Logger.Debug("Inititalize Email") _limilab = New Limilab(_LogConfig) ' === Initialize Queue === _Logger.Debug("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 ' === Initialize & Start Timer === _Logger.Debug("Initialize & Start Timer") If _AnyDatabaseInitialized Then _QueueTimer = New Timer With { .Interval = 60000, .Enabled = True } AddHandler _QueueTimer.Elapsed, AddressOf QueueTimer_Elapsed End If ' === 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 AppDomain_UnhandledException(sender As Object, e As UnhandledExceptionEventArgs) Dim oException As Exception = e.ExceptionObject _Logger.Warn("An unhandled exception has occurred.") _Logger.Error(oException) End Sub Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs) 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) Try 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 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) Else _Logger.Debug("Email Queue successfully processed.") End If Catch ex As Exception _Logger.Warn("Error while processing result of Worker!") _Logger.Error(e.Error) End Try End Sub 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 = Nothing Dim oAccounts As New List(Of EmailAccount) 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 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 <> ''" oEmailQueue = _Firebird.GetDatatable(oSQL) Case DatabaseType.MSSQL If My.Settings.MSSQL_SELECT <> String.Empty Then _Logger.Debug("My.Settings.MSSQL_SELECT will be used..") oSQL = My.Settings.MSSQL_SELECT Else oSQL = "SELECT * FROM TBEMLP_EMAIL_OUT WHERE EMAIL_SENT IS NULL and EMAIL_ADRESS <> ''" End If 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 oGuid, oJobId As Integer For Each oAccount In oEmailAccounts 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}", "GUID ASC") Case Else oAccountQueue = oEmailQueue.Select($"SENDING_PROFILE = {oAccount.Guid}", "GUID ASC") 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) ' ======= Initialize Sender ======= _MailSender = New Mail.MailSender(_LogConfig) ' ======= Connect to server ======= Dim oOptions As New Mail.MailSession.MailSessionOptions() With { .EnableTls1_1 = _Config.TlsVersion.EnableTls1_1, .EnableTls1_2 = _Config.TlsVersion.EnableTls1_2, .EnableDefault = _Config.TlsVersion.EnableDefault } Dim oResult As Mail.MailSession.SessionInfo = _MailSender.Connect(oAccount.Server, oAccount.Port, oAccount.Username, oAccount.Password, oAccount.AuthType, oOptions) If oResult.Connected = 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 Dim oAttachment = String.Empty Dim oEmailTo = String.Empty Dim oSubject = String.Empty Dim oBody = String.Empty Dim oAddedWhen = Now Dim ATT1_RELATED_ID = String.Empty Dim ATT1_REL_TYPE = String.Empty Select Case Database Case DatabaseType.Firebird 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 oGuid = oRow.ItemEx("GUID", 0) oEmailTo = oRow.ItemEx("EMAIL_ADRESS", String.Empty) _Logger.Debug($"EMAIL_ADRESS: {oEmailTo}") oSubject = oRow.ItemEx("EMAIL_SUBJ", String.Empty) _Logger.Debug($"EMAIL_SUBJ: {oSubject}") oBody = oRow.ItemEx("EMAIL_BODY", String.Empty) _Logger.Debug($"EMAIL_BODY: {oBody}") oJobId = oRow.ItemEx("REFERENCE_ID", 0) _Logger.Debug($"REFERENCE_ID: {oJobId}") oAddedWhen = oRow.ItemEx("ADDED_WHEN", Now) oAttachment = oRow.ItemEx("EMAIL_ATTMT1", String.Empty) ATT1_RELATED_ID = oRow.ItemEx("ATT1_RELATED_ID", String.Empty) ATT1_REL_TYPE = oRow.ItemEx("ATT1_REL_TYPE", String.Empty) End Select If ATT1_RELATED_ID <> String.Empty And ATT1_REL_TYPE <> String.Empty Then _Logger.Info($"Attachment via byte/ID [{ATT1_RELATED_ID}]...") If ATT1_REL_TYPE = "EnvelopeResult" Then GetEnvelope_Result_FileStreamByte(ATT1_RELATED_ID, MSSQLInstance) End If If IsNothing(_AttachmentByteData) = False Then Dim oTempFolder = _TempFiles.TempPath Dim oTempFilename = String.Concat(oTempFolder, "\", $"SigningReport_{ATT1_RELATED_ID}.pdf") Dim oFileFromByteData = CreateTempFileFromByte(oTempFilename) If Not IsNothing(oFileFromByteData) Then _Logger.Info($"oFileFromByteData is [{oFileFromByteData}]!") oAttachment = oFileFromByteData End If End If End If 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 = GetFirebirdUpdateString(oComment, oGuid) _Firebird.ExecuteNonQuery(oSQL) Case DatabaseType.MSSQL oSQL = GetSQLUpdateString(oComment, oGuid) MSSQLInstance.ExecuteNonQuery(oSQL) End Select _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo}") Else 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 oSQL = GetSQLUpdateString(oComment, oGuid) MSSQLInstance.ExecuteNonQuery(oSQL) _Logger.Info($"EmailID [{oGuid.ToString}] has been send to: {oEmailTo} - although there was an error in connection close!") End If End Select End If Next ' Account Queue Dim oDisconnected = _MailSender.Disconnect() If oDisconnected = False Then _Logger.Warn("Error while disconnecting from Server. Continuing.") End If _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 _Logger.Warn("Could not send mails for account [{0}]", oAccount.Guid) _Logger.Error(ex) End Try Next ' Accounts 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 Function GetSQLUpdateString(pComment As String, pGuid As Integer) As String Dim oSQL As String = "UPDATE TBEMLP_EMAIL_OUT SET " oSQL += " EMAIL_SENT = GETDATE() " If String.IsNullOrWhiteSpace(pComment) = False Then oSQL += $", COMMENT = '{pComment}' " End If oSQL += $" WHERE Guid = {pGuid}" Return oSQL End Function Private Function GetFirebirdUpdateString(pComment As String, pGuid As Integer) As String ' Vermutlich wird das nicht mehr gebraucht? Dim oSQL As String = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{pComment}' WHERE GUID = {pGuid}" If oSQL.Contains(",COMMENT = ''") Then oSQL.Replace(",COMMENT = ''", "") End If Return oSQL End Function Private Sub GetEnvelope_Result_FileStreamByte(ByVal pEnvID As Long, pMSSQL As MSSQLServer) Dim strSql As String 'For Document Try 'Get image data from gridview column. strSql = "Select [DOC_RESULT] from [TBSIG_ENVELOPE] WHERE GUID = " & pEnvID Dim obyteDB = pMSSQL.GetScalarValue(strSql) If Not IsDBNull(obyteDB) Then 'Get image data from DB Dim fileData As Byte() = DirectCast(obyteDB, Byte()) If Not fileData Is Nothing Then _AttachmentByteData = fileData Else _AttachmentByteData = Nothing End If Else _AttachmentByteData = Nothing End If Catch ex As Exception _Logger.Warn($"Error in GetEnvelope_Result_FileStreamByte [{ex.Message}]") _Logger.Error(ex) _AttachmentByteData = Nothing End Try End Sub Private Function CreateTempFileFromByte(ByVal sFileName As String) As String Try If Not _AttachmentByteData Is Nothing Then 'Read image data into a file stream Using fs As New FileStream(sFileName, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(_AttachmentByteData, 0, _AttachmentByteData.Length) 'Set image variable value using memory stream. fs.Flush() fs.Close() End Using 'Open File Return sFileName Else _Logger.Warn($"Error in CreateTempFileFromByte - _AttachmentByteData is nothing!") Return Nothing End If Catch ex As Exception _Logger.Warn($"Error in CreateTempFileFromByte [{ex.Message}]") _Logger.Error(ex) Return Nothing End Try End Function Protected Overrides Sub OnStop() Try _Logger.Warn("Service {0} was stopped.", ServiceName) _TempFiles.CleanUp() Catch ex As Exception _Logger.Warn("Error while stopping service!") _Logger.Error(ex) End Try End Sub End Class