Modules/Messaging/Limilab.vb
2022-10-17 10:41:07 +02:00

405 lines
15 KiB
VB.net

Imports DigitalData.Modules.Logging
Imports Limilabs.Mail
Imports Limilabs.Client.IMAP
Imports Limilabs.Client.SMTP
Imports Limilabs.Client
Imports System.Net.Security
Imports System
Imports System.Security.Authentication
Imports Limilabs.Mail.Headers
Imports Limilabs.Mail.MIME
Imports Limilabs
Public Class Limilab
Private Initialized As Boolean = False
Private LogConfig As LogConfig
Private Logger As DigitalData.Modules.Logging.Logger
Private IMAPServer As String
Private IMAPPort As Integer
Private User As String
Private Password As String
Private AuthType As String
Public CurrentImapObject As Imap
Public ErrorMessage As String
Private CURR_ListUIDs As List(Of Long)
Public Sub New(LogConfig As LogConfig)
LogConfig = LogConfig
Logger = LogConfig.GetLogger()
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(Log_enabled As Boolean, oImapServer As String, oPort As Integer, oUser As String, oPassword As String, oAuthType As String, Optional Folder As String = "Inbox")
LOG_Limilab(Log_enabled)
IMAPServer = oImapServer
IMAPPort = oPort
User = oUser
Password = oPassword
AuthType = oAuthType
Initialized = True
End Sub
Public Function CloseImap() As Boolean
Try
If Initialized = False Then
Return True
Else
If Not IsNothing(CurrentImapObject) Then
CurrentImapObject.Close()
End If
Return True
End If
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return False
End Try
End Function
Private Function LOG_Limilab(Log_enabled As Boolean) As Boolean
Mail.Log.Enabled = Log_enabled
End Function
''' <summary>
''' Tests connection to a given IMAP Server by connecting and doing a simple message query.
''' </summary>
''' <returns>True if connection and query were successful. False otherwise.</returns>
Public Function IMAPTestLogin() As Boolean
Logger.Debug("Starting IMAPTestLogin ...")
If Initialized = False Then
Return False
End If
Try
Logger.Debug("Connecting...")
Dim oReturn As Boolean = ImapConnect()
If oReturn = True Then
CurrentImapObject.Close()
End If
Return oReturn
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return False
End Try
End Function
Public Function IMAPGetUnseenMessageIDs() As List(Of Long)
Dim oListuids As New List(Of Long)
Logger.Debug("Starting IMAPGetMessageIDs ...")
If Initialized = False Then
Return Nothing
End If
Try
Dim oConnect As Boolean = ImapConnect()
If oConnect = True Then
oListuids = ImapGetMessageIDs_Unseen()
CURR_ListUIDs = oListuids
End If
Return oListuids
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return Nothing
End Try
End Function
Public Function IMAPGetMessageIDs_AllMails() As List(Of Long)
Dim oListuids As New List(Of Long)
Logger.Debug("Starting IMAPGetMessageIDs ...")
If Initialized = False Then
Return Nothing
End If
Try
Dim oConnect As Boolean = ImapConnect()
If oConnect = True Then
oListuids = ImapGetMessageIDs_All()
CURR_ListUIDs = oListuids
End If
Return oListuids
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return Nothing
End Try
End Function
Private Function ImapConnect() As Boolean
Try
If Initialized = False Then
Return True
End If
Logger.Debug("ImapConnect {0}:{1} with user {2}", IMAPServer, IMAPPort, User)
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!")
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()
Else
Logger.Info("Server supports no StartTLS")
oReturnImap.SSLConfiguration.EnabledSslProtocols = SslProtocols.Tls12
End If
ElseIf AuthType = "SSL" 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
ElseIf AuthType = "Simple" Then
End If
Logger.Debug(">> Connected to IMAP-Server!")
Logger.Debug("Login with User and password...")
oReturnImap.UseBestLogin(User, Password)
Logger.Debug(">> Logged on!")
CurrentImapObject = oReturnImap
Return True
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
If Not IsNothing(ex.InnerException) Then
Logger.Warn("Inner Exception ImapConnect: " + ex.InnerException.Message)
End If
Return False
End Try
End Function
Private Sub Validate(
ByVal sender As Object,
ByVal e As ServerCertificateValidateEventArgs)
Const ignoredErrors As SslPolicyErrors =
SslPolicyErrors.RemoteCertificateChainErrors Or _ ' self-signed
SslPolicyErrors.RemoteCertificateNameMismatch ' name mismatch
Dim nameOnCertificate As String = e.Certificate.Subject
If (e.SslPolicyErrors And Not ignoredErrors) = SslPolicyErrors.None Then
e.IsValid = True
Return
End If
e.IsValid = False
End Sub
Private Function ImapGetMessageIDs_Unseen() As List(Of Long)
Dim oListuids As New List(Of Long)
Try
CurrentImapObject.SelectInbox()
oListuids = CurrentImapObject.Search(Flag.Unseen)
Return oListuids
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return Nothing
End Try
End Function
Private Function ImapGetMessageIDs_All() As List(Of Long)
Dim oListuids As New List(Of Long)
Try
CurrentImapObject.SelectInbox()
oListuids = CurrentImapObject.Search(Flag.All)
Return oListuids
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return Nothing
End Try
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 Limilabs.Client.SMTP.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
Public Function GetMailInfo(UID As Long) As Boolean
Try
Dim eml = CurrentImapObject.GetMessageByUID(UID)
Dim email As IMail = New MailBuilder().CreateFromEml(eml)
' Subject
Console.WriteLine(email.Subject)
' From
For Each m As MailBox In email.From
Console.WriteLine(m.Address)
Console.WriteLine(m.Name)
Next
' Date
Console.WriteLine(email.[Date])
' Text body of the message
Console.WriteLine(email.Text)
' Html body of the message
Console.WriteLine(email.Html)
' Custom header
Console.WriteLine(email.Document.Root.Headers("x-spam-value"))
' Save all attachments to disk
For Each mime As MimeData In email.Attachments
mime.Save("c:\" + mime.SafeFileName)
Next
Return True
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return False
End Try
End Function
Public Function GetMailObjects() As ArrayList
Try
Dim WORKMAIL_LIST As New ArrayList()
For Each oUID In CURR_ListUIDs
Dim oEml = CurrentImapObject.GetMessageByUID(oUID)
Dim oEmail As IMail = New MailBuilder().CreateFromEml(oEml)
WORKMAIL_LIST.Add(oEmail)
Next
Return WORKMAIL_LIST
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return Nothing
End Try
End Function
Public Function IMAP_DeleteByUID(UID As Long) As Boolean
Try
If Not IsNothing(CurrentImapObject) Then
CurrentImapObject.DeleteMessageByUID(UID)
Return True
Else
Return False
End If
Catch ex As Exception
Logger.Error(ex)
ErrorMessage = ex.Message
Return False
End Try
End Function
End Class