2023-10-09 14:54:48 +02:00

1034 lines
45 KiB
VB.net

Imports System.Text.RegularExpressions
Imports WINDREAMLib
Imports EmailProfiler.Common.ClassCurrent
Imports System.IO
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Database
Imports DigitalData.Modules.Base
Imports System.Threading
Imports Limilabs.Mail
Imports Limilabs.Mail.MIME
Imports Limilabs.Mail.Headers
Imports MailBox = Limilabs.Mail.Headers.MailBox
Imports DigitalData.Modules.Patterns
Public Class clsWorkEmail
Private Const SUBJECT_MAX_LENGTH = 25
Private Const MESSAGE_ID_MAX_LENGTH = 100
Private CurrentMail As MailContainer = Nothing
Private CurrentTempMailPath As String
Private CURRENT_MAIL_BODY_ALL As String
Private CURRENT_MAIL_BODY_ANSWER1 As String = ""
Private CURRENT_MAIL_BODY_Substr2 As String = ""
Private CURRENT_MAIL_SUBJECT As String = ""
Private CURRENT_MAIL_FROM As String = ""
Private CurrentMailProcessName As String
Private ReadOnly _Logger As Logger
Private ReadOnly _LogConfig As LogConfig
Private ReadOnly _DB_MSSQL As MSSQLServer
Private ReadOnly _UseWindream As Boolean
Private ReadOnly _windream As clsWindream_allgemein
Private ReadOnly _windream_index As clsWindream_Index
Private ReadOnly _windreamConnectionString As String
Private ReadOnly _Patterns As Patterns2
Private ReadOnly _EmailAccountID As Integer = 1
Private _worked_email As Boolean = False
Sub New(LogConf As LogConfig, ConStr As String, WmConStr As String, pUseWindream As Boolean, EmailAccountID As Integer, EmlProfPraefix As String)
Try
_Logger = LogConf.GetLogger
_LogConfig = LogConf
_DB_MSSQL = New MSSQLServer(LogConf, ConStr)
_Logger.Debug("clsWorkmail _email initialized")
_UseWindream = pUseWindream
_Patterns = New Patterns2(LogConf)
If pUseWindream Then
_windream = New clsWindream_allgemein(LogConf)
_windream_index = New clsWindream_Index(LogConf)
_windreamConnectionString = WmConStr
End If
_EmailAccountID = EmailAccountID
SUBJECT_PRAFIX = EmlProfPraefix
Catch ex As Exception
_Logger.Error(ex)
End Try
End Sub
Public Function WorkEmailMessage(pMailMessage As IMail, poUID As Long, pValidationSQL As String) As Boolean
Try
For Each m As MailBox In pMailMessage.From
CURRENT_MAIL_FROM = m.Address
Next
'TODO: Move all of these CURRENT_MAIL vars into a business object of type mail container
CurrentMail = New MailContainer(pMailMessage, poUID)
_Logger.Debug($"Working on email from: {CURRENT_MAIL_FROM}...Subject: {pMailMessage.Subject}")
CURRENT_MAIL_BODY_ALL = ""
CURRENT_MAIL_BODY_ANSWER1 = ""
CURRENT_MAIL_BODY_Substr2 = ""
CURRENT_MAIL_SUBJECT = pMailMessage.Subject.ToUpper.EscapeForSQL()
CURRENT_MAIL_UID = poUID
' 05.06.23
' The MessageID is now replaced by a SHA256 Hash of the MessageID
' The reason is that MessageIDs can be very long,
' which results in the final filepath exceeding the Windream/Windows maximum of 255 chars.
' 28.07.23
' The SHA256 Hash is now truncated to half the size
' which should be a good balance between uniqueness and length
'CURRENT_MAIL_MESSAGE_ID = StringEx.GetShortHash(pMailMessage.MessageID)
'If String.IsNullOrEmpty(CURRENT_MAIL_MESSAGE_ID) Then
' CURRENT_MAIL_MESSAGE_ID = Guid.NewGuid.ToString()
'
'ElseIf CURRENT_MAIL_MESSAGE_ID.Length > MESSAGE_ID_MAX_LENGTH Then
'
' ' MessageIds longer than 100 chars will be replaced with a guid to avoid errors
' ' because of file paths longer than 255 chars.
' CURRENT_MAIL_MESSAGE_ID = Hash(CURRENT_MAIL_MESSAGE_ID)
'
'Else
' ' Default case, should cover most message ids
' CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace(">", "").Replace("<", "")
' CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace("'", "")
'
'End If
If IsNothing(CURRENT_MAIL_SUBJECT) Then
CURRENT_MAIL_SUBJECT = ""
Else
_Logger.Debug("Subject: [{0}]", CURRENT_MAIL_SUBJECT)
End If
_Logger.Info($"Working on email from : {CURRENT_MAIL_FROM}...")
Dim oSql = $"Select COALESCE(MAX(GUID),0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{CurrentMail.MessageId}'"
Dim oHistoryID = _DB_MSSQL.GetScalarValue(oSql)
If oHistoryID > 0 Then
_Logger.Info($"Messsage with subject [{CURRENT_MAIL_SUBJECT}] from [{CURRENT_MAIL_FROM}] has already been worked!")
Return True
End If
Dim oTempMailExists As Boolean = SAVE2TEMP(CurrentMail)
'Checking wether Mail can be opened
Dim oTempMailAccessible As Boolean = False
If oTempMailExists = False Then
_Logger.Warn("Could not process email [{0}], file does not exist!", CurrentMail.MessageId)
Return False
End If
Try
Dim oFS As FileStream = File.OpenRead(CurrentTempMailPath)
oTempMailAccessible = True
oFS.Close()
Catch ex As Exception
_Logger.Warn($"Could not read the Temp-Mail. Insufficient rights? Message: {ex.Message}")
End Try
If oTempMailAccessible = False Then
_Logger.Warn("Could not process email [{0}], file does is not accessible!", CurrentMail.MessageId)
Return False
End If
MESSAGE_ERROR = False
If pValidationSQL <> "" Then
Dim oReplaceValues = New Dictionary(Of String, String) From {
{"EMAIL", CurrentMail.SenderAddress},
{"DOMAIN", CurrentMail.SenderDomain}
}
Dim pValidationSQLWithPlaceholders = _Patterns.ReplaceCustomValues(pValidationSQL, oReplaceValues)
Dim oResult As String = ObjectEx.NotNull(_DB_MSSQL.GetScalarValue(pValidationSQLWithPlaceholders), "")
If oResult <> "" Then
'insert history und exit
InsertHistoryEntryWithStatus(CurrentMail, "REJECTED", oResult)
AddToEmailQueueMSSQL(CurrentMail.MessageId, oResult, "Email validation failed", _EmailAccountID)
' Return early from processing eml
Return True
End If
End If
If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER]") Then
Return PROCESS_MANAGER_IN(CurrentMail)
Else
_Logger.Debug("CommonEmail-Process-Sniffer")
If COMMON_EMAIL_IN(CurrentMail) = True Then
InsertHistoryEntry(CurrentMail)
If CURRENT_ATTMT_COUNT = 0 Then
_Logger.Info("### Mail contained no Attachments!! ###")
Dim oBody = EmailStrings.EMAIL_NO_FERDS
If AddToEmailQueueMSSQL(CurrentMail.MessageId, oBody, "No Attachments", _EmailAccountID) = True Then
CURRENT_ImapObject.DeleteMessageByUID(poUID)
End If
End If
Return True
Else
Return False
End If
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Public Function AddToEmailQueueMSSQL(MessageId As String, BodyText As String, Comment As String, pEmailAccountId As Integer) As Boolean
Try
Dim oReference = MessageId
Dim oEmailTo = ""
Dim oSubject = $"{SUBJECT_PRAFIX} - {EmailStrings.EMAIL_SUBJECT_REJECTED}"
Dim oCreatedWho = "DDEmailProfiler"
Dim oMaskedBodyText = BodyText.Replace("'", "''")
Dim oSubjectBodyText = String.Format(EmailStrings.EMAIL_SUBJECT_TEXT, CURRENT_MAIL_SUBJECT)
Dim oCompleteBodyText = oMaskedBodyText & oSubjectBodyText
Dim oFinalBodyText = String.Format(EmailStrings.EMAIL_WRAPPING_TEXT, oCompleteBodyText)
Dim oEmailAddress = CURRENT_MAIL_FROM
If IsNothing(oEmailAddress) OrElse String.IsNullOrWhiteSpace(oEmailAddress) Then
_Logger.Warn("Could not find email-address for MessageId {0}", MessageId)
oEmailTo = String.Empty
Else
oEmailTo = oEmailAddress
End If
_Logger.Debug("Trying to generate Email:")
_Logger.Debug("To: {0}", oEmailTo)
_Logger.Debug("Subject: {0}", oSubject)
_Logger.Debug("Body {0}", oFinalBodyText)
Dim osql = $"Select MAX(GUID) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{MessageId}'"
Dim oHistoryID = _DB_MSSQL.GetScalarValue(osql)
If IsNumeric(oHistoryID) Then
Dim oInsert = $"INSERT INTO [dbo].[TBEMLP_EMAIL_OUT] (
[REMINDER_TYPE_ID]
,[SENDING_PROFILE]
,[REFERENCE_ID]
,[REFERENCE_STRING]
,[WF_ID]
,[EMAIL_ADRESS]
,[EMAIL_SUBJ]
,[EMAIL_BODY]
,[COMMENT]
,[ADDED_WHO])
VALUES
(77
,{pEmailAccountId}
,{oHistoryID}
,'{MessageId}'
,77
,'{oEmailTo}'
,'{oSubject}'
,'{oFinalBodyText}'
,'{Comment}'
,'{oCreatedWho}')"
Return _DB_MSSQL.ExecuteNonQuery(oInsert)
Else
_Logger.Warn($"!! Could not get oHistoryID in AddToEmailQueueMSSQL [{osql}]")
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function PROCESS_MANAGER_IN(pCurrentMail As MailContainer) As Boolean
Try
_Logger.Info(String.Format("PM-related message found....[{0}]", pCurrentMail.Mail.Subject))
_Logger.Debug(String.Format("PM-related message found....[{0}]", pCurrentMail.Mail.Subject))
Dim oExpression = "PROCESS_NAME = 'ProcessManager'"
'Filter the rows using Select() method of DataTable
Dim TEMP_PROCESS_PROFILE_DT As DataTable = DT_POLL_PROCESS
Dim PM_ROW As DataRow() = TEMP_PROCESS_PROFILE_DT.Select(oExpression)
For Each row As DataRow In PM_ROW
Try
WM_REFERENCE_INDEX = row("WM_REFERENCE_INDEX")
Catch ex As Exception
_Logger.Debug($"PM_IN Attention WM_REFERENCE_INDEX seems to be Empty/null: {ex.Message}")
WM_REFERENCE_INDEX = Nothing
End Try
WM_VECTOR_LOG = row("WM_VECTOR_LOG")
WM_OBJEKTTYPE = row("WM_OBJEKTTYPE")
WM_IDX_BODY_TEXT = row("WM_IDX_BODY_TEXT")
WM_IDX_BODY_SUBSTR_LENGTH = row("WM_IDX_BODY_SUBSTR_LENGTH")
DeleteMail = row("DELETE_MAIL")
If COPY2HDD(pCurrentMail, row("COPY_2_HDD"), row("PATH_ORIGINAL"), row("PATH_EMAIL_ERRORS"), False) = True Then
EXTRACT_BODY(pCurrentMail)
End If
Next
If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER][EA]") Then
_Logger.Info(String.Format("Message referencing to EASY-APPROVAL...."))
_Logger.Debug(String.Format("Message referencing to EASY-APPROVAL...."))
CurrentMailProcessName = "DD EasyApproval via Mail"
If CURRENT_MAIL_BODY_ANSWER1 <> "" Then
If CURRENT_MAIL_BODY_ANSWER1.EndsWith(":") Then
_Logger.Info(String.Format("Keyword contained a : at end...removing it..."))
CURRENT_MAIL_BODY_ANSWER1 = CURRENT_MAIL_BODY_ANSWER1.Replace(":", "")
End If
If GET_WMDOC_INFO() = True Then
If DT_STEPS.Rows.Count > 0 Then
WORK_POLL_STEPS()
Else
_Logger.Info("No steps configured for this Profile ....")
End If
End If
End If
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
'Logger.Debug("Unexpected Error in PROCESS_MANAGER_IN: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
Return False
End Try
End Function
Dim DoubleBytes As Double
Default Public Property FormatBytes(ByVal BytesCaller As ULong) As String
Get
Try
Select Case BytesCaller
Case Is >= 1099511627776
DoubleBytes = CDbl(BytesCaller / 1099511627776) 'TB
Return FormatNumber(DoubleBytes, 2) & " TB"
Case 1073741824 To 1099511627775
DoubleBytes = CDbl(BytesCaller / 1073741824) 'GB
Return FormatNumber(DoubleBytes, 2) & " GB"
Case 1048576 To 1073741823
DoubleBytes = CDbl(BytesCaller / 1048576) 'MB
Return FormatNumber(DoubleBytes, 2) & " MB"
Case 1024 To 1048575
DoubleBytes = CDbl(BytesCaller / 1024) 'KB
Return FormatNumber(DoubleBytes, 2) & " KB"
Case 0 To 1023
DoubleBytes = BytesCaller ' bytes
Return FormatNumber(DoubleBytes, 2) & " bytes"
Case Else
Return ""
End Select
Catch
Return ""
End Try
End Get
Set(value As String)
End Set
End Property
Function COMMON_EMAIL_IN(pCurrentMail As MailContainer) As Boolean
Try
_Logger.Info(String.Format("COMMON_EMAIL_IN...Subject [{0}]", pCurrentMail.Mail.Subject))
_Logger.Debug(String.Format("COMMON_EMAIL_IN...Subject [{0}]", pCurrentMail.Mail.Subject))
Dim oExpression = "PROCESS_NAME = 'Attachment Sniffer' or PROCESS_NAME = 'ZugFeRD-Parser'"
'Filter the rows using Select() method of DataTable
Dim TEMP_PROCESS_PROFILE_DT As DataTable = DT_POLL_PROCESS
Dim PM_ROW As DataRow() = TEMP_PROCESS_PROFILE_DT.Select(oExpression)
If PM_ROW.Length = 0 Then
_Logger.Info("ATTENTION: NO PROCESS-Definititon Filter [PROCESS_NAME = 'Attachment Sniffer' or PROCESS_NAME = 'ZugFeRD-Parser'] returned 0")
Return False
End If
For Each oRow As DataRow In PM_ROW
DeleteMail = oRow("DELETE_MAIL")
CurrentMailProcessName = oRow.Item("PROCESS_NAME")
WM_REFERENCE_INDEX = oRow.ItemEx("WM_REFERENCE_INDEX", "")
WM_VECTOR_LOG = oRow.ItemEx("WM_VECTOR_LOG", "")
WM_OBJEKTTYPE = oRow.Item("WM_OBJEKTTYPE")
WM_IDX_BODY_TEXT = oRow.Item("WM_IDX_BODY_TEXT")
WM_IDX_BODY_SUBSTR_LENGTH = oRow.Item("WM_IDX_BODY_SUBSTR_LENGTH")
Dim oPathOriginal As String = oRow.ItemEx("PATH_ORIGINAL", "")
Dim oExtractMainPath As String = oRow("PATH_EMAIL_TEMP")
Try
Dim oSplit As String()
Dim oStorage As String
Try
oSplit = oExtractMainPath.Split("\")
If oSplit.Length > 1 Then
oStorage = oSplit(0)
Dim oCheckdvr As New DriveInfo(oStorage)
If CURRENT_DRIVE_CHECK <> oStorage Then
CURRENT_DRIVE_CHECK = oStorage
End If
End If
Catch ex As Exception
_Logger.Warn($"Unexpected Error in Extracting Storage from [{oExtractMainPath}]: {ex.Message}")
End Try
Dim dvr As New DriveInfo(CURRENT_DRIVE_CHECK)
If dvr.IsReady = True Then
Dim oFreeSpace = dvr.TotalFreeSpace
Dim oresult = FormatBytes(oFreeSpace)
If oresult.EndsWith("MB") Then
Dim oRemainingMB As Integer = oresult.Replace(" MB", "")
If oRemainingMB < 150 Then
_Logger.Warn($"ATTENTION: THE REMAINING SPACE FOR DRIVE [{dvr.Name}] IS LESS THEN 150 MB. STOPPING EXTRACTION")
CURRENT_DRIVE_ISFULL = True
Return False
End If
ElseIf oresult.EndsWith("GB") Or oresult.EndsWith("TB") Then
If CURRENT_DRIVE_ISFULL = True Then
CURRENT_DRIVE_ISFULL = False
_Logger.Warn($"REMAINING SPACE OF [{dvr.Name}] IS NOW {oresult} - SO RESETTING CURRENT_DRIVE_ISFULL")
End If
End If
End If
Catch ex As Exception
_Logger.Warn($"Unexpected Error in Checking RemainingTotalFreeSpace for Storage [{oExtractMainPath}]: {ex.Message}")
End Try
If COPY2HDD(pCurrentMail, oRow("COPY_2_HDD"), oRow("PATH_ORIGINAL"), oRow("PATH_EMAIL_ERRORS"), True) = True Then
If EXTRACT_ATTACHMENTS(pCurrentMail, oExtractMainPath, oRow("PATH_EMAIL_ERRORS")) = True Then
Return True
Else
_Logger.Warn("!##Returning false from EXTRACT_ATTACHMENTS!##")
Return False
End If
Else
Return False
End If
Next
Return True
Catch ex As Exception
_Logger.Error(ex)
'Logger.Debug("Unexpected Error in PROCESS_MANAGER_IN: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
Return False
End Try
End Function
Private Function SAVE2TEMP(pCurrentMail As MailContainer) As Boolean
Dim oTempFilename As String
Try
Dim oTempPath As String = Path.Combine(Path.GetTempPath, "DD_EmailProfiler")
_Logger.Debug($"oTempPath is: {oTempPath} ...")
If Directory.Exists(oTempPath) = False Then
Directory.CreateDirectory(oTempPath)
End If
Dim oFileEntries As String() = Directory.GetFiles(oTempPath)
' Process the list of files found in the directory.
Dim oFileName As String
For Each oFileName In oFileEntries
Try
File.Delete(oFileName)
Catch ex As Exception
End Try
Next oFileName
Dim oResult As Boolean = False
' Subject can be SUBJECT_MAX_LENGTH chars at most,
' otherwise we run into errors with the path being too long
'Dim oSubjectFilename = CURRENT_MAIL_MESSAGE.Subject.Truncate(SUBJECT_MAX_LENGTH) & ".eml"
Dim oSubjectFilename = pCurrentMail.MessageId & ".eml"
oSubjectFilename = StringEx.RemoveInvalidCharacters(oSubjectFilename)
oTempFilename = Path.Combine(oTempPath, oSubjectFilename)
_Logger.Debug($"Filepath is: {oTempFilename}")
pCurrentMail.Mail.Save(oTempFilename)
CurrentTempMailPath = oTempFilename
_Logger.Debug($"Email saved to Temppath {CurrentTempMailPath}")
Dim oCounter As Integer = 1
Dim oCancel As Boolean
Do While File.Exists(CurrentTempMailPath) = False
_Logger.Debug("Trying to read saved mail.. ({0}/{1})", oCounter, 10)
Thread.Sleep(1000)
oCounter += 1
If oCounter > 10 Then
_Logger.Warn("It took to long to save the mail to Temppath!")
oCancel = True
Exit Do
End If
Loop
If oCancel = True Then
oResult = False
Else
If File.Exists(CurrentTempMailPath) Then
oResult = True
End If
End If
'Datei in Array zum Templöschen speichern
TEMP_FILES.Add(oTempFilename)
Return oResult
Catch ex As Exception
_Logger.Error(ex)
_Logger.Info($"Unexpected error in Save2Temp [{oTempFilename}]")
CurrentTempMailPath = Nothing
'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
Return False
End Try
End Function
Private Function COPY2HDD(pCurrentMail As MailContainer, pShouldCopyToDisk As Boolean, pDestination As String, pPathErrors As String, pUseMessageIdAsFilename As Boolean) As Boolean
Try
If pShouldCopyToDisk = True Then
_Logger.Debug("COPY_2_HDD is ACTIVE!")
'PATH_ERROR = pPathErrors
If Directory.Exists(pDestination) Then
Dim oTempFilename = Path.Combine(pDestination, $"{pCurrentMail.MessageId}.eml")
If File.Exists(oTempFilename) = False Then
pCurrentMail.Mail.Save(oTempFilename)
Dim oFileInfo As New FileInfo(oTempFilename)
Dim oFileLenth As Long = oFileInfo.Length
If oFileLenth > 0 Then
_Logger.Info($"[COPY2HDD] Email saved to ({oTempFilename})")
Return True
Else
_Logger.Warn("FileLenth of file [{0}] is 0! File will be deleted.", oTempFilename)
Try
File.Delete(oTempFilename)
Catch ex As Exception
_Logger.Error(ex)
End Try
Return False
End If
Else
_Logger.Info("COPY2HDD (" & pCurrentMail.Mail.Subject & ") already existing in [{oTempFilename}]!", False, "RUN_THREAD.COPY_2_HDD")
Return True
End If
Else
_Logger.Error("Destination directory [{0}] does not exist!", pDestination)
Return False
End If
Else
Return True
End If
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function EXTRACT_BODY(pCurrentMail As MailContainer)
Dim oTable As DataTable = _DB_MSSQL.GetDatatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))")
Dim oBodyText As String = ""
If Not IsNothing(pCurrentMail.Mail.Text) Then
CURRENT_MAIL_BODY_ALL = oBodyText
End If
If Not IsNothing(CURRENT_MAIL_BODY_ALL) Then
Dim oRow = oTable.Rows.Item(0)
' CURRENT_MAIL_BODY_ALL = oMsg_email.Body
Dim oPattern1 As String
Dim oPattern2 As String
Try
oPattern1 = oTable.Rows(0).Item("REGEX")
Catch ex As Exception
oPattern1 = ""
End Try
Try
oPattern2 = oTable.Rows(1).Item("REGEX")
Catch ex As Exception
oPattern2 = ""
End Try
Dim oReg As Regex = New Regex(oPattern1, RegexOptions.IgnoreCase)
Dim oMatch As Match = oReg.Match(CURRENT_MAIL_BODY_ALL)
Dim oClearedBodyText = CURRENT_MAIL_BODY_ALL
Do While oMatch.Success
oClearedBodyText = oClearedBodyText.Replace(oMatch.Value, "")
oMatch = oMatch.NextMatch()
Loop
_Logger.Debug($"Cleared bodytext after Regex1 is: {oClearedBodyText}")
Dim oReg2 As Regex = New Regex(oPattern2, RegexOptions.IgnoreCase)
Dim oMatch2 As Match = oReg2.Match(oClearedBodyText)
Do While oMatch2.Success
oClearedBodyText = oClearedBodyText.Replace(oMatch2.Value, "")
'Dim g As Group = m.Groups(1)
'If g.ToString.StartsWith("&") = False Then
' TEMP_HTML_RESULTS.Add(g.ToString())
'End If
oMatch2 = oMatch2.NextMatch()
Loop
_Logger.Debug($"Cleared bodytext after Regex2 is: {oClearedBodyText}")
CURRENT_MAIL_BODY_ALL = oClearedBodyText
Else
_Logger.Info($"Mailbody still is nothing after bodyExtraction!!")
End If
Try
If CURRENT_MAIL_BODY_ALL = String.Empty Then
_Logger.Warn("Mailbody is empty. Email can not be processed! - Please check the html-structure")
_Logger.Info("EXCEPTION - Mailbody is empty.Email can not be processed! - Please check the html-structure")
MESSAGE_ERROR = True
Return False
Else
_Logger.Debug($"Length of Body is [{CURRENT_MAIL_BODY_ALL.Length}] - Body Text is [{CURRENT_MAIL_BODY_ALL}]")
End If
CURRENT_MAIL_BODY_ALL = CURRENT_MAIL_BODY_ALL.Replace(vbLf, "")
Dim oSplit = CURRENT_MAIL_BODY_ALL.Split(Environment.NewLine)
Dim oCount As Integer = 0
Dim oReadLength As Integer = 0
For Each ostr As String In oSplit
ostr = ostr.Replace(vbCrLf, "")
If ostr = String.Empty Then
Continue For
End If
oCount += 1
If oCount = 1 Then
CURRENT_MAIL_BODY_ANSWER1 = ostr
Else
If ostr.StartsWith("##") Then
Exit For
ElseIf oCount = 2 Then
CURRENT_MAIL_BODY_Substr2 = ostr
Else
If ((oReadLength + ostr.Length) >= WM_IDX_BODY_SUBSTR_LENGTH) Or ostr.StartsWith("##") Then
Exit For
End If
CURRENT_MAIL_BODY_Substr2 = CURRENT_MAIL_BODY_Substr2 & vbNewLine & ostr
End If
oReadLength += ostr.Length
End If
Next
_Logger.Debug(String.Format("MailBody-ANSWER1:...[{0}]", CURRENT_MAIL_BODY_ANSWER1))
_Logger.Debug(String.Format("MailBody-ANSWER2:...[{0}]", CURRENT_MAIL_BODY_Substr2))
If CURRENT_MAIL_BODY_ANSWER1 = String.Empty Then
_Logger.Warn("CURRENT_MAIL_BODY_ANSWER1 is String.Empty: So the answer will interpreted as empty!")
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
MESSAGE_ERROR = True
Return False
End Try
End Function
Private Function EXTRACT_ATTACHMENTS(pCurrentMail As MailContainer, pExtractPath As String, pErrorPath As String)
_Logger.Debug("In EXTRACT_ATTACHMENTS...")
_Logger.Debug(String.Format("PATH_TEMP[{0}]", pExtractPath))
Dim oAttachmentCount As Integer
oAttachmentCount = 0
Try
If CurrentTempMailPath <> Nothing Then
If File.Exists(CurrentTempMailPath) Then
For Each oAttachment As MimeData In pCurrentMail.Mail.Attachments
Dim oATTFilename = oAttachment.SafeFileName.ToString.ToLower
Dim oValidExtensions = New List(Of String) From {"pdf", "xls", "xlsx", "doc", "docx", "ppt", "pptx"}
Dim oValidExt = oValidExtensions.Any(Function(ext) oATTFilename.EndsWith(ext))
If oValidExt = False Then
_Logger.Debug("Invalid FileExtension [{0}]", oATTFilename)
Continue For
End If
Dim oAttachmentFilePath = ""
_Logger.Info("Working on Attachment [{0}]", oAttachment.SafeFileName)
Try
'Dim oFilename = oAttachment.SafeFileName
'oFilename = CleanInput(oFilename)
'Logger.Debug($"oFilename [{oFilename}]")
'If oFilename = String.Empty Then
' oFilename = oAttachment.SafeFileName
'End If
'05.06.23
'The filename of attachments will be HASH~DOMAIN~SUBJECT(0,25) from now on
'oAttachmentFileString = Path.Combine(PATH_TEMP, $"{CURRENT_MAIL_MESSAGE_ID}~{oFilename}")
'28.07.23
'The original filename part will now be slugified to prevent errors
'when opening the file in windream
'05.09.23
'The filename will now only contain a hash and a counter to prevent all errors relating to filenames and subject lines being shit
Dim oFileInfo = New FileInfo(oAttachment.SafeFileName)
Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oAttachment.SafeFileName)
Dim oFilename = StringEx.ConvertTextToSlug(oFilenameWithoutExtension) & oFileInfo.Extension
'Dim oAttachmentFileName = $"{CURRENT_MAIL_MESSAGE_ID}~{pCurrentMail.SenderDomain}~{oFilename}"
Dim oAttachmentFileName = $"{pCurrentMail.MessageId}~Attm{oAttachmentCount}{oFileInfo.Extension}"
_Logger.Debug("Final Filename for Attachment: [{0}]", oAttachmentFileName)
oAttachmentFilePath = Path.Combine(pExtractPath, oAttachmentFileName)
_Logger.Debug("Final Path for Attachment: [{0}]", oAttachmentFilePath)
If File.Exists(oAttachmentFilePath) = False Then
_Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFilePath))
Try
oAttachment.Save(oAttachmentFilePath)
'oAttachment.Save(oAttachmentFileString)
Dim oFileInfo1 As New FileInfo(oAttachmentFilePath)
Dim oFileLenth As Long = oFileInfo1.Length
If oFileLenth > 2 Then
_Logger.Info(String.Format("Attachment saved to [{0}]", oAttachmentFilePath))
'INSERT_HISTORY_FB(CURRENT_MAIL_MESSAGE_ID, oAttachment.SafeFileName)
InsertAttachmentHistoryEntry(pCurrentMail, pCurrentMail.MessageId, oAttachment.SafeFileName, oAttachmentFileName)
oAttachmentCount += 1
Else
_Logger.Warn($"##!! oFileLenth for AttachmentObjects is <2 !!##")
Try
File.Delete(oAttachmentFilePath)
Catch ex As Exception
_Logger.Error(ex)
End Try
MESSAGE_ERROR = True
End If
Catch ex As Exception
_Logger.Warn($"Error while saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}")
MESSAGE_ERROR = True
End Try
Else
_Logger.Warn("File [{0}] already exists!", oAttachmentFilePath)
oAttachmentCount += 1
End If
Catch ex As Exception
_Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilePath}")
MESSAGE_ERROR = True
End Try
Next
Else
_Logger.Warn($"If cause 2 EXTRACT_ATTACHMENTS: {CurrentTempMailPath} not existing")
End If
Else
_Logger.Warn($"EXTRACT_ATTACHMENTSIf cause 1: CURRENT_TEMP_MAIL_PATH is NOTHING")
End If
CURRENT_ATTMT_COUNT = oAttachmentCount
If MESSAGE_ERROR = True Then
Return False
Else
Return True
End If
Catch ex As Exception
_Logger.Error(ex)
MESSAGE_ERROR = True
Return False
End Try
End Function
Private Function InsertHistoryEntry(pCurrentMail As MailContainer) As Boolean
If MESSAGE_ERROR = False Then
Return InsertHistoryEntryWithStatus(pCurrentMail, String.Empty, String.Empty)
Else
_Logger.Info("! No INSERT_HISTORY as MessageError = True")
Return False
End If
End Function
Private Function InsertHistoryEntryWithStatus(pCurrentMail As MailContainer, pStatus As String, pComment As String) As Boolean
Dim ins = $"INSERT INTO TBEMLP_HISTORY (
WORK_PROCESS,
EMAIL_MSGID,
EMAIL_SUBJECT,
EMAIL_DATE,
EMAIL_BODY,
EMAIL_SUBSTRING1,
EMAIL_SUBSTRING2,
EMAIL_FROM,
PROFILE_ID,
STATUS,
COMMENT
) VALUES (
'{CurrentMailProcessName}',
'{pCurrentMail.MessageId}',
'{pCurrentMail.SubjectOriginal}',
'{pCurrentMail.Mail.Date}',
'{CURRENT_MAIL_BODY_ALL}',
'{CURRENT_MAIL_BODY_ANSWER1}',
'{CURRENT_MAIL_BODY_Substr2}',
'{pCurrentMail.SenderAddress}',
{CURRENT_PROFILE_GUID},
'{pStatus}',
'{pComment.Truncate(500)}'
)"
Return _DB_MSSQL.ExecuteNonQuery(ins)
End Function
Private Function InsertAttachmentHistoryEntry(pCurrentMail As MailContainer, pMessageId As String, pFileName As String, pNewFileName As String) As Boolean
If IsNothing(_DB_MSSQL) Then
_Logger.Info("INSERT_HISTORY_FB: _DB_MSSQL is nothing ")
Return False
End If
Try
If MESSAGE_ERROR = False Then
Dim ins = $"INSERT INTO TBEMLP_HISTORY_ATTACHMENT (
WORK_PROCESS,
EMAIL_MSGID,
EMAIL_FROM,
EMAIL_SUBJECT,
EMAIL_DATETIME,
EMAIL_BODY,
EMAIL_ATTMT,
EMAIL_ATTMT_INDEX
) VALUES " &
$"('{CurrentMailProcessName}'," &
$"'{pMessageId}'," &
$"'{pCurrentMail.SenderAddress}'," &
$"'{pCurrentMail.SubjectOriginal}'," &
$"'{pCurrentMail.Mail.Date}'," &
$"'{CURRENT_MAIL_BODY_ALL}'," &
$"'{pFileName}'," &
$"'{pNewFileName}')"
_DB_MSSQL.ExecuteNonQuery(ins)
End If
Return True
Catch ex As Exception
_Logger.Error(ex)
Return False
End Try
End Function
Private Function WORK_POLL_STEPS() As Boolean
Try
Dim oFoundSomething As Boolean = False
_worked_email = False
For Each row As DataRow In DT_STEPS.Rows
POLL_STEP_GUID = row.Item("GUID")
POLL_KEYWORDS = row.Item("KEYWORDS_BODY")
KEYWORDS_SPLIT = POLL_KEYWORDS.Split(";")
For Each oKeyWord As String In KEYWORDS_SPLIT
If CURRENT_MAIL_BODY_ANSWER1.ToUpper = oKeyWord.ToUpper Then
_worked_email = True
_Logger.Info(String.Format("Found Keyword '{0}' in MessageBody", oKeyWord))
oFoundSomething = True
Dim sql As String = String.Format("SELECT * FROM TBEMLP_POLL_INDEXING_STEPS WHERE STEP_ID = {0} AND ACTIVE = 1", POLL_STEP_GUID)
DT_INDEXING_STEPS = _DB_MSSQL.GetDatatable(sql)
If DT_INDEXING_STEPS.Rows.Count > 0 Then
WORK_INDEXING_STEPS()
Else
_Logger.Info("No Indexing Steps found?! - SQL: " & sql)
End If
End If
Next
Next
If oFoundSomething = False Then
_Logger.Info($"None of the keywords was found...Keyword after Regex is '{0}'")
End If
If _worked_email = False And oFoundSomething = False Then
Dim sql As String = String.Format("SELECT * FROM TBEMLP_POLL_INDEXING_STEPS WHERE STEP_ID = {0} AND ACTIVE = 1 AND USE_FOR_DIRECT_ANSWER = 1", POLL_STEP_GUID)
DT_INDEXING_STEPS = _DB_MSSQL.GetDatatable(sql)
If DT_INDEXING_STEPS.Rows.Count >= 1 Then
_Logger.Info($"An index for direct answer was configured. Therefore it will be used...")
End If
WORK_INDEXING_STEPS()
_worked_email = True
End If
'Now indexing the LogIndex
If Not IsNothing(WM_VECTOR_LOG) And (Not IsDBNull(WM_VECTOR_LOG)) And (WM_VECTOR_LOG <> "") Then
Dim msg = Now.ToString & " - " & CurrentMailProcessName
IndexFile(WM_VECTOR_LOG, msg, False)
End If
'Now indexing the Body-Message Index
If CURRENT_MAIL_BODY_Substr2 <> String.Empty And WM_IDX_BODY_TEXT <> String.Empty Then
IndexFile(WM_IDX_BODY_TEXT, CURRENT_MAIL_BODY_Substr2, True)
End If
Return True
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
'clsLogger.Add("Unexpected Error in WORK_POLL_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
Return False
End Try
End Function
Private Function WORK_INDEXING_STEPS() As Boolean
Try
For Each row As DataRow In DT_INDEXING_STEPS.Rows
Dim INDEXNAME As String = row.Item("INDEXNAME")
Dim INDEXVALUE As String = row.Item("INDEXVALUE")
If _UseWindream Then
IndexFile(INDEXNAME, INDEXVALUE, False)
End If
Next
Return True
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
'clsLogger.Add("Unexpected Error in WORK_INDEXING_STEPS: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True)
Return False
End Try
End Function
Private Function IndexFile(oidxname As String, oidxvalue As String, oConcat_act_Value As Boolean)
Dim OArrIndex() As String
ReDim Preserve OArrIndex(0)
OArrIndex(0) = oidxname
If oConcat_act_Value = True Then
Dim oActValue = _windream_index.GetValueforIndex_WMFile(CURRENT_WM_DOC, oidxname)
If Not IsNothing(oActValue) Then
If oActValue.ToString.Length > 0 Then
If oActValue <> oidxvalue Then
oidxvalue = oActValue & vbNewLine & oidxvalue
End If
End If
End If
End If
Dim oArrValue() As String
Dim oMyArray()
ReDim oMyArray(0)
oMyArray(0) = oidxvalue
Dim oVektorArray()
oVektorArray = _windream_index.GetVektorArray(CURRENT_WM_DOC, oidxname, oMyArray, True)
If oVektorArray Is Nothing = False Then
'Zielindex ist ein Vektorindex
ReDim oArrValue(oVektorArray.Length - 1)
Array.Copy(oVektorArray, oArrValue, oVektorArray.Length)
If oArrValue Is Nothing Then
_Logger.Warn($"arrValue from vektor for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
_Logger.Info($"arrValue from vektor for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
Return False
End If
Else
'Es handelt sich um einen Einfachindex
ReDim oArrValue(0)
oArrValue(0) = oidxvalue
End If
If oArrValue Is Nothing = False Then
Return _windream_index.RunIndexing(CURRENT_WM_DOC, OArrIndex, oArrValue, WM_OBJEKTTYPE)
Else
_Logger.Warn($"arrValue for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
_Logger.Info($"arrValue for index {oidxname} is nothing! Value: {oidxvalue} - no indexing!")
Return False
End If
End Function
Private Function GET_WMDOC_INFO() As Boolean
Try
Dim oDOC_ID = REGEX_CHECK_DOC_ID(CURRENT_MAIL_SUBJECT.Replace("10636", "133092").Replace("10644", "133092"))
If Not IsNothing(oDOC_ID) Then
Dim oDT_BASE_ATTR As DataTable = _DB_MSSQL.GetDatatableWithConnection("SELECT * FROM BaseAttributes WHERE dwDocID = " & oDOC_ID, _windreamConnectionString)
If Not IsNothing(oDT_BASE_ATTR) Then
If oDT_BASE_ATTR.Rows.Count = 1 Then
CURRENT_DOC_ID = oDOC_ID
Dim oSql = String.Format("Select[dbo].[FNDD_GET_WINDREAM_FILE_PATH]({0},'{1}')", CURRENT_DOC_ID, WM_DRIVE)
CURRENT_DOC_PATH = _DB_MSSQL.GetScalarValue(oSql)
_Logger.Debug("CURRENT_DOC_PATH is: " & CURRENT_DOC_PATH)
CURRENT_WM_DOC = Nothing
Dim oWMDOC As WMObject
Dim oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace(WM_DRIVE.ToLower & ":", "")
oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace("\\windream\objects", "")
oWMNormpath = CURRENT_DOC_PATH.ToLower.Replace("w:", "")
_Logger.Debug("oWMNormpath is: " & oWMNormpath)
Try
oWMDOC = _windream.oWMSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oWMNormpath)
CURRENT_WM_DOC = oWMDOC
Return True
Catch ex As Exception
_Logger.Warn("error while creating WMObject in (GET_DOC_INFO): " & ex.Message)
_Logger.Warn("oWMNormpath: " & oWMNormpath)
Return False
End Try
Else
_Logger.Warn("No record found for dwDocID " & oDOC_ID)
Return False
End If
Else
_Logger.Warn("DT_BASE_ATTR is nothing")
Return False
End If
Else
_Logger.Warn("Could not get a DOC-ID via regex!")
Return False
End If
Catch ex As Exception
_Logger.Error(ex)
'clsLogger.Add("Unexpected Error in GET_DOC_INFO: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID)
MESSAGE_ERROR = True
Return False
End Try
End Function
Public Function REGEX_CHECK_DOC_ID(SearchString As String)
Try
Dim oRegex As New Regex("\[DID#{1}([0-9]+)]{1}")
_Logger.Debug("REGEX_String before replacing: '" & SearchString & "'")
' Regulären Ausdruck zum Auslesen der windream-Indexe definieren
Dim elements As MatchCollection = oRegex.Matches(SearchString)
Dim result = ""
For Each element As Match In elements
result = element.Groups(1).Value
_Logger.Debug(String.Format("Found Regex(0) {0} in SearchString", element.Groups(0).Value))
_Logger.Debug(String.Format("Found Regex(1) {0} in SearchString", element.Groups(1).Value))
Next
Return result
Catch ex As Exception
MESSAGE_ERROR = True
_Logger.Error(ex)
Return Nothing
End Try
End Function
End Class