2023-09-19 13:15:42 +02:00

109 lines
3.9 KiB
VB.net

Imports System.Net
Imports System.Reflection
Imports System.IO
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Messaging
Imports DigitalData.Modules.Messaging.Mail
Imports Limilabs.Client.IMAP
Imports EmailProfiler.Common.ClassCurrent
Public Class clsEmailIMAP
Private ReadOnly Logger As Logger
Private ReadOnly _limilab As Limilab
Private Fetcher As MailFetcher
Public ReadOnly Property Client As Imap
Get
Return Fetcher.Client
End Get
End Property
Sub New(pLogConfig As LogConfig)
Logger = pLogConfig.GetLogger
_limilab = New Limilab(pLogConfig)
Fetcher = New MailFetcher(pLogConfig)
End Sub
Public Function FetchIMAPMessagesLimilab(Server As String, Port As Integer, Username As String, Password As String, AuthType As String) As Boolean
Try
Dim oSession = Fetcher.Connect(Server, Port, Username, Password, AuthType)
If oSession.Connected = False AndAlso oSession.Error IsNot Nothing Then
Logger.Warn("Connection to Mail Server failed!")
Logger.Error(oSession.Error)
Return False
ElseIf oSession.Connected = False Then
Logger.Warn("Connection to Mail Server failed!")
Return False
End If
Dim oMailIds As List(Of Long) = Fetcher.ListAllMails()
If oMailIds Is Nothing Then
Logger.Warn("List of UIDs was Nothing. Exiting.")
Return False
End If
If oMailIds.Count = 0 Then
Logger.Debug("No Emails found.")
Return True
End If
CURRENT_WORKMAIL_UID_LIST = oMailIds
Return True
'Logger.Debug("FetchIMAPMessagesLimilab - Fetching messages...")
'_limilab.InitIMAP(True, Server, Port, Username, Password, AuthType)
'Dim oListuids As New List(Of Long)
'oListuids = _limilab.IMAPGetMessageIDs_AllMails()
'If IsNothing(oListuids) Then
' Logger.Warn("List of UIDs was Nothing. Returning False.")
' Return False
'Else
' If oListuids.Count > 0 Then
' CURRENT_WORKMAIL_UID_LIST = oListuids
' Logger.Info("FetchIMAPMessagesLimilab - Found [{0}] messages", oListuids.Count)
' CURRENT_ImapObject = _limilab.CurrentImapObject
' Else
' Logger.Debug("FetchIMAPMessagesLimilab - No Emails found!")
' End If
' Return True
'End If
Catch ex As Exception
Logger.Error(ex)
Return False
End Try
End Function
''' <summary>
''' Uses a private API from MailWriter to write a MailMessage to disk.
''' May break in future versions of .NET
''' </summary>
Public Function WriteMessageToFile(Message As Mail.MailMessage, Filename As String) As Boolean
Dim oAssembly As Assembly = GetType(Mail.SmtpClient).Assembly
Dim oMailWriterType As Type = oAssembly.[GetType]("System.Net.Mail.MailWriter")
Try
Using oStream As New FileStream(Filename, FileMode.Create)
Dim oMailWriterConstructor As ConstructorInfo = oMailWriterType.GetConstructor(
BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, New Type() {GetType(Stream)}, Nothing
)
Dim oMailWriter As Object = oMailWriterConstructor.Invoke(New Object() {oStream})
Dim sendMethod As MethodInfo = GetType(Mail.MailMessage).GetMethod("Send", BindingFlags.Instance Or BindingFlags.NonPublic)
sendMethod.Invoke(Message, BindingFlags.Instance Or BindingFlags.NonPublic, Nothing, {oMailWriter, True, True}, Nothing)
End Using
Return True
Catch ex As Exception
Return Nothing
End Try
End Function
End Class