From 0704b07de70d76f02e3c5eef125c25ddb79b9a76 Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Mon, 23 Aug 2021 10:47:04 +0200 Subject: [PATCH] Version 2.4.2.2 - Remove Independentsoft Email, Replace with Limilabs.Mail, Remove manual Email Data Exctraction, Support Eml Files --- Global_Indexer/ClassEmailHeaderExtractor.vb | 179 +++-- Global_Indexer/ClassFilehandle.vb | 187 +++-- Global_Indexer/ClassFolderWatcher.vb | 1 - Global_Indexer/ClassInit.vb | 2 +- Global_Indexer/Global_Indexer.vbproj | 7 +- Global_Indexer/MailLicense.xml | 23 + Global_Indexer/My Project/AssemblyInfo.vb | 2 +- Global_Indexer/frmConfig_Basic.vb | 7 - Global_Indexer/frmIndex.vb | 820 ++++++++++---------- Global_Indexer/frmStart.vb | 1 - SetupVS19/Product.wxs | 3 + 11 files changed, 628 insertions(+), 604 deletions(-) create mode 100644 Global_Indexer/MailLicense.xml diff --git a/Global_Indexer/ClassEmailHeaderExtractor.vb b/Global_Indexer/ClassEmailHeaderExtractor.vb index 40f4680..4778409 100644 --- a/Global_Indexer/ClassEmailHeaderExtractor.vb +++ b/Global_Indexer/ClassEmailHeaderExtractor.vb @@ -1,106 +1,105 @@ -Imports Independentsoft -Imports Limilabs.Mail +Imports Limilabs.Mail Imports Limilabs.Mail.MSG Imports System.Text.RegularExpressions Public Class ClassEmailHeaderExtractor - ''' - ''' Extrahiert die Headerinformationen aus einem msg Objekt mithilfe der MSG.NET Klasse - ''' - ''' Eine Email vom Typ Msg.Message - ''' Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist. - Public Shared Function getMessageHeaders(msg As Msg.Message) - Try - Dim headers = msg.TransportMessageHeaders.Replace(vbCrLf, " ") - Return headers - Catch ex As Exception - Return Nothing - End Try - End Function + '''' + '''' Extrahiert die Headerinformationen aus einem msg Objekt mithilfe der MSG.NET Klasse + '''' + '''' Eine Email vom Typ Msg.Message + '''' Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist. + 'Public Shared Function getMessageHeaders(msg As Msg.Message) + ' Try + ' Dim headers = msg.TransportMessageHeaders.Replace(vbCrLf, " ") + ' Return headers + ' Catch ex As Exception + ' Return Nothing + ' End Try + 'End Function - ''' - ''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Absenderadresse. - ''' - ''' Headerinformationen die von getMessageHeaders erzeugt wurden. - ''' Eine Liste von Regular Expressions - ''' Die Ergebnisgruppe, die die Adresse enthält - ''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. - Public Shared Function extractFromAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) - If IsNothing(messageHeaders) Then - Return Nothing - End If + '''' + '''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Absenderadresse. + '''' + '''' Headerinformationen die von getMessageHeaders erzeugt wurden. + '''' Eine Liste von Regular Expressions + '''' Die Ergebnisgruppe, die die Adresse enthält + '''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. + 'Public Shared Function extractFromAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) + ' If IsNothing(messageHeaders) Then + ' Return Nothing + ' End If - For Each rx In RegexList - Dim match As Match = rx.Match(messageHeaders) - Dim email As String = match.Groups(RegexGroup).Value + ' For Each rx In RegexList + ' Dim match As Match = rx.Match(messageHeaders) + ' Dim email As String = match.Groups(RegexGroup).Value - If Not String.IsNullOrWhiteSpace(email) Then - Return email - End If - Next + ' If Not String.IsNullOrWhiteSpace(email) Then + ' Return email + ' End If + ' Next - Return Nothing - End Function - Public Shared Function extractFromHeader(messageHeaders As String, Regex As String) - Try - Dim result = Nothing - Dim i As Integer = 0 - If IsNothing(messageHeaders) Then - Return Nothing - End If - ' einen Regulären Ausdruck laden - Dim strRegex As String = Regex - Dim myRegex As New Regex(strRegex, RegexOptions.IgnorePatternWhitespace Or RegexOptions.IgnoreCase) - Dim strTargetString As String = messageHeaders.Trim - ' die Vorkommen im String auslesen - For Each myMatch As Match In myRegex.Matches(strTargetString) - If myMatch.Success Then - LOGGER.Debug("Match success. Matched Value: [{0}]", myMatch.Value) + ' Return Nothing + 'End Function + 'Public Shared Function extractFromHeader(messageHeaders As String, Regex As String) + ' Try + ' Dim result = Nothing + ' Dim i As Integer = 0 + ' If IsNothing(messageHeaders) Then + ' Return Nothing + ' End If + ' ' einen Regulären Ausdruck laden + ' Dim strRegex As String = Regex + ' Dim myRegex As New Regex(strRegex, RegexOptions.IgnorePatternWhitespace Or RegexOptions.IgnoreCase) + ' Dim strTargetString As String = messageHeaders.Trim + ' ' die Vorkommen im String auslesen + ' For Each myMatch As Match In myRegex.Matches(strTargetString) + ' If myMatch.Success Then + ' LOGGER.Debug("Match success. Matched Value: [{0}]", myMatch.Value) - If myMatch.Value <> "" Then - If i = 0 Then - result = myMatch.Value.ToString - Else - result = result & ";" & myMatch.Value.ToString - End If - i += 1 - End If - Else - LOGGER.Debug("Match failed!") - End If - Next + ' If myMatch.Value <> "" Then + ' If i = 0 Then + ' result = myMatch.Value.ToString + ' Else + ' result = result & ";" & myMatch.Value.ToString + ' End If + ' i += 1 + ' End If + ' Else + ' LOGGER.Debug("Match failed!") + ' End If + ' Next - LOGGER.Debug("Extracted value: [{0}]", result) + ' LOGGER.Debug("Extracted value: [{0}]", result) - Return result - Catch ex As Exception - LOGGER.Error(ex) - MsgBox("Unexpected Error in extractFromHeader: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) - Return Nothing - End Try - End Function + ' Return result + ' Catch ex As Exception + ' LOGGER.Error(ex) + ' MsgBox("Unexpected Error in extractFromHeader: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) + ' Return Nothing + ' End Try + 'End Function - ''' - ''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Empfängeradresse. - ''' - ''' Headerinformationen die von getMessageHeaders erzeugt wurden. - ''' Eine Liste von Regular Expressions - ''' Die Ergebnisgruppe, die die Adresse enthält - ''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. - Public Shared Function extractToAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) - If IsNothing(messageHeaders) Then - Return Nothing - End If + '''' + '''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Empfängeradresse. + '''' + '''' Headerinformationen die von getMessageHeaders erzeugt wurden. + '''' Eine Liste von Regular Expressions + '''' Die Ergebnisgruppe, die die Adresse enthält + '''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. + 'Public Shared Function extractToAddress(messageHeaders As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) + ' If IsNothing(messageHeaders) Then + ' Return Nothing + ' End If - For Each rx In RegexList - Dim match As Match = rx.Match(messageHeaders) - Dim email As String = match.Groups(RegexGroup).Value + ' For Each rx In RegexList + ' Dim match As Match = rx.Match(messageHeaders) + ' Dim email As String = match.Groups(RegexGroup).Value - If Not String.IsNullOrWhiteSpace(email) Then - Return email - End If - Next + ' If Not String.IsNullOrWhiteSpace(email) Then + ' Return email + ' End If + ' Next - Return Nothing - End Function + ' Return Nothing + 'End Function End Class diff --git a/Global_Indexer/ClassFilehandle.vb b/Global_Indexer/ClassFilehandle.vb index 52df65d..5bb1555 100644 --- a/Global_Indexer/ClassFilehandle.vb +++ b/Global_Indexer/ClassFilehandle.vb @@ -2,18 +2,16 @@ Imports System.Guid Imports System.Text.RegularExpressions Imports DevExpress.XtraEditors -Imports Independentsoft Imports DigitalData.Modules.Language Imports Limilabs.Mail Public Class ClassFilehandle Public Shared Function Decide_FileHandle(pFilename As String, pHandletype As String) Try - If pFilename.EndsWith(".msg") Then + If pFilename.ToUpper.EndsWith(".MSG") Or pFilename.ToUpper.EndsWith(".EML") Then CURRENT_MESSAGEID = "" - Dim oMsg As New Msg.Message(pFilename) - If oMsg.Attachments.Count > 0 Then - + Dim oMail As IMail = EMAIL.Load_Email(pFilename) + If oMail.Attachments.Count > 0 Then Dim oTitle As String Dim oMessage As String @@ -67,8 +65,7 @@ Public Class ClassFilehandle Dim oSuccess As Boolean = False LOGGER.Info("Converting file to Eml if needed: [{0}]", pEmailFilePath) - Dim oEmailFilePath = EMAIL.Convert_MsgToEml(pEmailFilePath) - Dim oEmail As IMail = EMAIL.Load_Email(oEmailFilePath) + Dim oEmail As IMail = EMAIL.Load_Email(pEmailFilePath) If oEmail.MessageID IsNot Nothing Then CURRENT_MESSAGEID = oEmail.MessageID @@ -77,13 +74,13 @@ Public Class ClassFilehandle CURRENT_MESSAGEID = NewGuid.ToString() End If - Dim oEmailFilePathWithoutAttachments = EMAIL.Remove_AttachmentsFromEmail(oEmailFilePath, "_excl_attachments") + Dim oEmailFilePathWithoutAttachments = EMAIL.Remove_AttachmentsFromEmail(pEmailFilePath, "_excl_attachments") TEMP_FILES.Add(oEmailFilePathWithoutAttachments) If Insert_GI_File(oEmailFilePathWithoutAttachments, oMessageOnlyMarker) = True Then oSuccess = True - Dim oAttachments As List(Of String) = EMAIL.Save_AttachmentsToDisk(oEmailFilePath) + Dim oAttachments As List(Of String) = EMAIL.Save_AttachmentsToDisk(pEmailFilePath) LOGGER.Debug("Saved [{0}] attachments to disk.", oAttachments.Count) @@ -108,91 +105,91 @@ Public Class ClassFilehandle End Try End Function - Private Shared Function Email_Decay(msgname As String, Optional FW As Boolean = False) - Try - Dim msgonly As String = "|MSGONLY|" - Dim ATT_EXTR As String = "|ATTMNTEXTRACTED|" - If FW = True Then - msgonly = "|FW_MSGONLY|" - ATT_EXTR = "|FW_ATTMNTEXTRACTED|" - End If - Dim erfolgreich As Boolean = False - Dim msg As New Msg.Message(msgname) - - If msg.InternetMessageId IsNot Nothing Then - CURRENT_MESSAGEID = msg.InternetMessageId - Else - LOGGER.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!") - Dim sGUID As String - sGUID = System.Guid.NewGuid.ToString() - CURRENT_MESSAGEID = sGUID - End If - - 'Nur die MSGDatei ablegen - Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(msgname) & "_excl_att.msg") - - If File.Exists(tempfile) Then - File.Delete(tempfile) - End If - Dim _msgEXAtt As New Msg.Message(msgname) - _msgEXAtt.Attachments.Clear() - _msgEXAtt.Save(tempfile) - 'Datei in Array zum Templöschen speichern - TEMP_FILES.Add(tempfile) - - If Insert_GI_File(tempfile, msgonly) = True Then - erfolgreich = True - 'Hier nun die Anhänge herauslösen - Dim _msg As New Msg.Message(msgname) - Dim i1 As Integer = 1 - - LOGGER.Info(">> Anzahl der Attachments: " & _msg.Attachments.Count) - For Each attachment As Independentsoft.Msg.Attachment In _msg.Attachments - If erfolgreich = False Then - Exit For - End If - Dim attachment_name As String - If attachment.LongFileName Is Nothing Then - attachment_name = attachment.DisplayName - Else - attachment_name = attachment.LongFileName - End If - If attachment.EmbeddedMessage IsNot Nothing Then - attachment_name = Utils.RemoveInvalidCharacters(attachment_name) - tempfile = Path.Combine(Path.GetTempPath, attachment_name & ".msg") - tempfile = ClassFilehandle.Versionierung_Datei(tempfile) - - If tempfile <> String.Empty Then - Dim oMessage = attachment.EmbeddedMessage - oMessage.IsEmbedded = False - oMessage.Save(tempfile) - TEMP_FILES.Add(tempfile) - LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile) - erfolgreich = Insert_GI_File(tempfile, ATT_EXTR) - i1 += 1 - End If - ElseIf Not attachment_name.Contains("inline") Then - 'Sonderzeichen entfernen - attachment_name = Utils.RemoveInvalidCharacters(attachment_name) - tempfile = Path.Combine(Path.GetTempPath, attachment_name) - tempfile = ClassFilehandle.Versionierung_Datei(tempfile) - If tempfile <> "" Then - attachment.Save(tempfile) - 'Datei in Array zum Templöschen speichern - TEMP_FILES.Add(tempfile) - LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile) - 'nun der Insert des Anhanges - erfolgreich = Insert_GI_File(tempfile, ATT_EXTR) - i1 += 1 - End If - End If - Next - End If - Return erfolgreich - Catch ex As Exception - MsgBox("Error in Email_Decay: " & ex.Message, MsgBoxStyle.Critical) - End Try - End Function + 'Private Shared Function Email_Decay(msgname As String, Optional FW As Boolean = False) + ' Try + ' Dim msgonly As String = "|MSGONLY|" + ' Dim ATT_EXTR As String = "|ATTMNTEXTRACTED|" + ' If FW = True Then + ' msgonly = "|FW_MSGONLY|" + ' ATT_EXTR = "|FW_ATTMNTEXTRACTED|" + ' End If + ' Dim erfolgreich As Boolean = False + ' Dim msg As New MSG.Message(msgname) + + ' If msg.InternetMessageId IsNot Nothing Then + ' CURRENT_MESSAGEID = msg.InternetMessageId + ' Else + ' LOGGER.Info("Es konnte keine Message-ID gelesen werden. Eine GUID wird erzeugt!") + ' Dim sGUID As String + ' sGUID = System.Guid.NewGuid.ToString() + ' CURRENT_MESSAGEID = sGUID + ' End If + + ' 'Nur die MSGDatei ablegen + ' Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(msgname) & "_excl_att.msg") + + ' If File.Exists(tempfile) Then + ' File.Delete(tempfile) + ' End If + ' Dim _msgEXAtt As New Msg.Message(msgname) + ' _msgEXAtt.Attachments.Clear() + ' _msgEXAtt.Save(tempfile) + ' 'Datei in Array zum Templöschen speichern + ' TEMP_FILES.Add(tempfile) + + ' If Insert_GI_File(tempfile, msgonly) = True Then + ' erfolgreich = True + ' 'Hier nun die Anhänge herauslösen + ' Dim _msg As New Msg.Message(msgname) + ' Dim i1 As Integer = 1 + + ' LOGGER.Info(">> Anzahl der Attachments: " & _msg.Attachments.Count) + ' For Each attachment As Independentsoft.Msg.Attachment In _msg.Attachments + ' If erfolgreich = False Then + ' Exit For + ' End If + ' Dim attachment_name As String + ' If attachment.LongFileName Is Nothing Then + ' attachment_name = attachment.DisplayName + ' Else + ' attachment_name = attachment.LongFileName + ' End If + ' If attachment.EmbeddedMessage IsNot Nothing Then + ' attachment_name = Utils.RemoveInvalidCharacters(attachment_name) + ' tempfile = Path.Combine(Path.GetTempPath, attachment_name & ".msg") + ' tempfile = ClassFilehandle.Versionierung_Datei(tempfile) + + ' If tempfile <> String.Empty Then + ' Dim oMessage = attachment.EmbeddedMessage + ' oMessage.IsEmbedded = False + ' oMessage.Save(tempfile) + ' TEMP_FILES.Add(tempfile) + ' LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile) + ' erfolgreich = Insert_GI_File(tempfile, ATT_EXTR) + ' i1 += 1 + ' End If + ' ElseIf Not attachment_name.Contains("inline") Then + ' 'Sonderzeichen entfernen + ' attachment_name = Utils.RemoveInvalidCharacters(attachment_name) + ' tempfile = Path.Combine(Path.GetTempPath, attachment_name) + ' tempfile = ClassFilehandle.Versionierung_Datei(tempfile) + ' If tempfile <> "" Then + ' attachment.Save(tempfile) + ' 'Datei in Array zum Templöschen speichern + ' TEMP_FILES.Add(tempfile) + ' LOGGER.Info(">> Attachment (" & i1 & "):" & tempfile) + ' 'nun der Insert des Anhanges + ' erfolgreich = Insert_GI_File(tempfile, ATT_EXTR) + ' i1 += 1 + ' End If + ' End If + ' Next + ' End If + ' Return erfolgreich + ' Catch ex As Exception + ' MsgBox("Error in Email_Decay: " & ex.Message, MsgBoxStyle.Critical) + ' End Try + 'End Function Private Shared Function Insert_GI_File(filename As String, handleType As String) Try @@ -201,7 +198,7 @@ Public Class ClassFilehandle Dim oHash As String = String.Empty If File.Exists(filename) Then - If filename.ToUpper.EndsWith(".MSG") And (handleType = "|OUTLOOK_MESSAGE|" Or handleType = "|MSGONLY|") Then + If (filename.ToUpper.EndsWith(".MSG") Or filename.ToUpper.EndsWith(".EML")) And (handleType = "|OUTLOOK_MESSAGE|" Or handleType = "|MSGONLY|") Then oHash = FILESYSTEM.GetChecksumFromString(filename) Else oHash = FILESYSTEM.GetChecksum(filename) diff --git a/Global_Indexer/ClassFolderWatcher.vb b/Global_Indexer/ClassFolderWatcher.vb index a9d3bae..d17d887 100644 --- a/Global_Indexer/ClassFolderWatcher.vb +++ b/Global_Indexer/ClassFolderWatcher.vb @@ -1,5 +1,4 @@ Imports System.IO -Imports Independentsoft Imports System.Threading Public Class ClassFolderWatcher diff --git a/Global_Indexer/ClassInit.vb b/Global_Indexer/ClassInit.vb index 3ffc300..d95c4cd 100644 --- a/Global_Indexer/ClassInit.vb +++ b/Global_Indexer/ClassInit.vb @@ -1,10 +1,10 @@ Imports System.ComponentModel -Imports DLLLicenseManager Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Config Imports DigitalData.Modules.Windream Imports DigitalData.Modules.Filesystem Imports DigitalData.Modules.Messaging +Imports DLLLicenseManager Public Class ClassInit Public _lizenzManager As ClassLicenseManager diff --git a/Global_Indexer/Global_Indexer.vbproj b/Global_Indexer/Global_Indexer.vbproj index 89dcc32..85378e5 100644 --- a/Global_Indexer/Global_Indexer.vbproj +++ b/Global_Indexer/Global_Indexer.vbproj @@ -189,10 +189,6 @@ False P:\Visual Studio Projekte\Bibliotheken\DLLLicenseManager.dll - - False - P:\Visual Studio Projekte\Bibliotheken\MSG .NET\Bin\22_11_19\Independentsoft.Msg.dll - P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WINDREAMLib.dll False @@ -780,6 +776,9 @@ PreserveNewest + + PreserveNewest + diff --git a/Global_Indexer/MailLicense.xml b/Global_Indexer/MailLicense.xml new file mode 100644 index 0000000..0510526 --- /dev/null +++ b/Global_Indexer/MailLicense.xml @@ -0,0 +1,23 @@ + + + 4dc5ef40-f1a9-468b-994c-b7ed600ad878 + Mail.dll + 2022-07-29 + Digital Data GmbH + single developer + Digital Data GmbH + + + + + + + + + + 75MRtl4ipYelIZYlpT8O7QDX9Zc= + + + Raxfkz6DfQVs/sMvH+F2nH0eHXD8FoUFSdP3t7AgBUdpABJQx86srlyuMSEhXPlc1THCqPouEVob4RsWnd9OXvTiPPSOUSK9zuNG6uz93KLAhpSD5PraAgBCF4jwZArlAp7aCNfZpHqQ3w6TRHS+CfravUU0AHHG3MZ1ZcRkGuo= + + \ No newline at end of file diff --git a/Global_Indexer/My Project/AssemblyInfo.vb b/Global_Indexer/My Project/AssemblyInfo.vb index 0ba182c..8b2d191 100644 --- a/Global_Indexer/My Project/AssemblyInfo.vb +++ b/Global_Indexer/My Project/AssemblyInfo.vb @@ -33,7 +33,7 @@ Imports System.Runtime.InteropServices ' übernehmen, indem Sie "*" eingeben: ' - + \ No newline at end of file diff --git a/Global_Indexer/frmConfig_Basic.vb b/Global_Indexer/frmConfig_Basic.vb index ee42d76..76e0033 100644 --- a/Global_Indexer/frmConfig_Basic.vb +++ b/Global_Indexer/frmConfig_Basic.vb @@ -516,11 +516,4 @@ Public Class frmConfig_Basic ' Navigate to a URL. System.Diagnostics.Process.Start("http://www.didalog.de/Support") End Sub - - 'Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged - ' If CURR_DELETE_ORIGIN <> chkdelete_origin.Checked Then - ' CURR_DELETE_ORIGIN = chkdelete_origin.Checked - ' SaveConfigValue("Delete_OriginFile", CURR_DELETE_ORIGIN) - ' End If - 'End Sub End Class \ No newline at end of file diff --git a/Global_Indexer/frmIndex.vb b/Global_Indexer/frmIndex.vb index 27006b6..60260b8 100644 --- a/Global_Indexer/frmIndex.vb +++ b/Global_Indexer/frmIndex.vb @@ -1,6 +1,5 @@ Imports System.IO Imports System.Text.RegularExpressions -Imports Independentsoft Imports System.Text Imports System.Security.AccessControl Imports System.Security.Principal @@ -313,17 +312,17 @@ Public Class frmIndex '#End Region '#Region "+++++ Funktionen bei OK - schliessen ++++++" - Function CheckWrite_IndexeMan(dokartid As Integer) + Function CheckWrite_IndexeMan(oDocumentTypeId As Integer) '#### Zuerst manuelle Werte indexieren #### Try _Logger.Info("In CheckWrite_IndexeMan") - Dim result As Boolean = False + Dim oResult As Boolean = False For Each oControl As Control In Me.pnlIndex.Controls ' MsgBox(ctrl.Name) If oControl.Name.StartsWith("txt") Then Dim box As DevExpress.XtraEditors.TextEdit = oControl If box.Text = "" Then - Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(box.Name, "txt", "") & "'", MyConnectionString, True) + Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(box.Name, "txt", "") & "'", MyConnectionString, True) If optional_index = False Then If USER_LANGUAGE = LANG_DE Then @@ -336,7 +335,7 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") - result = True + oResult = True End If Else If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then @@ -356,19 +355,19 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) - result = True + oResult = True End If End If End If If oControl.Name.StartsWith("cmbMulti") Then Dim oLookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl3) - Dim values As List(Of String) = oLookup.Properties.SelectedValues + Dim oValues As List(Of String) = oLookup.Properties.SelectedValues - If values.Count = 0 Then - Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'", MyConnectionString, True) + If oValues.Count = 0 Then + Dim oIsOptionalIndex As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'", MyConnectionString, True) - If optional_index = False Then + If oIsOptionalIndex = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) Else @@ -379,18 +378,18 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") - result = True + oResult = True End If Else - Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, values) + Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, oValues) Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) - result = True + oResult = True End If ElseIf oControl.Name.StartsWith("cmbSingle") Then Dim cmbSingle As TextBox = oControl If cmbSingle.Text = "" Then - Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'", MyConnectionString, True) + Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'", MyConnectionString, True) If optional_index = False Then If USER_LANGUAGE = LANG_DE Then @@ -402,16 +401,16 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") - result = True + oResult = True End If Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) - result = True + oResult = True End If ElseIf oControl.Name.StartsWith("cmb") Then Dim cmb As ComboBox = oControl If cmb.Text = "" Then - Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'", MyConnectionString, True) + Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'", MyConnectionString, True) If optional_index = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) @@ -422,11 +421,11 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") - result = True + oResult = True End If Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) - result = True + oResult = True End If End If If oControl.Name.StartsWith("dtp") Then @@ -434,7 +433,7 @@ Public Class frmIndex Dim oIndexName As String = Replace(dtp.Name, "dtp", "") If dtp.Text = String.Empty Then - Dim optional_index As Boolean = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {dokartid} AND NAME = '{oIndexName}'", MyConnectionString, True) + Dim optional_index As Boolean = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{oIndexName}'", MyConnectionString, True) If optional_index = False Then If USER_LANGUAGE = LANG_DE Then @@ -446,22 +445,22 @@ Public Class frmIndex Return False Else Indexwert_Postprocessing(oIndexName, "") - result = True + oResult = True End If Else Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) - result = True + oResult = True End If End If If oControl.Name.StartsWith("chk") Then Dim chk As CheckBox = oControl Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked) - result = True + oResult = True End If If TypeOf (oControl) Is Button Then Continue For End If - If oControl.Name.StartsWith("lbl") = False And result = False Then + If oControl.Name.StartsWith("lbl") = False And oResult = False Then _Logger.Info(TEXT_CHECK_MANUAL_INDEXES_EN) Return False End If @@ -871,8 +870,7 @@ Public Class frmIndex Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean Try Dim oMsgFilePath As String = Path.Combine("\\windream\objects", CURRENT_NEWFILENAME) - Dim oEmlFilePath As String = EMAIL.Convert_MsgToEml(oMsgFilePath) - Dim oMail As IMail = EMAIL.Load_Email(oEmlFilePath) + Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath) Dim oSQL As String = $"SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '{CURR_DOKART_OBJECTTYPE}'" Dim oTable As DataTable = ClassDatabase.Return_Datatable(oSQL) @@ -893,8 +891,8 @@ Public Class frmIndex End If Dim oMessageId As String = oMail.MessageID - Dim oMessageFrom As String = oMail.From.First?.Address - Dim oMessageTo As String = DirectCast(oMail.To.First, MailBox)?.Address + Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail) + Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail) Dim oSubject As String = oMail.Subject Dim oDateIn As Date = oMail.Date @@ -913,18 +911,29 @@ Public Class frmIndex For Each oIndex In oIndexNames Try - If oIndex.Value Is Nothing OrElse oIndex.Value = String.Empty Then + If oIndex.Value Is Nothing Then + LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) + Return False + + End If + + If TypeOf oIndex.Value Is String AndAlso oIndex.Value = String.Empty Then + LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) Return False + End If Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value) 'Die aktuelle Message-ID zwischenspeichern CURRENT_MESSAGEID = oMessageId + If oIndexingSuccessful = False Then - MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) + MsgBox($"Error while Indexing Email at Index [{oIndex.Key}]", MsgBoxStyle.Critical) Return False + End If Catch ex As Exception + LOGGER.Warn("Error while Indexing Email at Index [{0}]", oIndex.Key) LOGGER.Error(ex) Return False End Try @@ -937,383 +946,384 @@ Public Class frmIndex End Try End Function - Private Function SetEmailIndicesOld() - Dim indexierung_erfolgreich As Boolean = False - Dim _step As String = "1" - - Try - Dim oTempPath As String = Path.Combine("\\windream\objects", CURRENT_NEWFILENAME) - Dim msg As Msg.Message = New Msg.Message(oTempPath) - Dim msgDisplayTo = msg.DisplayTo - Dim msgInternetAccountName = msg.InternetAccountName - If LogErrorsOnly = False Then - _Logger.Info("") - _Logger.Info("msgInternetAccountName: " & msgInternetAccountName) - _Logger.Info("SenderName: " & msg.SenderName) - _Logger.Info("SenderEmailAddress: " & msg.SenderEmailAddress) - _Logger.Info("ReceivedByName: " & msg.ReceivedByName) - _Logger.Info("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress) - _Logger.Info("") - End If - _step = "2" - - 'Console.WriteLine("Subject: " + msg.Subject) - 'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime) - 'Console.WriteLine("SenderName: " + msg.SenderName) - 'Console.WriteLine("SenderEmailAddress: " + msg.SenderEmailAddress) - 'Console.WriteLine("ReceivedByName: " + msg.ReceivedByName) - 'Console.WriteLine("ReceivedByEmailAddress: " + msg.ReceivedByEmailAddress) - 'Console.WriteLine("DisplayTo: " + msg.DisplayTo) - 'Console.WriteLine("DisplayCc: " + msg.DisplayCc) - 'Console.WriteLine("Body: " + msg.Body) - 'Console.WriteLine("-----------------------------------------------------------------------") - 'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText) - Dim fromPattern As String = "" - Dim toPattern As String = "" - Dim messageIDPattern As String = "" - Dim finalize_pattern As String = "" - - ' Email Header auslesen - Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg) - - For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows - If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then - fromPattern = rowregex.Item("REGEX") - ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then - toPattern = rowregex.Item("REGEX") - ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then - messageIDPattern = rowregex.Item("REGEX") - ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then - finalize_pattern = rowregex.Item("REGEX") - End If - Next - Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") - If IsNothing(DT) Then - _Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "' RESULTED in NOTHING") - Return False - End If - If DT.Rows.Count = 1 Then - _step = "3" - CURRENT_MESSAGEDATE = "" - CURRENT_MESSAGESUBJECT = "" - 'Message-ID nur auswerten wenn vorher nicht gestzt wurde! - If CURRENT_MESSAGEID = "" Then - If Not msg.InternetMessageId Is Nothing Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId) - 'Die aktuelle Message-ID zwischenspeichern - CURRENT_MESSAGEID = msg.InternetMessageId - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) - Return False - End If - Else - If messageIDPattern = String.Empty Then - _Logger.Info("A messageID could not be read!") - Else - If Not IsNothing(headers) Then - CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern) - If IsNothing(CURRENT_MESSAGEID) Then - CURRENT_MESSAGEID = "" - End If - Else - _Logger.Info("A messageID could not be read - messageheader nothing/messagIDpattern value!") - End If - End If - - End If - Else - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) - Return False - End If - End If - _step = "4" - ' Regular Expressions vorbereiten - - If fromPattern <> "" And toPattern <> "" Then - _step = "4.1" - Dim FromRegexList As New List(Of Regex) - Dim ToRegexList As New List(Of Regex) - Dim fromRegex As New Regex(fromPattern, RegexOptions.IgnoreCase) - Dim toRegex As New Regex(toPattern, RegexOptions.IgnoreCase) - - FromRegexList.Add(fromRegex) - ToRegexList.Add(toRegex) - - - Dim emailFrom - Dim emailTo - ' Email Absender und Empfänger - If headers Is Nothing Then - _step = "4.2" - If IsNothing(msgDisplayTo) Then - _step = "4.3" - _Logger.Info("DisplayTo in email is nothing - default will be set") - emailTo = "NO RECIPIENT" - Else - _step = "4.4" - emailTo = msgDisplayTo.ToString.Replace("'", "") - End If - If IsNothing(msgInternetAccountName) Then - _step = "4.5" - _Logger.Info("InternetAccountName in email is nothing - default will be set") - emailFrom = "" - Else - _step = "4.6" - emailFrom = msgInternetAccountName.ToString.Replace("'", "") - End If - Else - _step = "5" - _Logger.Info("emailTo and From Extraction via messageheader.") - emailFrom = ClassEmailHeaderExtractor.extractFromHeader(headers, fromPattern) 'FromRegexList) - emailTo = ClassEmailHeaderExtractor.extractFromHeader(headers, toPattern) ' extractToAddress(headers, ToRegexList) - - 'Handler für leere emailTo-Adresse - If IsNothing(emailTo) Then - _step = "5.1" - _Logger.Info("emailTo couldn't be extracted from messageheader...") - If (headers.Contains("exc") Or headers.Contains("exchange")) Then - _step = "5.2" - _Logger.Info("...try with LDAP-option") - Dim _email = GetUserEmailfromLDAP(msgDisplayTo) - _step = "5.3" - If _email <> "" Then - emailTo = _email - Else - _Logger.Info(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'") - MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) - Return False - End If - Else - _step = "5.4" - CURR_MISSING_PATTERN_NAME = "Email To" - CURR_MISSING_SEARCH_STRING = headers - CURR_MISSING_MANUAL_VALUE = String.Empty - frmMissingInput.ShowDialog() - _step = "5.4.1" - If CURR_MISSING_MANUAL_VALUE <> String.Empty Then - _step = "5.4.2" - emailTo = CURR_MISSING_MANUAL_VALUE - Else - _step = "5.4.3" - _Logger.Info("no exchange patterns found in headers!") - MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) - Return False - End If - - End If - End If - _step = "6" - emailTo = ClassEmailHeaderExtractor.extractFromHeader(emailTo, finalize_pattern) - emailFrom = ClassEmailHeaderExtractor.extractFromHeader(emailFrom, finalize_pattern) - _step = "6.1" - - If Not IsNothing(emailFrom) Then - emailFrom = emailFrom.Replace("<", "") - emailFrom = emailFrom.Replace(">", "") - Else - _step = "6.1.x" - _Logger.Info("emailFrom is Nothing?!") - End If + 'Private Function SetEmailIndicesOld() + ' Dim indexierung_erfolgreich As Boolean = False + ' Dim _step As String = "1" + + ' Try + ' Dim oTempPath As String = Path.Combine("\\windream\objects", CURRENT_NEWFILENAME) + ' Dim msg As Msg.Message = New Msg.Message(oTempPath) + ' Dim msgDisplayTo = msg.DisplayTo + ' Dim msgInternetAccountName = msg.InternetAccountName + ' If LogErrorsOnly = False Then + ' _Logger.Info("") + ' _Logger.Info("msgInternetAccountName: " & msgInternetAccountName) + ' _Logger.Info("SenderName: " & msg.SenderName) + ' _Logger.Info("SenderEmailAddress: " & msg.SenderEmailAddress) + ' _Logger.Info("ReceivedByName: " & msg.ReceivedByName) + ' _Logger.Info("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress) + ' _Logger.Info("") + ' End If + ' _step = "2" + + ' 'Console.WriteLine("Subject: " + msg.Subject) + ' 'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime) + ' 'Console.WriteLine("SenderName: " + msg.SenderName) + ' 'Console.WriteLine("SenderEmailAddress: " + msg.SenderEmailAddress) + ' 'Console.WriteLine("ReceivedByName: " + msg.ReceivedByName) + ' 'Console.WriteLine("ReceivedByEmailAddress: " + msg.ReceivedByEmailAddress) + ' 'Console.WriteLine("DisplayTo: " + msg.DisplayTo) + ' 'Console.WriteLine("DisplayCc: " + msg.DisplayCc) + ' 'Console.WriteLine("Body: " + msg.Body) + ' 'Console.WriteLine("-----------------------------------------------------------------------") + ' 'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText) + ' Dim fromPattern As String = "" + ' Dim toPattern As String = "" + ' Dim messageIDPattern As String = "" + ' Dim finalize_pattern As String = "" + + ' ' Email Header auslesen + ' Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg) + + ' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows + ' If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then + ' fromPattern = rowregex.Item("REGEX") + ' ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then + ' toPattern = rowregex.Item("REGEX") + ' ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then + ' messageIDPattern = rowregex.Item("REGEX") + ' ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then + ' finalize_pattern = rowregex.Item("REGEX") + ' End If + ' Next + ' Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") + ' If IsNothing(DT) Then + ' _Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "' RESULTED in NOTHING") + ' Return False + ' End If + ' If DT.Rows.Count = 1 Then + ' _step = "3" + ' CURRENT_MESSAGEDATE = "" + ' CURRENT_MESSAGESUBJECT = "" + ' 'Message-ID nur auswerten wenn vorher nicht gestzt wurde! + ' If CURRENT_MESSAGEID = "" Then + ' If Not msg.InternetMessageId Is Nothing Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId) + ' 'Die aktuelle Message-ID zwischenspeichern + ' CURRENT_MESSAGEID = msg.InternetMessageId + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' Else + ' If messageIDPattern = String.Empty Then + ' _Logger.Info("A messageID could not be read!") + ' Else + ' If Not IsNothing(headers) Then + ' CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern) + ' If IsNothing(CURRENT_MESSAGEID) Then + ' CURRENT_MESSAGEID = "" + ' End If + ' Else + ' _Logger.Info("A messageID could not be read - messageheader nothing/messagIDpattern value!") + ' End If + ' End If - If Not IsNothing(emailTo) Then - _step = "6.1.1 " & emailTo.ToString - emailTo = emailTo.Replace("<", "") - emailTo = emailTo.Replace(">", "") - _step = "6.2" - Dim _duplicatesCheck As List(Of String) = New List(Of String) - _duplicatesCheck = emailTo.ToString.Split(";").ToList - ' Filter distinct elements, and convert back into list. - Dim result As List(Of String) = _duplicatesCheck.Distinct().ToList - ' Display result. - Dim i As Integer = 0 - For Each element As String In result - If i = 0 Then - emailTo = element - Else - emailTo = emailTo & ";" & element - End If - i += 1 - Next - Else - _step = "6.3" - _Logger.Info("emailTo is Nothing?!") - End If + ' End If + ' Else + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' End If + ' _step = "4" + ' ' Regular Expressions vorbereiten + + ' If fromPattern <> "" And toPattern <> "" Then + ' _step = "4.1" + ' Dim FromRegexList As New List(Of Regex) + ' Dim ToRegexList As New List(Of Regex) + ' Dim fromRegex As New Regex(fromPattern, RegexOptions.IgnoreCase) + ' Dim toRegex As New Regex(toPattern, RegexOptions.IgnoreCase) + + ' FromRegexList.Add(fromRegex) + ' ToRegexList.Add(toRegex) + + + ' Dim emailFrom + ' Dim emailTo + ' ' Email Absender und Empfänger + ' If headers Is Nothing Then + ' _step = "4.2" + ' If IsNothing(msgDisplayTo) Then + ' _step = "4.3" + ' _Logger.Info("DisplayTo in email is nothing - default will be set") + ' emailTo = "NO RECIPIENT" + ' Else + ' _step = "4.4" + ' emailTo = msgDisplayTo.ToString.Replace("'", "") + ' End If + ' If IsNothing(msgInternetAccountName) Then + ' _step = "4.5" + ' _Logger.Info("InternetAccountName in email is nothing - default will be set") + ' emailFrom = "" + ' Else + ' _step = "4.6" + ' emailFrom = msgInternetAccountName.ToString.Replace("'", "") + ' End If + ' Else + ' _step = "5" + ' _Logger.Info("emailTo and From Extraction via messageheader.") + ' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(headers, fromPattern) 'FromRegexList) + ' emailTo = ClassEmailHeaderExtractor.extractFromHeader(headers, toPattern) ' extractToAddress(headers, ToRegexList) + + ' 'Handler für leere emailTo-Adresse + ' If IsNothing(emailTo) Then + ' _step = "5.1" + ' _Logger.Info("emailTo couldn't be extracted from messageheader...") + ' If (headers.Contains("exc") Or headers.Contains("exchange")) Then + ' _step = "5.2" + ' _Logger.Info("...try with LDAP-option") + ' Dim _email = GetUserEmailfromLDAP(msgDisplayTo) + ' _step = "5.3" + ' If _email <> "" Then + ' emailTo = _email + ' Else + ' _Logger.Info(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'") + ' MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) + ' Return False + ' End If + ' Else + ' _step = "5.4" + ' CURR_MISSING_PATTERN_NAME = "Email To" + ' CURR_MISSING_SEARCH_STRING = headers + ' CURR_MISSING_MANUAL_VALUE = String.Empty + ' frmMissingInput.ShowDialog() + ' _step = "5.4.1" + ' If CURR_MISSING_MANUAL_VALUE <> String.Empty Then + ' _step = "5.4.2" + ' emailTo = CURR_MISSING_MANUAL_VALUE + ' Else + ' _step = "5.4.3" + ' _Logger.Info("no exchange patterns found in headers!") + ' MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) + ' Return False + ' End If + + ' End If + ' End If + ' _step = "6" + ' emailTo = ClassEmailHeaderExtractor.extractFromHeader(emailTo, finalize_pattern) + ' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(emailFrom, finalize_pattern) + ' _step = "6.1" + + ' If Not IsNothing(emailFrom) Then + ' emailFrom = emailFrom.Replace("<", "") + ' emailFrom = emailFrom.Replace(">", "") + ' Else + ' _step = "6.1.x" + ' _Logger.Info("emailFrom is Nothing?!") + ' End If - _Logger.Info("Headers-Content: ") - _Logger.Info(headers.ToString) - End If - 'Handler für leere emailFrom-Adresse - If IsNothing(emailFrom) Then - _step = "7" - _Logger.Info("emailFrom couldn't be extracted from messageheader...") - If Not IsNothing(msg.SenderEmailAddress) Then - If msg.SenderEmailAddress <> String.Empty Then - _step = "7.1" - _Logger.Info("emailFrom via msg.SenderEmailAddress will be used instead!") - emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "") - End If - End If - End If - If IsNothing(emailFrom) Or emailFrom = String.Empty Then - _step = "7.2" - CURR_MISSING_PATTERN_NAME = "Email From" - CURR_MISSING_SEARCH_STRING = emailFrom - CURR_MISSING_MANUAL_VALUE = String.Empty - frmMissingInput.ShowDialog() - If CURR_MISSING_MANUAL_VALUE <> String.Empty Then - _step = "7.3" - emailFrom = CURR_MISSING_MANUAL_VALUE - Else - MsgBox("Could't get 'emailfrom' from messageHeader." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) - Return False - End If - End If + ' If Not IsNothing(emailTo) Then + ' _step = "6.1.1 " & emailTo.ToString + ' emailTo = emailTo.Replace("<", "") + ' emailTo = emailTo.Replace(">", "") + ' _step = "6.2" + ' Dim _duplicatesCheck As List(Of String) = New List(Of String) + ' _duplicatesCheck = emailTo.ToString.Split(";").ToList + ' ' Filter distinct elements, and convert back into list. + ' Dim result As List(Of String) = _duplicatesCheck.Distinct().ToList + ' ' Display result. + ' Dim i As Integer = 0 + ' For Each element As String In result + ' If i = 0 Then + ' emailTo = element + ' Else + ' emailTo = emailTo & ";" & element + ' End If + ' i += 1 + ' Next + ' Else + ' _step = "6.3" + ' _Logger.Info("emailTo is Nothing?!") + ' End If - _Logger.Info("emailFrom: " & emailFrom) - _Logger.Info("emailTo: " & emailTo) - 'FROM - If Not IsNothing(emailFrom) Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_FROM").ToString, emailFrom) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices [emailFrom] - See log", MsgBoxStyle.Critical) - Return False - End If - Else - _Logger.Info("emailFrom is still Nothing?!") - _step = "7.4" - End If - 'TO - If Not IsNothing(emailTo) Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_TO").ToString, emailTo) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices [emailTo] - See log", MsgBoxStyle.Critical) - Return False - End If - Else - _Logger.Info("emailTo is still Nothing?!") - _step = "7.5" - End If + ' _Logger.Info("Headers-Content: ") + ' _Logger.Info(headers.ToString) + ' End If + ' 'Handler für leere emailFrom-Adresse + ' If IsNothing(emailFrom) Then + ' _step = "7" + ' _Logger.Info("emailFrom couldn't be extracted from messageheader...") + ' If Not IsNothing(msg.SenderEmailAddress) Then + ' If msg.SenderEmailAddress <> String.Empty Then + ' _step = "7.1" + ' _Logger.Info("emailFrom via msg.SenderEmailAddress will be used instead!") + ' emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "") + ' End If + ' End If + ' End If + ' If IsNothing(emailFrom) Or emailFrom = String.Empty Then + ' _step = "7.2" + ' CURR_MISSING_PATTERN_NAME = "Email From" + ' CURR_MISSING_SEARCH_STRING = emailFrom + ' CURR_MISSING_MANUAL_VALUE = String.Empty + ' frmMissingInput.ShowDialog() + ' If CURR_MISSING_MANUAL_VALUE <> String.Empty Then + ' _step = "7.3" + ' emailFrom = CURR_MISSING_MANUAL_VALUE + ' Else + ' MsgBox("Could't get 'emailfrom' from messageHeader." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) + ' Return False + ' End If + ' End If - ' Dim subj As String = ClassFormFunctions.CleanInput(msg.Subject) - Dim subj As String = msg.Subject - If IsNothing(subj) Or subj = "" Then - _Logger.Info("msg subject is empty...DEFAULT will be set") - subj = "No subject" - MsgBox("Attention: Email was send without a subject - Default value 'No subject' will be used!", MsgBoxStyle.Exclamation) - Else - subj = ClassHelper.encode_utf8(msg.Subject) - If IsNothing(subj) Then - subj = msg.Subject - End If - End If + ' _Logger.Info("emailFrom: " & emailFrom) + ' _Logger.Info("emailTo: " & emailTo) + ' 'FROM + ' If Not IsNothing(emailFrom) Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_FROM").ToString, emailFrom) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices [emailFrom] - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' Else + ' _Logger.Info("emailFrom is still Nothing?!") + ' _step = "7.4" + ' End If + ' 'TO + ' If Not IsNothing(emailTo) Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_TO").ToString, emailTo) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices [emailTo] - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' Else + ' _Logger.Info("emailTo is still Nothing?!") + ' _step = "7.5" + ' End If - _Logger.Info("Now all email-items will be indexed!") + ' ' Dim subj As String = ClassFormFunctions.CleanInput(msg.Subject) + ' Dim subj As String = msg.Subject + ' If IsNothing(subj) Or subj = "" Then + ' _Logger.Info("msg subject is empty...DEFAULT will be set") + ' subj = "No subject" + ' MsgBox("Attention: Email was send without a subject - Default value 'No subject' will be used!", MsgBoxStyle.Exclamation) + ' Else + ' subj = ClassHelper.encode_utf8(msg.Subject) + ' If IsNothing(subj) Then + ' subj = msg.Subject + ' End If + ' End If - _Logger.Info("subj: " & subj) - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj) - CURRENT_MESSAGESUBJECT = subj - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices [Subject] - See log", MsgBoxStyle.Critical) - Return False - End If - _Logger.Info("MessageDeliveryTime: " & msg.MessageDeliveryTime) - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime) - CURRENT_MESSAGEDATE = msg.MessageDeliveryTime - If indexierung_erfolgreich = False Then - MsgBox("Error in SetEmailIndices [Datein] - See log", MsgBoxStyle.Critical) - Return False - End If - Else - indexierung_erfolgreich = False - End If + ' _Logger.Info("Now all email-items will be indexed!") - Return indexierung_erfolgreich - End If - Catch ex As Exception - ShowErrorMessage(ex, "SetEmailIndices") - Return False - End Try - End Function - Public Function GetUserEmailfromLDAP(ByVal userName As String) As String - - Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo" - Dim dommain As String = "com" '> Unexpected Error in GetUserEmail from LDAP: " & ex.Message) - _Logger.Error(ex) - End Try - End Using - - Return userEmail + ' _Logger.Info("subj: " & subj) + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj) + ' CURRENT_MESSAGESUBJECT = subj + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices [Subject] - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' _Logger.Info("MessageDeliveryTime: " & msg.MessageDeliveryTime) + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime) + ' CURRENT_MESSAGEDATE = msg.MessageDeliveryTime + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetEmailIndices [Datein] - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' Else + ' indexierung_erfolgreich = False + ' End If - End Function - Private Function SetAttachmentIndices() - Dim indexierung_erfolgreich As Boolean = True - Try - Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") - If DT.Rows.Count = 1 Then - - If Not CURRENT_MESSAGEID Is Nothing Then - If CURRENT_MESSAGEID <> "" Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetAttachmentIndices MESSAGE-ID - See log", MsgBoxStyle.Critical) - Return False - End If - End If - End If - 'Das Subject speichern - If CURRENT_MESSAGESUBJECT <> "" Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, CURRENT_MESSAGESUBJECT) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetAttachmentIndices SUBJECT - See log", MsgBoxStyle.Critical) - Return False - End If - End If - 'Das MesageDate speichern - If CURRENT_MESSAGEDATE <> "" Then - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, CURRENT_MESSAGEDATE) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetAttachmentIndices DATE - See log", MsgBoxStyle.Critical) - Return False - End If - End If - 'Kennzeichnen das es ein Anhang war! - indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_CHECK_ATTACHMENT").ToString, True) - If indexierung_erfolgreich = False Then - MsgBox("Error in SetAttachmentIndices ATTACHMENT Y/N - See log", MsgBoxStyle.Critical) - Return False - End If - Return indexierung_erfolgreich - End If - Catch ex As Exception - ShowErrorMessage(ex, "SetAttachmentIndices") - Return False - End Try + ' Return indexierung_erfolgreich + ' End If + ' Catch ex As Exception + ' ShowErrorMessage(ex, "SetEmailIndices") + ' Return False + ' End Try + 'End Function + + 'Public Function GetUserEmailfromLDAP(ByVal userName As String) As String + + ' Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo" + ' Dim dommain As String = "com" '> Unexpected Error in GetUserEmail from LDAP: " & ex.Message) + ' _Logger.Error(ex) + ' End Try + ' End Using + + ' Return userEmail + + 'End Function + 'Private Function SetAttachmentIndices() + ' Dim indexierung_erfolgreich As Boolean = True + ' Try + ' Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") + ' If DT.Rows.Count = 1 Then + + ' If Not CURRENT_MESSAGEID Is Nothing Then + ' If CURRENT_MESSAGEID <> "" Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetAttachmentIndices MESSAGE-ID - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' End If + ' End If + ' 'Das Subject speichern + ' If CURRENT_MESSAGESUBJECT <> "" Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, CURRENT_MESSAGESUBJECT) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetAttachmentIndices SUBJECT - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' End If + ' 'Das MesageDate speichern + ' If CURRENT_MESSAGEDATE <> "" Then + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, CURRENT_MESSAGEDATE) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetAttachmentIndices DATE - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' End If + ' 'Kennzeichnen das es ein Anhang war! + ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_CHECK_ATTACHMENT").ToString, True) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in SetAttachmentIndices ATTACHMENT Y/N - See log", MsgBoxStyle.Critical) + ' Return False + ' End If + ' Return indexierung_erfolgreich + ' End If + ' Catch ex As Exception + ' ShowErrorMessage(ex, "SetAttachmentIndices") + ' Return False + ' End Try - End Function + 'End Function Private Function SINGLEFILE_2_WINDREAM(_Objekttyp As String) As Boolean Try @@ -1402,25 +1412,25 @@ Public Class frmIndex Select Case CancelAttempts Case 0 If USER_LANGUAGE = LANG_DE Then - MsgBox("Bitte indexieren Sie die Datei vollständig!" & vbNewLine & "(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information) + MsgBox($"Bitte indexieren Sie die Datei vollständig!{vbNewLine}(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information) Else - MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information) + MsgBox($"Please Index file completely{vbNewLine}(Abort 1 of Indexdialog)", MsgBoxStyle.Information) End If CancelAttempts = CancelAttempts + 1 e.Cancel = True Case 1 Dim result As MsgBoxResult If USER_LANGUAGE = LANG_DE Then - result = MessageBox.Show("Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!" & vbNewLine & "Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) + result = MessageBox.Show($"Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!{vbNewLine}Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) Else - result = MessageBox.Show("You abort the indexdialog for the 2nd time!" & vbNewLine & "Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) + result = MessageBox.Show($"You abort the indexdialog for the 2nd time!{vbNewLine}Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) End If If result = MsgBoxResult.Yes Then Dim containsfw_file As Boolean = False Try ABORT_INDEXING = True - Dim sql As String = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')" + Dim sql As String = $"SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('{Environment.UserName}')" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True) Dim anz = DT.Rows.Count @@ -2225,7 +2235,7 @@ Public Class frmIndex Return utf8Encoding.GetString(encodedString) End Function - Private Function WORK_FILE() + Private Function WORK_FILE() As Boolean Try Me.VWDDINDEX_MANTableAdapter.Fill(Me.MyDataset.VWDDINDEX_MAN, CURRENT_DOKART_ID) _Logger.Debug("Manuelle Indexe geladen") @@ -2751,6 +2761,8 @@ Public Class frmIndex End If End If + EMAIL.Clear_TempFiles() + DocumentViewer1.CloseDocument() DocumentViewer1.Done() diff --git a/Global_Indexer/frmStart.vb b/Global_Indexer/frmStart.vb index 27e314b..5c6de5b 100644 --- a/Global_Indexer/frmStart.vb +++ b/Global_Indexer/frmStart.vb @@ -1,6 +1,5 @@ Imports System.IO Imports Microsoft.Office.Interop -Imports Independentsoft Imports DLLLicenseManager Imports System.Text Imports System.Globalization diff --git a/SetupVS19/Product.wxs b/SetupVS19/Product.wxs index b8e1ef8..b25d3e6 100644 --- a/SetupVS19/Product.wxs +++ b/SetupVS19/Product.wxs @@ -119,6 +119,9 @@ + + +