AppStd/EmailProfiler
8
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

MS Erweiterung IMAP

Browse Source
This commit is contained in:
Digital Data - Marlon Schreiber
2019-03-26 16:35:05 +01:00
parent 1d07465ca5
commit 9b9ec33533
98 changed files with 2215 additions and 349688 deletions
Download Patch File Download Diff File Expand all files Collapse all files

278
App/DigitalData.EMLProfiler/clsWorkEmail.vb
View File

@@ -96,7 +96,7 @@ Public Class clsWorkEmail
WM_IDX_BODY_SUBSTR_LENGTH = row("WM_IDX_BODY_SUBSTR_LENGTH")
oDel_email = row("DELETE_MAIL")
COPY2HDD(row("COPY_2_HDD"), row("PATH_EMAIL_TEMP"), row("PATH_EMAIL_ERRORS"), False)
COPY2HDD(row("COPY_2_HDD"), row("PATH_ORIGINAL"), row("PATH_EMAIL_ERRORS"), False)
EXTRACT_BODY()
Next
@@ -107,6 +107,10 @@ Public Class clsWorkEmail
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
MessageError = False
If GET_WMDOC_INFO() = True Then
If DT_STEPS.Rows.Count > 0 Then
@@ -139,26 +143,26 @@ Public Class clsWorkEmail
'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
For Each oDataRow As DataRow In PM_ROW
Try
WM_REFERENCE_INDEX = row("WM_REFERENCE_INDEX")
WM_REFERENCE_INDEX = oDataRow("WM_REFERENCE_INDEX")
Catch ex As Exception
WM_REFERENCE_INDEX = Nothing
End Try
Try
WM_VECTOR_LOG = row("WM_VECTOR_LOG")
WM_VECTOR_LOG = oDataRow("WM_VECTOR_LOG")
Catch ex As Exception
WM_VECTOR_LOG = Nothing
End Try
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")
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")
COPY2HDD(row("COPY_2_HDD"), row("PATH_EMAIL_TEMP"), row("PATH_EMAIL_ERRORS"), True)
EXTRACT_ATTACHMENTS(row("PATH_EMAIL_TEMP"), row("PATH_EMAIL_ERRORS"))
EXTRACT_BODY()
oDel_email = row("DELETE_MAIL")
COPY2HDD(oDataRow("COPY_2_HDD"), oDataRow("PATH_ORIGINAL"), oDataRow("PATH_EMAIL_ERRORS"), True)
EXTRACT_ATTACHMENTS(oDataRow("PATH_EMAIL_TEMP"), oDataRow("PATH_EMAIL_ERRORS"))
'EXTRACT_BODY()
oDel_email = oDataRow("DELETE_MAIL")
Next
If ClassCurrent.CURRENT_DEBUG_LOCAL_EMAIL = "" Then
EMAIL_DELETE(oDel_email)
@@ -228,14 +232,13 @@ Public Class clsWorkEmail
Return False
End Try
End Function
Private Function COPY2HDD(copy_2_hdd As Boolean, pathemailtemp As String, pathemail_errors As String, messageid As Boolean)
Private Function COPY2HDD(copy_2_hdd As Boolean, pathOriginal As String, pathemail_errors As String, messageid As Boolean)
Try
If copy_2_hdd = True Then
Logger.Debug("COPY_2_HDD is ACTIVE!")
PATH_TEMP = pathemailtemp
PATH_ERROR = pathemail_errors
If Directory.Exists(PATH_TEMP) Then
Dim oTempFilename = PATH_TEMP
If Directory.Exists(pathOriginal) Then
Dim oTempFilename = pathOriginal
If messageid = True Then
oTempFilename &= "\" & CURRENT_MAIL_MESSAGE.MessageID & ".eml"
Else
@@ -259,69 +262,122 @@ Public Class clsWorkEmail
End Function
Private Function EXTRACT_BODY()
TEMP_HTML_RESULTS.Clear()
Dim oDTFunctionRegex As DataTable = _Database.Return_Datatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE FUNCTION_NAME IN ('EMAIL_PROFILER - RemoveHTMLText','EMAIL_PROFILER - BODY REMOVE NewLine','EMAIL_PROFILER - BODY_ANSWER_GROUP')")
Dim oDTFunctionRegex As DataTable = _Database.Return_Datatable("SELECT * FROM TBDD_FUNCTION_REGEX WHERE UPPER(FUNCTION_NAME) IN (UPPER('EMAIL_PROFILER - RemoveHTMLText'),UPPER('EMAIL_PROFILER - RemoveHTMLText1'))")
Dim msg_email As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH)
If IsNothing(msg_email.Body) Then
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(msg_email.BodyParts)
oAllBodyParts.Add(GetChildren(msg_email.BodyParts))
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
Logger.Debug(String.Format("BODY1-Text is....#{0}", bodyPart.Body))
If CURRENT_MAIL_BODY_ALL <> bodyPart.Body Then
CURRENT_MAIL_BODY_ALL = bodyPart.Body
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
Logger.Debug(String.Format("bodyhtml....#{0}", bodyPart.Body))
If CURRENT_MAIL_BODY_ALL = "" Then
CURRENT_MAIL_BODY_ALL = bodyPart.Body
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 = msg_email.Body
CURRENT_MAIL_BODY_ALL = oMsg_email.Body
End If
If CURRENT_MAIL_BODY_ALL.StartsWith("<html") Then
If Not IsNothing(CURRENT_MAIL_BODY_ALL) Then
' CURRENT_MAIL_BODY_ALL = oMsg_email.Body
Dim oPattern1 As String
Dim oPattern2 As String
Try
Dim pattern1 As String = ""
For Each oRow As DataRow In oDTFunctionRegex.Rows
If oRow.Item("FUNCTION_NAME") = "EMAIL_PROFILER - RemoveHTMLText" 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)
oPattern1 = oDTFunctionRegex.Rows(0).Item("REGEX")
Catch ex As Exception
oPattern1 = ""
End Try
'If TEMP_HTML_RESULTS.Count = 0 Then
' Logger.Warn("HTML Recognition via Regex could not create a match within this mail - So the answer will interpreted as empty!")
'End If
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.Info($"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.Info($"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")
@@ -345,7 +401,9 @@ Public Class clsWorkEmail
If oCount = 1 Then
CURRENT_MAIL_BODY_ANSWER1 = ostr
Else
If oCount = 2 Then
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
@@ -389,8 +447,8 @@ Public Class clsWorkEmail
Logger.Debug(String.Format("MailBody-ANSWER1:...[{0}]", CURRENT_MAIL_BODY_ANSWER1))
Logger.Debug(String.Format("MailBody-ANSWER2:...[{0}]", CURRENT_MAIL_BODY_Substr2))
Logger.Info(String.Format("MailBody-ANSWER1:...[{0}]", CURRENT_MAIL_BODY_ANSWER1))
Logger.Info(String.Format("MailBody-ANSWER2:...[{0}]", CURRENT_MAIL_BODY_Substr2))
'now trying to get the text before Masterline
'If WM_IDX_BODY_TEXT <> String.Empty And WM_IDX_BODY_SUBSTR_LENGTH <> 0 And oDTFunctionRegex.Rows.Count >= 1 Then
' If CURRENT_MAIL_BODY_ALL.StartsWith("<html") Then
@@ -450,33 +508,43 @@ Public Class clsWorkEmail
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 msg_email As New Independentsoft.Email.Mime.Message(CURRENT_TEMP_MAIL_PATH)
For Each attachment As Attachment In msg_email.GetAttachments
If Path.GetExtension(attachment.GetFileName).ToUpper.Contains("PDF") Then
Dim sGUID = System.Guid.NewGuid.ToString()
Dim oAttachmentFilename
Try
oAttachmentFilename = Path.Combine(PATH_TEMP, $"{sGUID}{Path.GetExtension(attachment.GetFileName)}")
If System.IO.File.Exists(oAttachmentFilename) = False Then
attachment.Save(oAttachmentFilename)
INSERT_HISTORY_FB(sGUID, attachment.GetFileName)
Else
Logger.Info("Attachment (" & oAttachmentFilename & ") already existing!", False, "EXTRACT_ATTACHMENTS")
End If
Catch ex As Exception
Logger.Warn($"Error while creating and saving attachment-name: {ex.Message} - AttachmentName: {oAttachmentFilename}")
MessageError = True
Return False
End Try
End If
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 oAttachmentFileString
Logger.Debug(String.Format("Working on Attachment [{0}]", oAttachment.GetFileName))
Try
Dim oFilename = oAttachment.GetFileName
oFilename = CleanInput(oFilename)
If oFilename = String.Empty Then
oFilename = oAttachment.GetFileName
End If
oAttachmentFileString = Path.Combine(PATH_TEMP, $"{oMSGID}~{oFilename}")
If System.IO.File.Exists(oAttachmentFileString) = False Then
Logger.Debug(String.Format("Trying to save attachment [{0}]", oAttachmentFileString))
oAttachment.Save(oAttachmentFileString)
INSERT_HISTORY_FB(oMSGID, oAttachment.GetFileName)
Else
Logger.Info("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")
@@ -492,6 +560,29 @@ Public Class clsWorkEmail
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()
If MessageError = False Then
Dim ins = $"INSERT INTO TBEMLP_HISTORY (WORK_PROCESS,EMAIL_MSGID,EMAIL_SUBJECT,EMAIL_DATE,EMAIL_BODY,EMAIL_SUBSTRING1,EMAIL_SUBSTRING2) VALUES " &
@@ -543,6 +634,7 @@ Public Class clsWorkEmail
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")
@@ -550,10 +642,12 @@ Public Class clsWorkEmail
POLL_KEYWORDS = row.Item("KEYWORDS_BODY")
KEYWORDS_SPLIT = POLL_KEYWORDS.Split(";")
For Each str As String In KEYWORDS_SPLIT
If CURRENT_MAIL_BODY_ANSWER1.ToUpper = str.ToUpper Then
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", str))
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 = _Database.Return_Datatable(sql)
If DT_INDEXING_STEPS.Rows.Count > 0 Then
@@ -566,9 +660,15 @@ Public Class clsWorkEmail
Next
Next
If _worked_email = False Then
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 = _Database.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
@@ -674,7 +774,7 @@ Public Class clsWorkEmail
CURRENT_WM_DOC = Nothing
Dim oWMDOC As WMObject
Try
oWMDOC = _windream.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, CURRENT_DOC_PATH.Substring(2))
oWMDOC = _windream.oWMSession.GetWMObjectByPath(WMEntity.WMEntityDocument, CURRENT_DOC_PATH.Substring(2))
CURRENT_WM_DOC = oWMDOC
Return True
Catch ex As Exception