This commit is contained in:
Jonathan Jenne 2021-10-26 11:12:22 +02:00
commit 2b6e06c3fa
4 changed files with 161 additions and 42 deletions

View File

@ -1,10 +1,13 @@
Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Logging
Imports Limilabs.Mail Imports Limilabs.Mail
Imports Limilabs.Client.IMAP Imports Limilabs.Client.IMAP
Imports Limilabs.Client.SMTP
Imports Limilabs.Client Imports Limilabs.Client
Imports System.Net.Security Imports System.Net.Security
Imports System Imports System
Imports System.Security.Authentication Imports System.Security.Authentication
Imports Limilabs.Mail.Headers
Imports Limilabs.Mail.MIME
Public Class Limilab Public Class Limilab
Private Initialized As Boolean = False Private Initialized As Boolean = False
@ -16,11 +19,21 @@ Public Class Limilab
Private Password As String Private Password As String
Private AuthType As String Private AuthType As String
Private ImapObject As Imap Private ImapObject As Imap
Public ErrorMessage As String
Public Sub New(LogConfig As LogConfig) Public Sub New(LogConfig As LogConfig)
LogConfig = LogConfig LogConfig = LogConfig
Logger = LogConfig.GetLogger() Logger = LogConfig.GetLogger()
Logger.Info("Limilab initialized") Logger.Info("Limilab initialized")
End Sub End Sub
''' <summary>
''' Initializes the module.
''' </summary>
''' <param name="oImapServer">IP-Address or Domainname of Server</param>
''' <param name="oPort">IMAP-Port</param>
''' <param name="oUser">IMAP-Username</param>
''' <param name="oPassword">IMAP-Password</param>
''' <param name="oAuthType">Auth-Type</param>
''' <param name="Folder">The folder to fetch messages from. Defaults to `Inbox`</param>
Public Sub InitIMAP(oImapServer As String, oPort As Integer, oUser As String, oPassword As String, oAuthType As String, Optional Folder As String = "Inbox") Public Sub InitIMAP(oImapServer As String, oPort As Integer, oUser As String, oPassword As String, oAuthType As String, Optional Folder As String = "Inbox")
IMAPServer = oImapServer IMAPServer = oImapServer
IMAPPort = oPort IMAPPort = oPort
@ -32,11 +45,6 @@ Public Class Limilab
''' <summary> ''' <summary>
''' Tests connection to a given IMAP Server by connecting and doing a simple message query. ''' Tests connection to a given IMAP Server by connecting and doing a simple message query.
''' </summary> ''' </summary>
''' <param name="Server">IP-Address or Domainname of Server</param>
''' <param name="Port">IMAP-Port</param>
''' <param name="Username">IMAP-Username</param>
''' <param name="Password">IMAP-Password</param>
''' <param name="Folder">The folder to fetch messages from. Defaults to `Inbox`</param>
''' <returns>True if connection and query were successful. False otherwise.</returns> ''' <returns>True if connection and query were successful. False otherwise.</returns>
Public Function IMAPTestLogin() As Boolean Public Function IMAPTestLogin() As Boolean
Logger.Debug("Testing Login to Server {0}:{1} with user {2}", IMAPServer, IMAPPort, User) Logger.Debug("Testing Login to Server {0}:{1} with user {2}", IMAPServer, IMAPPort, User)
@ -52,6 +60,7 @@ Public Class Limilab
Return oReturn Return oReturn
Catch ex As Exception Catch ex As Exception
Logger.Error(ex) Logger.Error(ex)
ErrorMessage = ex.Message
Return False Return False
End Try End Try
End Function End Function
@ -61,29 +70,39 @@ Public Class Limilab
Return True Return True
End If End If
Dim oReturnImap As New Imap() Dim oReturnImap As New Imap()
AddHandler oReturnImap.ServerCertificateValidate, AddressOf Validate
Logger.Debug($"AUTH_TYPE [{AuthType}]")
If AuthType = "SSL/TLS" Then
If IMAPPort <> "993" Then
Logger.Debug($"Connecting with explizit port [{IMAPPort}]")
oReturnImap.Connect(IMAPServer, IMAPPort)
Else
Logger.Debug("Connecting to IMAP-Server without port...")
oReturnImap.ConnectSSL(IMAPServer)
End If
Logger.Debug($"Connect to [{IMAPServer}] successful!")
If AuthType.EndsWith("TLS") Then Dim oSupportsStartTLS As Boolean = oReturnImap.SupportedExtensions().Contains(ImapExtension.StartTLS)
oReturnImap.SSLConfiguration.EnabledSslProtocols = SslProtocols.Tls12 If oSupportsStartTLS And AuthType.EndsWith("TLS") Then
' we will use custom validation Logger.Debug("Server supports StartTLS, so starting...")
AddHandler oReturnImap.ServerCertificateValidate, AddressOf Validate oReturnImap.StartTLS()
Logger.Debug("Connecting to IMAP-Server without port...") Else
oReturnImap.Connect(IMAPServer) Logger.Info("Server supports no StartTLS")
oReturnImap.SSLConfiguration.EnabledSslProtocols = SslProtocols.Tls12
End If
ElseIf AuthType = "SSL" Then ElseIf AuthType = "SSL" Then
' we will use custom validation If IMAPPort <> "993" Then
AddHandler oReturnImap.ServerCertificateValidate, AddressOf Validate Logger.Debug($"Connecting with explizit port [{IMAPPort}]")
Logger.Debug($"Connecting to IMAP-Server with port {IMAPPort}...") oReturnImap.Connect(IMAPServer, IMAPPort)
oReturnImap.ConnectSSL(IMAPServer, IMAPPort) Else
Logger.Debug("Connecting to IMAP-Server without port...")
oReturnImap.ConnectSSL(IMAPServer)
End If
ElseIf AuthType = "Simple" Then ElseIf AuthType = "Simple" Then
End If End If
Logger.Debug(">> Connected to IMAP-Server!") Logger.Debug(">> Connected to IMAP-Server!")
Dim oSupportsStartTLS As Boolean = oReturnImap.SupportedExtensions() _
.Contains(ImapExtension.StartTLS)
If oSupportsStartTLS And AuthType.EndsWith("TLS") Then
Logger.Debug("Server supports StartTLS, so starting...")
oReturnImap.StartTLS()
End If
Logger.Debug("Login with User and password...") Logger.Debug("Login with User and password...")
oReturnImap.UseBestLogin(User, Password) oReturnImap.UseBestLogin(User, Password)
Logger.Debug(">> Logged on!") Logger.Debug(">> Logged on!")
@ -91,6 +110,7 @@ Public Class Limilab
Return True Return True
Catch ex As Exception Catch ex As Exception
Logger.Error(ex) Logger.Error(ex)
ErrorMessage = ex.Message
If Not IsNothing(ex.InnerException) Then If Not IsNothing(ex.InnerException) Then
Logger.Warn("Inner Exception ImapConnect: " + ex.InnerException.Message) Logger.Warn("Inner Exception ImapConnect: " + ex.InnerException.Message)
End If End If
@ -125,25 +145,121 @@ Public Class Limilab
Return oListuids Return oListuids
Catch ex As Exception Catch ex As Exception
Logger.Error(ex) Logger.Error(ex)
ErrorMessage = ex.Message
Return oListuids Return oListuids
End Try End Try
End Function End Function
Public Function GetMessageUids(oImapServer As String, oPort As Integer, oUser As String, oPassword As String, oSSL As Boolean)
Try
Catch ex As Exception
End Try
End Function
Public Function DeleteMessageByUID(oUID As String) As Boolean Public Function DeleteMessageByUID(oUID As String) As Boolean
Try Try
ImapObject.DeleteMessageByUID(oUID) ImapObject.DeleteMessageByUID(oUID)
Return True Return True
Catch ex As Exception Catch ex As Exception
Logger.Error(ex) Logger.Error(ex)
ErrorMessage = ex.Message
Return False Return False
End Try End Try
End Function End Function
''' <summary>
''' Creates a MailObject and sends Mail via smtp.
''' </summary>
''' <returns>True if Message was send. False otherwise.</returns>
Public Function NewSMTPEmail(mailto As String, mailSubject As String, mailBody As String,
mailfrom As String, mailsmtp As String, mailport As Integer, mailUser As String, mailPW As String,
AUTH_TYPE As String, SENDER_INSTANCE As String, ADDED_DATETIME As String, Optional attachmentString As String = "", Optional Test As Boolean = False)
Try
Dim oError As Boolean = False
Dim oReceipiants As String()
If mailto.Contains(";") Then
oReceipiants = mailto.Split(";")
Else
ReDim Preserve oReceipiants(0)
oReceipiants(0) = mailto
End If
For Each oMailReceipiant As String In oReceipiants
Logger.Debug($"oMailReceipiant [{oMailReceipiant}]")
Logger.Debug($"mailsmtp [{mailsmtp}]")
Logger.Debug($"mailport [{mailport}]")
Logger.Debug($"mailSubject [{mailSubject}]")
Dim oMailBuilder As New MailBuilder()
oMailBuilder.From.Add(New MailBox(mailfrom))
oMailBuilder.[To].Add(New MailBox(oMailReceipiant))
oMailBuilder.Subject = mailSubject
If ADDED_DATETIME <> "" Then
mailBody &= "<p>Creation-time: " & ADDED_DATETIME
End If
If Test = True Then
oMailBuilder.Html = $"This is a Testmail! <p> The body-text will be replaced within profile! <p> mailsmtp: {mailsmtp} <br> mailport: {mailport}
<br> mailUser: {mailUser} <br> mailPW: XXXX <br> AUTH_TYPE: {AUTH_TYPE}"
Else
oMailBuilder.Html = mailBody
End If
Logger.Debug($"mailBody [{oMailBuilder.Html.ToString}]")
If attachmentString <> "" Then
' Read attachment from disk, add it to Attachments collection
If System.IO.File.Exists(attachmentString) Then
Dim oAttachment As MimeData = oMailBuilder.AddAttachment(attachmentString)
End If
End If
Dim email As IMail = oMailBuilder.Create()
' Send the message
Using oSmtp As New Smtp()
AddHandler oSmtp.ServerCertificateValidate, AddressOf Validate
Logger.Debug($"AUTH_TYPE [{AUTH_TYPE}]")
If AUTH_TYPE = "SSL" Then
Try
If mailport <> "465" Then
Logger.Debug($"Connecting with explizit port [{mailport}]")
oSmtp.Connect(mailsmtp, mailport)
Logger.Debug($"Connect to [{mailsmtp}] successful!")
Else
oSmtp.ConnectSSL(mailsmtp)
End If
Catch ex As Exception
Logger.Error(ex)
End Try
ElseIf AUTH_TYPE = "SSL/TLS" Then
'##########################################################################################
'Tested with ExchangeServer SWB 22.10.2021
'##########################################################################################
If mailport <> "587" Then
Logger.Debug($"Connecting with explizit port [{mailport}]")
oSmtp.Connect(mailsmtp, mailport)
Else
oSmtp.Connect(mailsmtp)
End If
Logger.Debug($"Connect to [{mailsmtp}] successful!")
Dim supportsStartTLS As Boolean = oSmtp.SupportedExtensions().Contains(SmtpExtension.StartTLS)
If supportsStartTLS = True Then
oSmtp.StartTLS()
Logger.Debug($"TLS started!")
Else
Logger.Info("Server supports no StartTLS")
oSmtp.SSLConfiguration.EnabledSslProtocols = SslProtocols.Tls12
End If
Else
oSmtp.Connect(mailsmtp)
End If
Logger.Debug($"mailUser [{mailUser}]")
oSmtp.UseBestLogin(mailUser, mailPW) ' remove if not needed
oSmtp.SendMessage(email)
Logger.Info("Message to " & oMailReceipiant & " has been send.")
oSmtp.Close()
End Using
Next
Return True
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return False
End Try
End Function
End Class End Class

View File

@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.3.0.0")> <Assembly: AssemblyVersion("1.5.0.0")>
<Assembly: AssemblyFileVersion("1.3.0.0")> <Assembly: AssemblyFileVersion("1.5.0.0")>

View File

@ -14,11 +14,12 @@ Public Class EmailService
Private _Firebird As Firebird Private _Firebird As Firebird
Private _MSSQL As MSSQLServer Private _MSSQL As MSSQLServer
Private _MSSQL_Test As MSSQLServer Private _MSSQL_Test As MSSQLServer
Private _Email As Email
Private _Encryption As EncryptionLegacy Private _Encryption As EncryptionLegacy
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 _messageSend As Boolean = False
Private Enum DatabaseType Private Enum DatabaseType
Firebird Firebird
@ -30,6 +31,7 @@ Public Class EmailService
' === Initialize Logger === ' === Initialize Logger ===
_LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "EmailService") _LogConfig = New LogConfig(LogConfig.PathType.CustomPath, Path.Combine(My.Application.Info.DirectoryPath, "Log"), Nothing, "Digital Data", "EmailService")
_LogConfig.Debug = My.Settings.DEBUG _LogConfig.Debug = My.Settings.DEBUG
_Logger = _LogConfig.GetLogger() _Logger = _LogConfig.GetLogger()
Try Try
Dim directory As New IO.DirectoryInfo(_LogConfig.LogDirectory) Dim directory As New IO.DirectoryInfo(_LogConfig.LogDirectory)
@ -93,7 +95,7 @@ Public Class EmailService
_Logger.NewBlock("Inititalize Email") _Logger.NewBlock("Inititalize Email")
_Email = New Email(_LogConfig) _limilab = New Limilab(_LogConfig)
_Logger.EndBlock() _Logger.EndBlock()
@ -216,7 +218,7 @@ Public Class EmailService
End If End If
Dim oEmailTo, oSubject, oBody As String Dim oEmailTo, oSubject, oBody As String
Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment, ofromName, oErrorMsg Dim oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, oAttachment, ofromName, oErrorMsg, oMailADDED
Dim oAccountId, oGuid, oJobId As Integer Dim oAccountId, oGuid, oJobId As Integer
For Each oEmailToRow As DataRow In oEmailQueue.Rows For Each oEmailToRow As DataRow In oEmailQueue.Rows
@ -243,6 +245,7 @@ Public Class EmailService
oMailUser = oAccountRow.Item("EMAIL_USER") oMailUser = oAccountRow.Item("EMAIL_USER")
oAuthType = oAccountRow.Item("AUTH_TYPE") oAuthType = oAccountRow.Item("AUTH_TYPE")
oMailPW = oAccountRow.Item("EMAIL_PW") oMailPW = oAccountRow.Item("EMAIL_PW")
oMailADDED = ""
Case DatabaseType.MSSQL Case DatabaseType.MSSQL
oMailFrom = oAccountRow.Item("EMAIL_FROM") oMailFrom = oAccountRow.Item("EMAIL_FROM")
@ -252,6 +255,7 @@ Public Class EmailService
oMailUser = oAccountRow.Item("EMAIL_USER") oMailUser = oAccountRow.Item("EMAIL_USER")
oAuthType = oAccountRow.Item("AUTH_TYPE") oAuthType = oAccountRow.Item("AUTH_TYPE")
oMailPW = oAccountRow.Item("EMAIL_PW") oMailPW = oAccountRow.Item("EMAIL_PW")
oMailADDED = oAccountRow.Item("ADDED_WHEN").ToString
Try Try
oErrorMsg = IIf(IsDBNull(oAccountRow.Item("ERROR_MSG")), "", oAccountRow.Item("ERROR_MSG")) oErrorMsg = IIf(IsDBNull(oAccountRow.Item("ERROR_MSG")), "", oAccountRow.Item("ERROR_MSG"))
Catch ex As Exception Catch ex As Exception
@ -322,10 +326,9 @@ Public Class EmailService
End If End If
Dim oEmailSent As Boolean = False _messageSend = _limilab.NewSMTPEmail(oEmailTo, oSubject, oBody, oMailFrom, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oMailADDED, oAttachment)
oEmailSent = _Email.New_EmailISoft(oSubject, oBody, oEmailTo, oMailFrom, ofromName, oMailSMTP, oMailport, oMailUser, oMailPW, oAuthType, "DDEmailService", oAttachment)
If oEmailSent Then If _messageSend Then
Select Case Database Select Case Database
Case DatabaseType.Firebird Case DatabaseType.Firebird
@ -352,9 +355,9 @@ Public Class EmailService
' End If ' End If
' _Firebird.ExecuteNonQuery(oSQL) ' _Firebird.ExecuteNonQuery(oSQL)
Case DatabaseType.MSSQL Case DatabaseType.MSSQL
oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET ERROR_TIMESTAMP = GETDATE(),ERROR_MSG = '{_Email.Err_Message}' WHERE GUID = {oGuid} " oSQL = $"UPDATE TBEMLP_EMAIL_OUT SET ERROR_TIMESTAMP = GETDATE(),ERROR_MSG = '{_limilab.ErrorMessage}' WHERE GUID = {oGuid} "
MSSQLInstance.ExecuteNonQuery(oSQL) MSSQLInstance.ExecuteNonQuery(oSQL)
If _Email._msg_Send = True Then If _messageSend = True 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}" oSQL = $"UPDATE TBEDM_EMAIL_QUEUE SET EMAIL_SENT = CURRENT_TIMESTAMP,COMMENT = '{oComment}' WHERE GUID = {oGuid}"

View File

@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben: ' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")> ' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.3.0.0")> <Assembly: AssemblyVersion("1.4.0.0")>
<Assembly: AssemblyFileVersion("1.3.0.0")> <Assembly: AssemblyFileVersion("1.4.0.0")>