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 Imports System.Data.SqlClient 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 ReadOnly _RejectionTemplateId As Integer = 0 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, pRejectionTemplateId As Integer) Try _Logger = LogConf.GetLogger _LogConfig = LogConf _DB_MSSQL = New MSSQLServer(LogConf, ConStr) _Logger.Debug("clsWorkmail _email initialized") _UseWindream = pUseWindream _Patterns = New Patterns2(LogConf) _RejectionTemplateId = pRejectionTemplateId _Logger.Debug($"_RejectionTemplateId: {_RejectionTemplateId}") 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($"Message 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 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) 'AddEmailToQueueMSSQL(CurrentMail.MessageId, oResult, "Email validation failed", _EmailAccountID) AddToEmailQueueMSSQL(CurrentMail.MessageId, oResult, "Email validation failed", _EmailAccountID, _RejectionTemplateId, ErrorCode.SenderValidationFailed, "", "") ' 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") Dim oCommonEmailResult = COMMON_EMAIL_IN(CurrentMail) If oCommonEmailResult = False Then Return False End If If CURRENT_ATTMT_COUNT = 0 Then _Logger.Info("### Mail contained no Attachments!! ###") InsertHistoryEntryWithStatus(CurrentMail, "REJECTED", "No Attachments") Dim oBody = EmailStrings.EMAIL_NO_FERDS 'If AddEmailToQueueMSSQL(CurrentMail.MessageId, oBody, "No Attachments", _EmailAccountID) = True Then If AddToEmailQueueMSSQL(CurrentMail.MessageId, oBody, "No Attachments", _EmailAccountID, _RejectionTemplateId, ErrorCode.NoAttachments, "", "") = True Then CURRENT_ImapObject.DeleteMessageByUID(poUID) End If Else InsertHistoryEntry(CurrentMail) End If Return True End If Catch ex As Exception _Logger.Error(ex) Return False End Try End Function ''' ''' Method to decide wether we use the old or the new ''' Rejection E-mail method. ''' ''' TODO we have no information about the language of the receiver at the moment ''' ''' E-Mail Message ID ''' Body Text ''' Comment ''' Sending Profile from config ''' ID for E-Mail-Template from config ''' Error Code ''' Zusätzlicher Parameter 1 ''' Zusätzlicher Parameter 2 Public Function AddToEmailQueueMSSQL(pMessageId As String, pBodyText As String, pComment As String, pEmailAccountId As Integer, pTemplateId As Integer, pErrorCode As ErrorCode, pParameter1 As String, pParameter2 As String) As Boolean Dim useLegacyMethod = True Dim oErrorCode As String = String.Empty ' ErrorCode valid? If pErrorCode <> ErrorCode.Unknown Then Dim intCode As Integer = DirectCast(pErrorCode, Integer) oErrorCode = $"{EmailStrings.ErrorCodePraefix}{intCode}" Dim oSQL = $"SELECT COUNT(*) FROM TBDD_GUI_LANGUAGE_PHRASE WHERE TITLE = '{oErrorCode}'" If _DB_MSSQL.GetScalarValue(oSQL) > 0 Then useLegacyMethod = False Else _Logger.Warn($"Rejection reason [{oErrorCode}] not found in TBDD_GUI_LANGUAGE_PHRASE!") End If End If ' Gibt es das Template in TBDD_EMAIL_TEMPLATE? If useLegacyMethod = False AndAlso pTemplateId > 0 Then Try Dim oSQL = $"SELECT COUNT(*) FROM TBDD_EMAIL_TEMPLATE WHERE GUID = {pTemplateId}" If _DB_MSSQL.GetScalarValue(oSQL) <= 0 Then _Logger.Warn($"EMAIL_TEMPLATE [{pTemplateId}] not found in TBDD_EMAIL_TEMPLATE!") useLegacyMethod = True End If Catch ex As Exception _Logger.Error(ex) useLegacyMethod = True End Try Else _Logger.Debug($"RejectionTemplateId not configured!") useLegacyMethod = True End If ' Check if Stored Procedure PRDD_SEND_REJECTION_MAIL exists If useLegacyMethod = False Then Try Dim oSQL = $"SELECT COUNT(*) FROM sys.objects WHERE type = 'P' AND OBJECT_ID = OBJECT_ID('dbo.PRDD_SEND_REJECTION_MAIL')" If _DB_MSSQL.GetScalarValue(oSQL) <= 0 Then _Logger.Warn($"Procedure ['PRDD_SEND_REJECTION_MAIL'] not found in Database!") useLegacyMethod = True End If Catch ex As Exception _Logger.Error(ex) useLegacyMethod = True End Try End If If useLegacyMethod = True Then _Logger.Warn("New rejection mail logic is not configured correctly, use legacy logic instead!") Return AddEmailToQueueMSSQL(pMessageId, pBodyText, pComment, pEmailAccountId) Else _Logger.Debug("New rejection mail logic is configured!") Return AddEmailToQueueMSSQL(pMessageId, pTemplateId, oErrorCode, pEmailAccountId, pParameter1, pParameter2) End If End Function ''' ''' Function calls SP PRDD_SEND_REJECTION_MAIL ''' for sending rejection mail. ''' ''' E-Mail Message ID ''' GUID for TBDD_EMAIL_TEMPLATE from config ''' ErrorID (TBDD_GUI_LANGUAGE_PHRASE) ''' Sending profile from config ''' Zusätzlicher Parameter 1 ''' Zusätzlicher Parameter 2 Private Function AddEmailToQueueMSSQL(pMessageId As String, pTemplateId As Integer, pErrorCode As String, pEmailAccountId As Integer, pParameter1 As String, pParameter2 As String) As Boolean If pParameter1.IsNullOrEmpty Then pParameter1 = "" Else pParameter1 = pParameter1.Replace("'", "''") End If If pParameter2.IsNullOrEmpty Then pParameter2 = "" Else pParameter2 = pParameter2.Replace("'", "''") End If Try Dim oExecute = $"EXECUTE dbo.PRDD_SEND_REJECTION_MAIL '{pMessageId}' , 0 , {pEmailAccountId} , 'DDEmailProfiler' , {pTemplateId} , '{pErrorCode}' , '{pParameter1}' , '{pParameter2}' , 77" Return _DB_MSSQL.ExecuteNonQuery(oExecute) Catch ex As Exception _Logger.Error(ex) Return False End Try End Function Public Function AddEmailToQueueMSSQL(pMessageId As String, pBodyText As String, pComment As String, pEmailAccountId As Integer) As Boolean Try Dim oReference = pMessageId Dim oEmailTo = "" Dim oSubject = $"{SUBJECT_PRAFIX} - {EmailStrings.EMAIL_SUBJECT_REJECTED}" Dim oCreatedWho = "DDEmailProfiler" Dim oMaskedBodyText = pBodyText.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}", pMessageId) 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 COALESCE(MAX(GUID), 0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{pMessageId}'" Dim oHistoryID As Integer = _DB_MSSQL.GetScalarValue(osql) 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} ,'{pMessageId}' ,77 ,'{oEmailTo}' ,'{oSubject}' ,'{oFinalBodyText}' ,'{pComment}' ,'{oCreatedWho}')" Return _DB_MSSQL.ExecuteNonQuery(oInsert) Catch ex As Exception _Logger.Error(ex) Return False End Try Return True 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_OBJEKTTYPE = oRow.ItemEx("WM_OBJEKTTYPE", "") WM_REFERENCE_INDEX = oRow.ItemEx("WM_REFERENCE_INDEX", "") WM_VECTOR_LOG = oRow.ItemEx("WM_VECTOR_LOG", "") WM_IDX_BODY_TEXT = oRow.ItemEx("WM_IDX_BODY_TEXT", "") WM_IDX_BODY_SUBSTR_LENGTH = oRow.ItemEx("WM_IDX_BODY_SUBSTR_LENGTH", 0) Dim oPathOriginal As String = oRow.ItemEx("PATH_ORIGINAL", "") Dim oExtractMainPath As String = oRow.ItemEx("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 'ToDo Konsistenz prüfen 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 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 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 oString As String In oSplit oString = oString.Replace(vbCrLf, "") If oString = String.Empty Then Continue For End If oCount += 1 If oCount = 1 Then CURRENT_MAIL_BODY_ANSWER1 = oString Else If oString.StartsWith("##") Then Exit For ElseIf oCount = 2 Then CURRENT_MAIL_BODY_Substr2 = oString Else If ((oReadLength + oString.Length) >= WM_IDX_BODY_SUBSTR_LENGTH) Or oString.StartsWith("##") Then Exit For End If CURRENT_MAIL_BODY_Substr2 = CURRENT_MAIL_BODY_Substr2 & vbNewLine & oString End If oReadLength += oString.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 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)) InsertAttachmentHistoryEntry(pCurrentMail, 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 oCommand = New SqlCommand( "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 ( @WORK_PROCESS, @MESSAGE_ID, @SUBJECT, @DATE, @BODY, @SUBSTRING1, @SUBSTRING2, @FROM, @PROFILE_ID, @STATUS, @COMMENT)" ) oCommand.Parameters.Add("WORK_PROCESS", SqlDbType.VarChar, 100).Value = CurrentMailProcessName oCommand.Parameters.Add("MESSAGE_ID", SqlDbType.VarChar, 500).Value = pCurrentMail.MessageId oCommand.Parameters.Add("SUBJECT", SqlDbType.VarChar, 1000).Value = pCurrentMail.SubjectOriginal oCommand.Parameters.Add("DATE", SqlDbType.DateTime).Value = pCurrentMail.Mail.Date oCommand.Parameters.Add("BODY", SqlDbType.VarChar).Value = CURRENT_MAIL_BODY_ALL oCommand.Parameters.Add("SUBSTRING1", SqlDbType.VarChar, 2000).Value = CURRENT_MAIL_BODY_ANSWER1 oCommand.Parameters.Add("SUBSTRING2", SqlDbType.VarChar, 2000).Value = CURRENT_MAIL_BODY_Substr2 oCommand.Parameters.Add("FROM", SqlDbType.VarChar, 500).Value = pCurrentMail.SenderAddress oCommand.Parameters.Add("PROFILE_ID", SqlDbType.Int).Value = CURRENT_PROFILE_GUID oCommand.Parameters.Add("STATUS", SqlDbType.VarChar, 900).Value = pStatus oCommand.Parameters.Add("COMMENT", SqlDbType.VarChar, 500).Value = pComment.Truncate(500) Return _DB_MSSQL.ExecuteNonQuery(oCommand) End Function Private Function InsertAttachmentHistoryEntry(pCurrentMail As MailContainer, 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 = True Then _Logger.Warn("MESSAGE_ERROR = true, not inserting!") Return False End If Dim oCommand = New SqlCommand( "INSERT INTO TBEMLP_HISTORY_ATTACHMENT ( WORK_PROCESS, EMAIL_MSGID, EMAIL_FROM, EMAIL_SUBJECT, EMAIL_DATETIME, EMAIL_BODY, EMAIL_ATTMT, EMAIL_ATTMT_INDEX ) VALUES ( @WORK_PROCESS, @MESSAGE_ID, @FROM, @SUBJECT, @DATE, @BODY, @ATTACHMENT, @ATTACHMENT_INDEX )") oCommand.Parameters.Add("WORK_PROCESS", SqlDbType.VarChar, 100).Value = CurrentMailProcessName oCommand.Parameters.Add("MESSAGE_ID", SqlDbType.VarChar, 500).Value = pCurrentMail.MessageId oCommand.Parameters.Add("SUBJECT", SqlDbType.VarChar, 1000).Value = pCurrentMail.SubjectOriginal oCommand.Parameters.Add("DATE", SqlDbType.DateTime).Value = pCurrentMail.Mail.Date oCommand.Parameters.Add("BODY", SqlDbType.VarChar).Value = CURRENT_MAIL_BODY_ALL oCommand.Parameters.Add("FROM", SqlDbType.VarChar, 500).Value = pCurrentMail.SenderAddress oCommand.Parameters.Add("ATTACHMENT", SqlDbType.VarChar, 500).Value = pFileName oCommand.Parameters.Add("ATTACHMENT_INDEX", SqlDbType.VarChar, 500).Value = pNewFileName _DB_MSSQL.ExecuteNonQuery(oCommand) 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