519 lines
21 KiB
VB.net
519 lines
21 KiB
VB.net
Imports System.Timers
|
|
Imports System.IO
|
|
Imports System.ComponentModel
|
|
Imports DigitalData.Modules.Logging
|
|
Imports DigitalData.Modules.Database
|
|
Imports DigitalData.Modules.Messaging
|
|
Imports DigitalData.Modules.Language
|
|
Imports DigitalData.Modules.Encryption
|
|
Imports DigitalData.Modules.Config
|
|
|
|
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 _AnyDatabaseInitialized As Boolean = False
|
|
Private _limilab As Limilab
|
|
Private _MailSender As MailSender
|
|
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.FirebirdServer <> String.Empty Then
|
|
_Firebird = New Firebird(_LogConfig, _Config.FirebirdServer, _Config.FirebirdDatabase, _Config.FirebirdUser, _Config.FirebirdPassword)
|
|
|
|
If _Firebird._DBInitialized = False Then
|
|
_Logger.Warn("Firebird Connection could not be established. Check the Error Log")
|
|
End If
|
|
End If
|
|
|
|
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
|
|
|
|
' === Initialize Email ===
|
|
|
|
_Logger.Debug("Inititalize Email")
|
|
|
|
_limilab = New Limilab(_LogConfig)
|
|
_MailSender = New MailSender(_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 _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 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
|
|
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 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)
|
|
|
|
' ======= 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
|
|
|
|
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
|
|
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)
|
|
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}")
|
|
|
|
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
|
|
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} - although there was an error in connection close!")
|
|
|
|
End If
|
|
|
|
End Select
|
|
End If
|
|
|
|
Next ' Account Queue
|
|
|
|
Dim oDisconnected = _MailSender.DisconnectFromServer()
|
|
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
|
|
|
|
|
|
|
|
Protected Overrides Sub OnStop()
|
|
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
|
|
End Class
|