Imports Independentsoft.Email.Mime Imports System.Text.RegularExpressions Imports WINDREAMLib Imports DigitalData.EMLProfiler.ClassCurrent Imports System.IO Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports System.Threading Public Class clsWorkEmail Private Shared Logger As Logger Private MyLogger As LogConfig Private _email As clsEmail Private _DB_MSSQL As clsDatabase Private _USE_WM As Boolean Private _windream As clsWindream_allgemein Private _windream_index As clsWindream_Index Private _firebird As Firebird Private _worked_email As Boolean = False Sub New(LogConf As LogConfig, ConStr As String, FB_DATASOURCE As String, FB_DATABASE As String, FB_USER As String, FB_PW As String, USE_WM As Boolean) Try Logger = LogConf.GetLogger MyLogger = LogConf _email = New clsEmail(LogConf) Logger.Debug("clsWorkmail _email initialized") _DB_MSSQL = New clsDatabase(LogConf, ConStr) Logger.Debug("clsWorkmail _email initialized") _USE_WM = USE_WM If USE_WM Then _windream = New clsWindream_allgemein(LogConf) _windream_index = New clsWindream_Index(LogConf) End If If FB_DATASOURCE <> String.Empty Then _firebird = New Firebird(LogConf, FB_DATASOURCE, FB_DATABASE, FB_USER, FB_PW) End If Catch ex As Exception Logger.Error(ex) End Try End Sub Public Function WorkEmailMessage(MyEmailMessage As Message) As Boolean Try Logger.Debug($"Working on email from: {MyEmailMessage.From.EmailAddress}...Subject: {MyEmailMessage.Subject}") CURRENT_MAIL_BODY_ALL = "" CURRENT_MAIL_BODY_ANSWER1 = "" CURRENT_MAIL_BODY_Substr2 = "" CURRENT_MAIL_MESSAGE = MyEmailMessage CURRENT_MAIL_SUBJECT = MyEmailMessage.Subject.ToUpper If IsNothing(CURRENT_MAIL_SUBJECT) Then CURRENT_MAIL_SUBJECT = "" Else Logger.Debug($"Subject: {CURRENT_MAIL_SUBJECT}...") End If CURRENT_MAIL_FROM = MyEmailMessage.From.EmailAddress Logger.Debug($"Working on email from : {CURRENT_MAIL_FROM}...") Dim oTempMailExists As Boolean = SAVE2TEMP() 'Checking wether Mail can be opened Dim oTempMailAccessible As Boolean = False If oTempMailExists = True Then Try Dim oFS As FileStream = File.OpenRead(CURRENT_TEMP_MAIL_PATH) oTempMailAccessible = True Catch ex As Exception Logger.Warn($"Could not read the Temp-Mail. Insufficient rights? Message: {ex.Message}") End Try If oTempMailAccessible = True Then MessageError = False If CURRENT_MAIL_SUBJECT.Contains("[PROCESSMANAGER]") Then PROCESS_MANAGER_IN() ElseIf MyEmailMessage.Subject.Contains("[ADDI]") Then Else Logger.Info("CommonEmail-Process-Sniffer") If COMMON_EMAIL_IN() = True Then INSERT_HISTORY_MSSQL() Return True Else Return False End If End If End If End If Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Unexpected Error in WORK_MAIL: " & ex.Message & "MESSAGE_ID: " & msg.MessageID) Return False End Try End Function Private Function PROCESS_MANAGER_IN() As Boolean Try Dim oDel_email As Boolean = False Logger.Info(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.Subject)) Logger.Debug(String.Format("PM-related message found....[{0}]", CURRENT_MAIL_MESSAGE.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") oDel_email = row("DELETE_MAIL") If COPY2HDD(row("COPY_2_HDD"), row("PATH_ORIGINAL"), row("PATH_EMAIL_ERRORS"), False) = True Then EXTRACT_BODY() 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....")) CURRENT_MAIL_PROCESS_NAME = "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 If ClassCurrent.CURRENT_DEBUG_LOCAL_EMAIL = "" Then EMAIL_DELETE(oDel_email) 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 Function COMMON_EMAIL_IN() As Boolean Try Dim oDel_email As Boolean = False Logger.Info(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.Subject)) Logger.Debug(String.Format("COMMON_EMAIL_IN...Subject [{0}]", CURRENT_MAIL_MESSAGE.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) For Each oDataRow As DataRow In PM_ROW oDel_email = oDataRow("DELETE_MAIL") CURRENT_MAIL_PROCESS_NAME = oDataRow.Item("PROCESS_NAME") Try WM_REFERENCE_INDEX = oDataRow("WM_REFERENCE_INDEX") Catch ex As Exception Logger.Debug($"Attention WM_REFERENCE_INDEX seems to be Empty/null: {ex.Message}") WM_REFERENCE_INDEX = Nothing End Try Try WM_VECTOR_LOG = oDataRow("WM_VECTOR_LOG") Catch ex As Exception WM_VECTOR_LOG = Nothing End Try WM_OBJEKTTYPE = oDataRow("WM_OBJEKTTYPE") WM_IDX_BODY_TEXT = oDataRow("WM_IDX_BODY_TEXT") WM_IDX_BODY_SUBSTR_LENGTH = oDataRow("WM_IDX_BODY_SUBSTR_LENGTH") If COPY2HDD(oDataRow("COPY_2_HDD"), oDataRow("PATH_ORIGINAL"), oDataRow("PATH_EMAIL_ERRORS"), True) = True Then If EXTRACT_ATTACHMENTS(oDataRow("PATH_EMAIL_TEMP"), oDataRow("PATH_EMAIL_ERRORS")) = True Then Return True Else Return False End If Else Return False End If Next If ClassCurrent.CURRENT_DEBUG_LOCAL_EMAIL = "" Then EMAIL_DELETE(oDel_email) 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 Private Function SAVE2TEMP() 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) Else Logger.Debug($"SAVE2TEMP - oTempPath [{oTempPath}] is already existing!!") 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 Dim oTempFilename As String = Path.Combine(oTempPath, CURRENT_MAIL_MESSAGE.GetFileName) Dim oCounter As Integer = 1 If File.Exists(oTempFilename) = True Then Do While File.Exists(oTempFilename) oCounter += 1 oTempFilename = Path.Combine(oTempPath, oCounter & "_" & CURRENT_MAIL_MESSAGE.GetFileName) Loop End If CURRENT_MAIL_MESSAGE.Save(oTempFilename, True) CURRENT_TEMP_MAIL_PATH = oTempFilename Logger.Debug($"Email saved to Temppath {CURRENT_TEMP_MAIL_PATH}") oCounter = 0 Dim oCancel As Boolean Do While File.Exists(CURRENT_TEMP_MAIL_PATH) = False 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(CURRENT_TEMP_MAIL_PATH) 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) CURRENT_TEMP_MAIL_PATH = 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(copy_2_hdd As Boolean, pathOriginal As String, pathemail_errors As String, messageid As Boolean) As Boolean Try If copy_2_hdd = True Then Logger.Debug("COPY_2_HDD is ACTIVE!") PATH_ERROR = pathemail_errors If Directory.Exists(pathOriginal) Then Dim oTempFilename = pathOriginal If messageid = True Then oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.MessageID & ".eml" Else oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.GetFileName End If Dim cleanPath As String = String.Join("", oTempFilename.Split(Path.GetInvalidPathChars())) If System.IO.File.Exists(cleanPath) = False Then Try File.Delete(cleanPath) Catch ex As Exception Logger.Error(ex) Return False End Try CURRENT_MAIL_MESSAGE.Save(cleanPath, True) Dim oFileInfo As New FileInfo(cleanPath) Dim oFileLenth As Long = oFileInfo.Length If oFileLenth > 0 Then Logger.Info($"[COPY2HDD] Email saved to ({cleanPath})") Return True Else Logger.Warn($"##!! oFileLenth is 0 !!##") Try File.Delete(cleanPath) Catch ex As Exception Logger.Error(ex) End Try Return False End If Else Logger.Info("COPY2HDD - EMail (" & CURRENT_MAIL_MESSAGE.Subject & ") already existing!", False, "RUN_THREAD.COPY_2_HDD") Return False End If End If End If Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) Return False End Try End Function Private Function EXTRACT_BODY() TEMP_HTML_RESULTS.Clear() Dim oDTFunctionRegex As DataTable = _DB_MSSQL.Return_Datatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))") Dim oMsg_email As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH) Dim oBodyText As String = "" If IsNothing(oMsg_email.Body) Then Dim oAllBodyParts As New BodyPartCollection() oAllBodyParts.Add(oMsg_email.BodyParts) oAllBodyParts.Add(GetChildren(oMsg_email.BodyParts)) For Each bodyPart As BodyPart In oAllBodyParts If bodyPart.ContentType IsNot Nothing AndAlso bodyPart.ContentType.Type = "text" AndAlso bodyPart.ContentType.SubType = "plain" Then If oBodyText = String.Empty Then Logger.Debug(String.Format("BODY1-Text is....#{0}", bodyPart.Body)) oBodyText = bodyPart.Body Else Continue For End If ElseIf bodyPart.ContentType IsNot Nothing AndAlso bodyPart.ContentType.Type = "text" AndAlso bodyPart.ContentType.SubType = "html" Then If oBodyText = String.Empty Then oBodyText = bodyPart.Body Logger.Debug(String.Format("bodyhtml....#{0}", bodyPart.Body)) Else Continue For End If Logger.Debug(String.Format("bodyhtml....#{0}", bodyPart.Body)) End If Next If oBodyText = "" Then Else CURRENT_MAIL_BODY_ALL = oBodyText End If Else CURRENT_MAIL_BODY_ALL = oMsg_email.Body End If If Not IsNothing(CURRENT_MAIL_BODY_ALL) Then ' CURRENT_MAIL_BODY_ALL = oMsg_email.Body Dim oPattern1 As String Dim oPattern2 As String Try oPattern1 = oDTFunctionRegex.Rows(0).Item("REGEX") Catch ex As Exception oPattern1 = "" End Try Try oPattern2 = oDTFunctionRegex.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 ' Dim pattern1 As String = "" ' For Each oRow As DataRow In oDTFunctionRegex.Rows ' If oRow.Item("FUNCTION_NAME").ToString.ToUpper = "EMAIL_PROFILER - RemoveHTMLText".ToUpper Then ' pattern1 = oRow.Item("REGEX") ' End If ' Next ' If pattern1 = String.Empty Then ' Exit Try ' End If ' ' Instantiate the regular expression object. ' Dim r As Regex = New Regex(pattern1, RegexOptions.Multiline) ' ' Match the regular expression pattern against a text string. ' Dim m As Match = r.Match(CURRENT_MAIL_BODY_ALL) ' Dim oClearedBodyText = CURRENT_MAIL_BODY_ALL ' Do While m.Success ' oClearedBodyText = oClearedBodyText.Replace(m.Value, "") ' 'Dim g As Group = m.Groups(1) ' 'If g.ToString.StartsWith("&") = False Then ' ' TEMP_HTML_RESULTS.Add(g.ToString()) ' 'End If ' m = m.NextMatch() ' Loop ' Logger.Info($"Cleared bodytext is: {oClearedBodyText}") ' CURRENT_MAIL_BODY_ALL = Trim(oClearedBodyText) 'Catch ex As Exception 'End Try 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") MessageError = 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 Dim oAnswer2 As String 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 Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) MessageError = True Return False End Try End Function Private Function EXTRACT_ATTACHMENTS(pathemailtemp As String, pathemail_errors As String) Logger.Debug("In EXTRACT_ATTACHMENTS...") PATH_TEMP = pathemailtemp PATH_ERROR = pathemail_errors Logger.Debug(String.Format("PATH_TEMP[{0}]", PATH_TEMP)) Try If CURRENT_TEMP_MAIL_PATH <> Nothing Then If File.Exists(CURRENT_TEMP_MAIL_PATH) Then Dim oCurrentMail As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH) Dim oMSGID = oCurrentMail.MessageID If IsNothing(oMSGID) Then oMSGID = System.Guid.NewGuid.ToString() End If oMSGID = oMSGID.Replace(">", "").Replace("<", "") For Each oAttachment As Attachment In oCurrentMail.GetAttachments Dim oATTFilename = oAttachment.GetFileName.ToString.ToLower Dim oValidExt As Boolean = False If oATTFilename.EndsWith("pdf") Then oValidExt = True ElseIf oATTFilename.EndsWith("xls") Then oValidExt = True ElseIf oATTFilename.EndsWith("xlsx") Then oValidExt = True ElseIf oATTFilename.EndsWith("doc") Then oValidExt = True ElseIf oATTFilename.EndsWith("docx") Then oValidExt = True ElseIf oATTFilename.EndsWith("ppt") Then oValidExt = True ElseIf oATTFilename.EndsWith("pptx") Then oValidExt = True End If If oValidExt = False Then Logger.Debug(String.Format("Invalid FileExtension [{0}]", oATTFilename)) Continue For End If Dim oAttachmentFileString Logger.Info(String.Format(" Working on Attachment [{0}]", oAttachment.GetFileName)) Try Dim oFilename = oAttachment.GetFileName oFilename = CleanInput(oFilename) Logger.Debug($"oFilename [{oFilename}]") If oFilename = String.Empty Then oFilename = oAttachment.GetFileName End If oAttachmentFileString = Path.Combine(PATH_TEMP, $"{oMSGID}~{oFilename}") Logger.Debug($"oAttachmentFileString [{oAttachmentFileString}]") If System.IO.File.Exists(oAttachmentFileString) = False Then Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFileString)) Try oAttachment.Save(oAttachmentFileString) Dim oFileInfo As New FileInfo(oAttachmentFileString) Dim oFileLenth As Long = oFileInfo.Length If oFileLenth > 0 Then Logger.Info(String.Format("Attachment saved to [{0}]", oAttachmentFileString)) INSERT_HISTORY_FB(oMSGID, oAttachment.GetFileName) INSERT_HISTORY_ATTMT_MSSQL(oMSGID, oAttachment.GetFileName) Else Logger.Warn($"##!! oFileLenth for AttachmentObjects is 0 !!##") Try File.Delete(oAttachmentFileString) Catch ex As Exception Logger.Error(ex) End Try MessageError = True Return False End If Catch ex As Exception Logger.Warn($"Error while saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFileString}") MessageError = True End Try Else Logger.Info("EXATTMNT - Attachment (" & oAttachmentFileString & ") already existing!", False, "EXTRACT_ATTACHMENTS") End If Catch ex As Exception Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFileString}") MessageError = True Return False End Try Next Else Logger.Warn($"If cause 2 EXTRACT_ATTACHMENTS: {CURRENT_TEMP_MAIL_PATH} not existing") End If Else Logger.Warn($"EXTRACT_ATTACHMENTSIf cause 1: CURRENT_TEMP_MAIL_PATH is NOTHING") End If Catch ex As Exception Logger.Error(ex) 'clsLogger.Add("Unexpected Error in COPY2HDD: " & ex.Message & "MESSAGE_ID: " & CURRENT_MAIL_MESSAGE.MessageID, True) MessageError = True Return False End Try End Function Private Function CleanInput(strIn As String) As String ' Replace invalid characters with empty strings. Try Return Regex.Replace(strIn, "[^\w\.@-]", "") ' If we timeout when replacing invalid characters, ' we should return String.Empty. Catch ex As Exception Logger.Error(ex) Return String.Empty End Try End Function Private Function RemoveCharacter(ByVal stringToCleanUp) Dim characterToRemove As String = "" characterToRemove = Chr(34) + "#$%&'()*+,-./\~" Dim firstThree As Char() = characterToRemove.Take(16).ToArray() For index = 1 To firstThree.Length - 1 stringToCleanUp = stringToCleanUp.ToString.Replace(firstThree(index), "") Next Return stringToCleanUp End Function Private Function INSERT_HISTORY_MSSQL() As Boolean If MessageError = False Then Dim ins = $"INSERT INTO TBEMLP_HISTORY (WORK_PROCESS,EMAIL_MSGID,EMAIL_SUBJECT,EMAIL_DATE,EMAIL_BODY,EMAIL_SUBSTRING1,EMAIL_SUBSTRING2,EMAIL_FROM,PROFILE_ID) VALUES " & $"('{CURRENT_MAIL_PROCESS_NAME}'," & $"'{CURRENT_MAIL_MESSAGE.MessageID.Replace("<", "").Replace(">", "")}'," & $"'{CURRENT_MAIL_MESSAGE.Subject}'," & $"'{CURRENT_MAIL_MESSAGE.Date}'," & $"'{CURRENT_MAIL_BODY_ALL}'," & $"'{CURRENT_MAIL_BODY_ANSWER1}'," & $"'{CURRENT_MAIL_BODY_Substr2}'," & $"'{CURRENT_MAIL_FROM}'," & $"{CURRENT_PROFILE_GUID})" Return _DB_MSSQL.Execute_non_Query(ins) Else Logger.Info("! No INSERT_HISTORY as MessageError = True") Return False End If End Function Private Function INSERT_HISTORY_FB(oGUID As String, ATTMT1 As String) As Boolean If IsNothing(_firebird) Then Logger.Info("INSERT_HISTORY_FB: _firebird is nothing ") Return False End If Try If MessageError = False Then Dim ins = $"INSERT INTO TBEDM_EMAIL_PROFILER_HISTORY (WORK_PROCESS,EMAIL_MSGID,EMAIL_FROM,EMAIL_SUBJECT,EMAIL_DATETIME,EMAIL_BODY,EMAIL_SUBSTRING1,EMAIL_SUBSTRING2,EMAIL_ATTMT1) VALUES " & $"('{CURRENT_MAIL_PROCESS_NAME}'," & $"'{oGUID}'," & $"'{CURRENT_MAIL_MESSAGE.From.EmailAddress}'," & $"'{CURRENT_MAIL_MESSAGE.Subject}'," & $"'{CURRENT_MAIL_MESSAGE.Date}'," & $"'{CURRENT_MAIL_BODY_ALL}'," & $"'{CURRENT_MAIL_BODY_ANSWER1}'," & $"'{CURRENT_MAIL_BODY_Substr2}'," & $"'{ATTMT1}')" Return _firebird.ExecuteNonQuery(ins) End If Catch ex As Exception Logger.Error(ex) Return False End Try End Function Private Function INSERT_HISTORY_ATTMT_MSSQL(oMSGID As String, ATTMT1 As String) If IsNothing(_DB_MSSQL) Then Logger.Info("INSERT_HISTORY_FB: _DB_MSSQL is nothing ") Return False End If Try If MessageError = False Then Dim ins = $"INSERT INTO TBEMLP_HISTORY_ATTACHMENT (WORK_PROCESS,EMAIL_MSGID,EMAIL_FROM,EMAIL_SUBJECT,EMAIL_DATETIME,EMAIL_BODY,EMAIL_ATTMT) VALUES " & $"('{CURRENT_MAIL_PROCESS_NAME}'," & $"'{oMSGID}'," & $"'{CURRENT_MAIL_MESSAGE.From.EmailAddress}'," & $"'{CURRENT_MAIL_MESSAGE.Subject}'," & $"'{CURRENT_MAIL_MESSAGE.Date}'," & $"'{CURRENT_MAIL_BODY_ALL}'," & $"'{ATTMT1}')" _DB_MSSQL.Execute_non_Query(ins) End If Catch ex As Exception Logger.Error(ex) End Try End Function Private Function GetChildren(ByVal bodyParts As BodyPartCollection) As BodyPartCollection Dim children As New BodyPartCollection() For i As Integer = 0 To bodyParts.Count - 1 children.Add(GetChildren(bodyParts(i).BodyParts)) children.Add(bodyParts(i)) Next Return children End Function Private Function EMAIL_DELETE(del As Boolean) If del = True And MessageError = False Then _email.DELETE_EMAIL(CURRENT_MAIL_MESSAGE.MessageID) Else If MessageError = True Then Logger.Warn($"Did not delete Message [{CURRENT_MAIL_MESSAGE.MessageID}] as there was an MessageError!") End If End If 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_STEP_PROCESS_ID = row.Item("PROCESS_ID") 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.Return_Datatable(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.Return_Datatable(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 & " - " & CURRENT_MAIL_PROCESS_NAME 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 MessageError = 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() 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 _USE_WM Then IndexFile(INDEXNAME, INDEXVALUE, False) End If Next Catch ex As Exception MessageError = 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() 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.Return_DatatableCS("SELECT * FROM BaseAttributes WHERE dwDocID = " & oDOC_ID, WM_CON_STRING) 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.Execute_Scalar(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) MessageError = True Return False End Try End Function Public Function REGEX_CHECK_DOC_ID(SearchString As String) Try Dim regex As Regex = 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 = regex.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 MessageError = True Logger.Error(ex) 'clsLogger.AddError("Unexpected error: " & ex.Message, "REGEX_CHECK_DOC_ID") Return Nothing End Try End Function End Class