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
+ }
+
+ Dim oCurrentDomain As AppDomain
+ AddHandler oCurrentDomain.UnhandledException, AddressOf AppDomain_UnhandledException
_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")
-
+ _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)
- 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
+ Dim oAccountQueue As DataRow()
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)
+ oAccountQueue = oEmailQueue.Select($"EMAIL_ACCOUNT_ID = {oAccount.Guid}")
+ Case Else
+ oAccountQueue = oEmailQueue.Select($"SENDING_PROFILE = {oAccount.Guid}")
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!")
+ ' 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
+ 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 Select
- End If
- Next
+ 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} - althogh 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
@@ -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