AppStd/Monorepo
8
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

EmailService: Big update

Browse Source
This commit is contained in:
Jonathan Jenne 2022-10-13 16:35:10 +02:00
parent d5b1d66de1
commit 165ade98f2
4 changed files with 728 additions and 205 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Services.EmailService/DDEmailService.vbproj
View File

@ -47,6 +47,9 @@
<OptionInfer>On</OptionInfer> <OptionInfer>On</OptionInfer>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Reference Include="DigitalData.Modules.Base">
<HintPath>..\..\DDModules\Base\bin\Debug\DigitalData.Modules.Base.dll</HintPath>
</Reference>
<Reference Include="DigitalData.Modules.Config"> <Reference Include="DigitalData.Modules.Config">
<HintPath>..\..\DDModules\Config\bin\Debug\DigitalData.Modules.Config.dll</HintPath> <HintPath>..\..\DDModules\Config\bin\Debug\DigitalData.Modules.Config.dll</HintPath>
</Reference> </Reference>
@ -109,6 +112,13 @@
<Import Include="System.Threading.Tasks" /> <Import Include="System.Threading.Tasks" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Compile Include="EmailService.Designer.vb">
<DependentUpon>EmailService.vb</DependentUpon>
</Compile>
<Compile Include="EmailService.vb">
<SubType>Component</SubType>
</Compile>
<Compile Include="EmailServiceOld.vb" />
<Compile Include="ModuleRuntime.vb" /> <Compile Include="ModuleRuntime.vb" />
<Compile Include="My Project\Application.Designer.vb"> <Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen> <AutoGen>True</AutoGen>
@ -120,12 +130,6 @@
<Compile Include="ProjectInstaller.vb"> <Compile Include="ProjectInstaller.vb">
<SubType>Component</SubType> <SubType>Component</SubType>
</Compile> </Compile>
<Compile Include="EmailService.vb">
<SubType>Component</SubType>
</Compile>
<Compile Include="EmailService.Designer.vb">
<DependentUpon>EmailService.vb</DependentUpon>
</Compile>
<Compile Include="My Project\AssemblyInfo.vb" /> <Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Resources.Designer.vb"> <Compile Include="My Project\Resources.Designer.vb">
<AutoGen>True</AutoGen> <AutoGen>True</AutoGen>

10
Services.EmailService/EmailService.Designer.vb generated
View File

@ -1,11 +1,11 @@
Imports System.ServiceProcess Imports System.ServiceProcess
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()>
Partial Class EmailService Partial Class EmailService
Inherits System.ServiceProcess.ServiceBase Inherits System.ServiceProcess.ServiceBase
'UserService überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen. 'UserService überschreibt den Löschvorgang, um die Komponentenliste zu bereinigen.
<System.Diagnostics.DebuggerNonUserCode()> _ <System.Diagnostics.DebuggerNonUserCode()>
Protected Overrides Sub Dispose(ByVal disposing As Boolean) Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try Try
If disposing AndAlso components IsNot Nothing Then If disposing AndAlso components IsNot Nothing Then
@ -17,8 +17,8 @@ Partial Class EmailService
End Sub End Sub
' Der Haupteinstiegspunkt für den Prozess ' Der Haupteinstiegspunkt für den Prozess
<MTAThread()> _ <MTAThread()>
<System.Diagnostics.DebuggerNonUserCode()> _ <System.Diagnostics.DebuggerNonUserCode()>
Shared Sub Main() Shared Sub Main()
Dim ServicesToRun() As System.ServiceProcess.ServiceBase Dim ServicesToRun() As System.ServiceProcess.ServiceBase
@ -39,7 +39,7 @@ Partial Class EmailService
' Hinweis: Die folgende Prozedur ist für den Komponenten-Designer erforderlich. ' Hinweis: Die folgende Prozedur ist für den Komponenten-Designer erforderlich.
' Das Bearbeiten ist mit dem Komponenten-Designer möglich. ' Das Bearbeiten ist mit dem Komponenten-Designer möglich.
' Das Bearbeiten mit dem Code-Editor ist nicht möglich. ' Das Bearbeiten mit dem Code-Editor ist nicht möglich.
<System.Diagnostics.DebuggerStepThrough()> _ <System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent() Private Sub InitializeComponent()
components = New System.ComponentModel.Container() components = New System.ComponentModel.Container()
Me.ServiceName = "Service1" Me.ServiceName = "Service1"

488
Services.EmailService/EmailService.vb
View File

@ -1,11 +1,10 @@
Imports System.ComponentModel Imports System.Timers
Imports System.IO
Imports System.ComponentModel
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Messaging Imports DigitalData.Modules.Messaging
Imports DigitalData.Modules.Filesystem
Imports DigitalData.Modules.Language Imports DigitalData.Modules.Language
Imports System.Timers
Imports System.IO
Imports DigitalData.Modules.Encryption Imports DigitalData.Modules.Encryption
Public Class EmailService Public Class EmailService
@ -18,8 +17,9 @@ Public Class EmailService
Private _EmailQueue As BackgroundWorker Private _EmailQueue As BackgroundWorker
Private _QueueTimer As Timer Private _QueueTimer As Timer
Private _AnyDatabaseInitialized As Boolean = False Private _AnyDatabaseInitialized As Boolean = False
Private _limilab As DigitalData.Modules.Messaging.Limilab Private _limilab As Limilab
Private _messageSend As Boolean = False Private _MailSender As MailSender
Private ReadOnly _messageSend As Boolean = False
Private Enum DatabaseType Private Enum DatabaseType
Firebird Firebird
@ -29,38 +29,26 @@ Public Class EmailService
Protected Overrides Sub OnStart(ByVal args() As String) Protected Overrides Sub OnStart(ByVal args() As String)
Try Try
' === Initialize Logger === ' === Initialize Logger ===
_LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "EmailService") Dim oLogPath = Path.Combine(My.Application.Info.DirectoryPath, "Log")
_LogConfig.Debug = My.Settings.DEBUG _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() _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) _Logger.Info("Starting {0}", ServiceName)
' === Inititalize Encryption === ' === Inititalize Encryption ===
_Logger.NewBlock("Inititalize Encryption") _Logger.Debug("Inititalize Encryption")
_Encryption = New EncryptionLegacy() _Encryption = New EncryptionLegacy()
_Logger.EndBlock()
' === Initialize Databases === ' === Initialize Databases ===
_Logger.NewBlock("Inititalize Databases") _Logger.Info("Inititalize Databases")
If My.Settings.FB_ConnString <> String.Empty Then 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) _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 _AnyDatabaseInitialized = _Firebird?._DBInitialized Or _MSSQL?.DBInitialized Or _MSSQL_Test?.DBInitialized
_Logger.EndBlock()
' === Initialize Email === ' === Initialize Email ===
_Logger.NewBlock("Inititalize Email") _Logger.Debug("Inititalize Email")
_limilab = New Limilab(_LogConfig) _limilab = New Limilab(_LogConfig)
_MailSender = New MailSender(_LogConfig)
_Logger.EndBlock() _Logger.EndBlock()
@ -141,13 +128,23 @@ Public Class EmailService
End Try End Try
End Sub 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) Private Sub QueueTimer_Elapsed(sender As Object, e As ElapsedEventArgs)
If Not _EmailQueue.IsBusy Then Try
_EmailQueue.RunWorkerAsync() If Not _EmailQueue.IsBusy Then
_Logger.Debug("Worker is ready, executing.") _EmailQueue.RunWorkerAsync()
Else _Logger.Debug("Worker is ready, executing.")
_Logger.Info("Worker is busy, skipping execution.") Else
End If _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 End Sub
Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs) Private Sub EmailQueue_DoWork(sender As Object, e As DoWorkEventArgs)
@ -171,11 +168,24 @@ Public Class EmailService
End Try End Try
End Sub 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 Try
Dim oSQL As String = String.Empty Dim oSQL As String = String.Empty
Dim oEmailAccounts As DataTable Dim oEmailAccounts As DataTable = Nothing
Dim oEmailQueue As DataTable Dim oAccounts As New List(Of EmailAccount)
Select Case Database Select Case Database
Case DatabaseType.Firebird Case DatabaseType.Firebird
@ -189,20 +199,94 @@ Public Class EmailService
If IsNothing(oEmailAccounts) Then If IsNothing(oEmailAccounts) Then
_Logger.Warn("Error in TBEDM_EMAIL_ACCOUNT Query. Exiting.") _Logger.Warn("Error in TBEDM_EMAIL_ACCOUNT Query. Exiting.")
_Logger.Warn("Query: {0}", oSQL) _Logger.Warn("Query: {0}", oSQL)
Return False Return Nothing
End If End If
If oEmailAccounts.Rows.Count = 0 Then 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.") _Logger.Warn("No Active Email Accounts Configured! Exiting.")
Return False Return False
End If End If
Select Case Database Select Case Database
Case DatabaseType.Firebird 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) oEmailQueue = _Firebird.GetDatatable(oSQL)
Case DatabaseType.MSSQL 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) oEmailQueue = MSSQLInstance.GetDatatable(oSQL)
End Select End Select
@ -217,168 +301,182 @@ Public Class EmailService
Return False Return False
End If End If
Dim oEmailTo, oSubject, oBody As String Dim oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oErrorMsg, oMailADDED
Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment, ofromName, oErrorMsg, oMailADDED Dim oGuid, oJobId As Integer
Dim oAccountId, oGuid, oJobId As Integer
For Each oEmailToRow As DataRow In oEmailQueue.Rows For Each oAccount In oEmailAccounts
Dim oAccountMatch As Boolean = False
Dim oComment As String = String.Empty
Select Case Database Try
Case DatabaseType.Firebird _Logger.Debug("Sending mails for Account [{0}]", oAccount.Guid)
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 Dim oAccountQueue As DataRow()
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 Select Case Database
Case DatabaseType.Firebird Case DatabaseType.Firebird
oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}" oAccountQueue = oEmailQueue.Select($"EMAIL_ACCOUNT_ID = {oAccount.Guid}")
If oSQL.Contains(",COMMENT = ''") Then Case Else
oSQL.Replace(",COMMENT = ''", "") oAccountQueue = oEmailQueue.Select($"SENDING_PROFILE = {oAccount.Guid}")
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 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 If
End Select End If
End If
Next 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 Return True
Catch ex As Exception Catch ex As Exception
@ -397,6 +495,7 @@ Public Class EmailService
_Logger.Error(e.Error) _Logger.Error(e.Error)
End If End If
Catch ex As Exception Catch ex As Exception
_Logger.Warn("Error while processing result of Worker!")
_Logger.Error(e.Error) _Logger.Error(e.Error)
End Try End Try
End Sub End Sub
@ -405,6 +504,7 @@ Public Class EmailService
Try Try
_Logger.Warn("Service {0} was stopped.", ServiceName) _Logger.Warn("Service {0} was stopped.", ServiceName)
Catch ex As Exception Catch ex As Exception
_Logger.Warn("Error while stopping service!")
_Logger.Error(ex) _Logger.Error(ex)
End Try End Try
End Sub End Sub

419
Services.EmailService/EmailServiceOld.vb Normal file
View File

@ -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