Imports System.Text.RegularExpressions Imports WINDREAMLib Imports DigitalData.EMLProfiler.ClassCurrent Imports System.IO Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Database Imports DigitalData.Modules.Language Imports System.Threading Imports Limilabs.Mail Imports Limilabs.Mail.MIME Imports Limilabs.Mail.Headers Imports MailBox = Limilabs.Mail.Headers.MailBox 'Imports DigitalData.Modules.Messaging Public Class clsWorkEmail Private Const FILENAME_MAX_LENGTH = 100 Private Shared Logger As Logger Private MyLogger As LogConfig 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 Private _EmailAccountID As Integer = 1 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, EmailAccountID As Integer, EmlProfPraefix As String) Try Logger = LogConf.GetLogger MyLogger = LogConf _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 _EmailAccountID = EmailAccountID SUBJECT_PRAFIX = EmlProfPraefix Catch ex As Exception Logger.Error(ex) End Try End Sub Public Shared Function RemoveIllegalFileNameChars(input As String, Optional replacement As String = "") As String Dim regexSearch = New String(Path.GetInvalidFileNameChars()) & New String(Path.GetInvalidPathChars()) Dim r = New Regex(String.Format("[{0}]", Regex.Escape(regexSearch))) Return r.Replace(input, replacement) End Function Public Function WorkEmailMessage(MyEmailMessage As IMail, poUID As Long) As Boolean Try For Each m As MailBox In MyEmailMessage.From CURRENT_MAIL_FROM = m.Address Next 'TODO: Move all of these CURRENT_MAIL vars into a business object of type mail container 'Dim oMail As New MailContainer(MyEmailMessage, poUID) Logger.Debug($"Working on email from: {CURRENT_MAIL_FROM}...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 CURRENT_MAIL_MESSAGE_ID = RemoveIllegalFileNameChars(MyEmailMessage.MessageID) CURRENT_MAIL_UID = poUID If IsNothing(CURRENT_MAIL_MESSAGE_ID) Then CURRENT_MAIL_MESSAGE_ID = System.Guid.NewGuid.ToString() Else If CURRENT_MAIL_MESSAGE_ID.Length = 0 Then CURRENT_MAIL_MESSAGE_ID = System.Guid.NewGuid.ToString() End If End If CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace(">", "").Replace("<", "") CURRENT_MAIL_MESSAGE_ID = CURRENT_MAIL_MESSAGE_ID.Replace("'", "") If IsNothing(CURRENT_MAIL_SUBJECT) Then CURRENT_MAIL_SUBJECT = "" Else Logger.Debug($"Subject: {CURRENT_MAIL_SUBJECT}...") End If Logger.Debug($"Working on email from : {CURRENT_MAIL_FROM}...") Dim osql = $"Select COALESCE(MAX(GUID),0) FROM TBEMLP_HISTORY WHERE EMAIL_MSGID = '{CURRENT_MAIL_MESSAGE_ID}'" Dim oHistoryID = _DB_MSSQL.Execute_Scalar(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() '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 oFS.Close() 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() If CURRENT_ATTMT_COUNT = 0 Then Logger.Info("### Mail contained no Attachments!! ###") Dim oBody = EmailStrings.EMAIL_NO_FERDS If AddToEmailQueueMSSQL(CURRENT_MAIL_MESSAGE_ID, oBody, "No Attachments", _EmailAccountID) = True Then CURRENT_ImapObject.DeleteMessageByUID(poUID) End If End If 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 Public Function AddToEmailQueueMSSQL(MessageId As String, BodyText As String, SourceProcedure 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).Replace("'", "''") 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.Execute_Scalar(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}' ,'{SourceProcedure}' ,'{oCreatedWho}')" Return _DB_MSSQL.Execute_non_Query(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() As Boolean Try 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") DeleteMail = 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 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 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) 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 oDataRow As DataRow In PM_ROW DeleteMail = 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 = "" End Try Try WM_VECTOR_LOG = oDataRow("WM_VECTOR_LOG") Catch ex As Exception Logger.Debug($"Attention WM_VECTOR_LOG seems to be Empty/null: {ex.Message}") WM_VECTOR_LOG = "" 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 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() 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 FILENAME_MAX_LENGTH chars at most, ' otherwise we run into errors with the path being too long Dim oSubjectFilename = CURRENT_MAIL_MESSAGE.Subject.Truncate(FILENAME_MAX_LENGTH) & ".eml" Logger.Debug($"oSubjectFilename (beforeclean) is: {oSubjectFilename}") oSubjectFilename = RemoveIllegalFileNameChars(oSubjectFilename) Dim oTempFilename = oTempPath & "\" & oSubjectFilename Logger.Debug($"oTempFilename (afterclean) is: {oTempFilename}") 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.Subject.Replace(" ", "") & ".eml") ' oTempFilename = String.Join("", oTempFilename.Split(Path.GetInvalidPathChars())) ' oTempFilename = oTempFilename.Replace("/", "") ' oTempFilename = oTempFilename.Replace("\", "") ' Loop 'End If CURRENT_MAIL_MESSAGE.Save(oTempFilename) 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(pShouldCopyToDisk As Boolean, pPathOriginal 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(pPathOriginal) Then Dim oTempFilename = pPathOriginal If pUseMessageIdAsFilename = True Then Dim oFileName = CURRENT_MAIL_MESSAGE_ID & ".eml" oTempFilename = Path.Combine(oTempFilename, oFileName) 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE_ID & ".eml" Else Dim oFileName = CURRENT_MAIL_MESSAGE.Subject.Truncate(FILENAME_MAX_LENGTH).Replace(" ", "") & ".eml" oTempFilename = Path.Combine(oTempFilename, oFileName) 'oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.Subject.Replace(" ", "") & ".eml" End If 'Dim cleanPath As String = String.Join("", oTempFilename.Split(Path.GetInvalidPathChars())) If File.Exists(oTempFilename) = False Then Try File.Delete(oTempFilename) Catch ex As Exception Logger.Error(ex) Return False End Try CURRENT_MAIL_MESSAGE.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($"##!! oFileLenth is 0 !!##") Try File.Delete(oTempFilename) Catch ex As Exception Logger.Error(ex) End Try Return False End If Else Logger.Info("COPY2HDD (" & CURRENT_MAIL_MESSAGE.Subject & ") already existing in [{oTempFilename}]!", False, "RUN_THREAD.COPY_2_HDD") Return True End If End If End If Catch ex As Exception Logger.Error(ex) 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 Not IsNothing(CURRENT_MAIL_MESSAGE.Text) Then CURRENT_MAIL_BODY_ALL = oBodyText End If '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)) Dim oAttachmentCount As Integer oAttachmentCount = 0 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) 'For Each mime As MimeData In CURRENT_MAIL_MESSAGE.Attachments ' mime.Save(mime.SafeFileName) 'Next For Each mime As MimeData In CURRENT_MAIL_MESSAGE.Attachments ' For Each oAttachment As Attachment In oCurrentMail.GetAttachments Dim oATTFilename = mime.SafeFileName.ToString.ToLower '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}]", mime.SafeFileName)) 'oAttachment.GetFileName)) Try Dim oFilename = mime.SafeFileName 'oAttachment.GetFileName oFilename = CleanInput(oFilename) Logger.Debug($"oFilename [{oFilename}]") If oFilename = String.Empty Then oFilename = mime.SafeFileName 'oAttachment.GetFileName End If oAttachmentFileString = Path.Combine(PATH_TEMP, $"{CURRENT_MAIL_MESSAGE_ID}~{oFilename}") Logger.Debug($"oAttachmentFileString [{oAttachmentFileString}]") If System.IO.File.Exists(oAttachmentFileString) = False Then Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFileString)) Try mime.Save(oAttachmentFileString) '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(CURRENT_MAIL_MESSAGE_ID, mime.SafeFileName) INSERT_HISTORY_ATTMT_MSSQL(CURRENT_MAIL_MESSAGE_ID, mime.SafeFileName) oAttachmentCount += 1 Else Logger.Warn($"##!! oFileLenth for AttachmentObjects is 0 !!##") Try File.Delete(oAttachmentFileString) Catch ex As Exception Logger.Error(ex) End Try MessageError = True 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") oAttachmentCount += 1 End If Catch ex As Exception Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFileString}") MessageError = True 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 CURRENT_ATTMT_COUNT = oAttachmentCount If MessageError = True Then Return False Else Return True 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 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_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_FROM}'," & $"'{CURRENT_MAIL_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_FROM}'," & $"'{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 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