Leerer Betreff beim Ablegen Emails wird abgefangen - frmIndex

This commit is contained in:
OlgunR 2025-08-28 16:01:43 +02:00
parent 131383ff9d
commit b2242cb6a9

View File

@ -775,27 +775,28 @@ Public Class frmIndex
' Textboxen (TextEdit) ' Textboxen (TextEdit)
If oControl.Name.StartsWith("txt") Then If oControl.Name.StartsWith("txt") Then
Dim box As DevExpress.XtraEditors.TextEdit = DirectCast(oControl, DevExpress.XtraEditors.TextEdit) Dim oBox As DevExpress.XtraEditors.TextEdit = DirectCast(oControl, DevExpress.XtraEditors.TextEdit)
Dim indexName = Replace(box.Name, "txt", "") Dim oIndexName = Replace(oBox.Name, "txt", "")
Dim optionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{indexName}'") Dim oOptionalIndex As Boolean = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{oIndexName}'")
If String.IsNullOrWhiteSpace(box.Text) Then If String.IsNullOrWhiteSpace(oBox.Text) Then
If Not optionalIndex Then If Not oOptionalIndex Then
DxErrorProvider1.SetError(box, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN)) DxErrorProvider1.SetError(oBox, If(USER_LANGUAGE = LANG_DE, TEXT_MISSING_INPUT_DE, TEXT_MISSING_INPUT_EN))
box.Focus() oBox.Focus()
Return False Return False
End If End If
Indexwert_Postprocessing(indexName, "") Indexwert_Postprocessing(oIndexName, "")
Else Else
If Not Indexwert_checkValueDB(indexName, box.Text) Then If Not Indexwert_checkValueDB(oIndexName, oBox.Text) Then
Dim msg = If(USER_LANGUAGE = LANG_DE, Dim oMsg = If(USER_LANGUAGE = LANG_DE,
"Der eingegebene Wert wurde nicht in der Datenbank gefunden!", "Der eingegebene Wert wurde nicht in der Datenbank gefunden!",
"The value was not found in the Database!") "The value was not found in the Database!")
DxErrorProvider1.SetError(box, msg) DxErrorProvider1.SetError(oBox, oMsg)
box.Focus() oBox.Focus()
Return False Return False
End If End If
Indexwert_Postprocessing(indexName, box.Text) Indexwert_Postprocessing(oIndexName, oBox.Text)
_Logger.Debug($"Der Index: '{oIndexName}' wurde mit dem Wert '{oBox.Text}' beschrieben.")
End If End If
oResult = True oResult = True
Continue For Continue For
@ -878,6 +879,7 @@ Public Class frmIndex
Indexwert_Postprocessing(indexName, "") Indexwert_Postprocessing(indexName, "")
Else Else
Indexwert_Postprocessing(indexName, dtp.Text) Indexwert_Postprocessing(indexName, dtp.Text)
_Logger.Debug($"Der Index '{indexName}' wurde mit dem Wert '{dtp.Text}' beschrieben.")
End If End If
oResult = True oResult = True
Continue For Continue For
@ -1145,97 +1147,257 @@ Public Class frmIndex
End Try End Try
End Function End Function
'Private Function Write_Indizes() As Boolean
' Try
' _Logger.Info("Indexing file [{0}]", CURRENT_NEWFILENAME)
' Dim indexierung_erfolgreich As Boolean = False
' 'Manuelle Indexe Indexieren
' Dim DTMan As DataTable = MyDataset.VWDDINDEX_MAN
' If DTMan.Rows.Count > 0 Then
' Dim Count As Integer = 0
' For Each row As DataRow In DTMan.Rows
' Dim idxvalue = row.Item("Indexwert")
' Dim indexname = row.Item("WD_INDEX").ToString
' _Logger.Debug($"Write_Indizes - Index [{indexname}]...")
' Dim optional_Index = CBool(row.Item("OPTIONAL"))
' Dim indexiert = CBool(row.Item("Indexiert"))
' If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then
' If indexname <> String.Empty Then
' If row.Item("SAVE_VALUE") = True Then
' 'Den Indexwert zwischenspeichern
' Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS
' Dim rowexists As Boolean = False
' For Each rowTemp As DataRow In DTTemp.Rows
' 'Wenn bereits ein Eintrag existiert.....
' If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then
' rowexists = True
' '......überschreiben
' rowTemp.Item("Value") = row.Item("Indexwert")
' End If
' Next
' '.....ansonsten neu anlegen
' If rowexists = False Then
' Dim newRow As DataRow = DTTemp.NewRow()
' newRow("Dokumentart") = row.Item("DOKUMENTART").ToString
' newRow("Indexname") = row.Item("INDEXNAME").ToString
' newRow("Value") = row.Item("Indexwert")
' DTTemp.Rows.Add(newRow)
' End If
' End If
' _Logger.Debug($"Manueller Indexvalue [{idxvalue}]...NOW THE INDEXING...")
' Count += 1
' ' den Typ des Zielindexes auslesen
' Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname)
' _Logger.Debug($"oIndexType [{oIndexType}]...")
' If oIndexType = 0 Then
' MsgBox("Could not get the windream-indextype. Check Your Configuration", MsgBoxStyle.Information, "Attention")
' Return False
' End If
' If oIndexType > 4095 Then
' _Logger.Debug($"Indexing Vektor - oIndexType [{oIndexType}] ...")
' Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR)
' Dim oListofString As New List(Of String)
' 'If oSplitArray.Length <= 1 Then
' ' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
' 'Else
' For Each oStr In oSplitArray
' oListofString.Add(oStr)
' Next
' indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE)
' 'End If
' Else
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
' End If
' 'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue)
' If indexierung_erfolgreich = False Then
' MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical)
' Return False
' Exit For
' End If
' Else
' _Logger.Debug("No Indexing: indexname: " & indexname)
' _Logger.Debug("No Indexing: is optional? " & optional_Index.ToString)
' End If
' Else
' _Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname)
' _Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname)
' End If
' Next
' End If
' 'Automatische Indexe Indexieren
' Dim DTAut As DataTable = MyDataset.VWDDINDEX_AUTOM
' If DTAut.Rows.Count > 0 Then
' _Logger.Debug(" #### Es gibt automatische Atrribute - Anzahl: " & DTAut.Rows.Count.ToString & " #####")
' Dim Count As Integer = 0
' For Each row As DataRow In DTAut.Rows
' Dim oIsIndexed = CBool(row.Item("Indexiert"))
' Dim oIndexValue = row.Item("Indexwert").ToString
' Dim oIndexName = row.Item("INDEXNAME").ToString
' Dim oOverwrite As Boolean = row.ItemEx("VKT_OVERWRITE", False)
' Dim oPreventMultipleValues As Boolean = row.ItemEx("VKT_PREVENT_MULTIPLE_VALUES", False)
' If oIsIndexed = True And oIndexValue <> "" Then
' If oIndexValue <> "EMPTY_OI" Then
' _Logger.Info("Auto Indexname: " & oIndexName.ToString)
' _Logger.Info("Indexvalue: " & oIndexValue.ToString)
' Count += 1
' ' den Typ des Zielindexes auslesen
' Dim oIndexType As Integer = WINDREAM.GetIndexType(oIndexName)
' _Logger.Debug("WMIndexType: " & oIndexType.ToString)
' If oIndexType > 4095 Then
' _Logger.Debug("Es Handelt sich um einen VektorIndex...")
' Dim oExistingItems = WINDREAM.GetIndexValue(CURRENT_NEWFILENAME, oIndexName)
' Dim oSplitArray = Split(oIndexValue, ClassConstants.VECTORSEPARATOR)
' Dim oListofString As New List(Of String)
' If oSplitArray.Length = 0 Then
' _Logger.Debug("oSplitArray.Length = 0")
' oListofString.Add(oIndexValue)
' Else
' _Logger.Debug("oSplitArray is > 0 ...")
' For Each oStr In oSplitArray
' _Logger.Debug("oSplitArray - oStr: {0}", oStr)
' oListofString.Add(oStr)
' Next
' End If
' 'If oSplitArray.Length <= 1 Then
' ' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
' 'Else
' If oOverwrite = False And oExistingItems.Count > 0 And oIndexType <> 4100 Then
' _Logger.Debug("oOverwrite = False and WMObject already contains [{0}] values in attribute,Values will be concatted", oExistingItems.Count)
' oListofString = oExistingItems.Concat(oListofString).ToList()
' End If
' If oPreventMultipleValues = True Then
' _Logger.Debug("Preventing multiple values in Vektor")
' oListofString = oListofString.Distinct().ToList()
' End If
' indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, oIndexName, oListofString, CURR_DOKART_OBJECTTYPE)
' 'End If
' Else
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
' End If
' 'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE)
' If indexierung_erfolgreich = False Then
' MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical)
' Return False
' Exit For
' End If
' End If
' End If
' Next
' End If
' If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".MSG") Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".EML") Then
' indexierung_erfolgreich = SetEmailIndicies(False)
' If indexierung_erfolgreich = False Then
' MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
' Return False
' End If
' ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
' indexierung_erfolgreich = SetEmailIndicies(True)
' If indexierung_erfolgreich = False Then
' MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
' Return False
' End If
' End If
' Catch ex As Exception
' ShowErrorMessage(ex, "Write_Indizes")
' Return False
' Finally
' End Try
' Return True
'End Function
Private Function Write_Indizes() As Boolean Private Function Write_Indizes() As Boolean
Try Try
_Logger.Info("Starting indexing for file [{0}] (DropType = {1})", CURRENT_NEWFILENAME, DropType)
_Logger.Info("Indexing file [{0}]", CURRENT_NEWFILENAME)
Dim indexierung_erfolgreich As Boolean = False Dim indexierung_erfolgreich As Boolean = False
'Manuelle Indexe Indexieren
' ----------------------
' Manuelle Indizes
' ----------------------
Dim DTMan As DataTable = MyDataset.VWDDINDEX_MAN Dim DTMan As DataTable = MyDataset.VWDDINDEX_MAN
If DTMan.Rows.Count > 0 Then If DTMan.Rows.Count > 0 Then
Dim Count As Integer = 0 _Logger.Info("Processing {0} manual indexes...", DTMan.Rows.Count)
For Each row As DataRow In DTMan.Rows For Each row As DataRow In DTMan.Rows
Dim idxvalue = row.Item("Indexwert") Dim idxvalue = row.Item("Indexwert")
Dim indexname = row.Item("WD_INDEX").ToString Dim indexname = row.Item("WD_INDEX").ToString
_Logger.Debug($"Write_Indizes - Index [{indexname}]...")
Dim optional_Index = CBool(row.Item("OPTIONAL")) Dim optional_Index = CBool(row.Item("OPTIONAL"))
Dim indexiert = CBool(row.Item("Indexiert")) Dim indexiert = CBool(row.Item("Indexiert"))
If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then
If indexiert AndAlso Not String.IsNullOrEmpty(idxvalue.ToString) AndAlso idxvalue <> "EMPTY_OI" Then
If indexname <> String.Empty Then If indexname <> String.Empty Then
_Logger.Debug("Manual Index: [{0}] Value: [{1}]", indexname, idxvalue)
' Zwischenspeichern falls SAVE_VALUE
If row.Item("SAVE_VALUE") = True Then If row.Item("SAVE_VALUE") = True Then
'Den Indexwert zwischenspeichern
Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS
Dim rowexists As Boolean = False Dim rowexists As Boolean = DTTemp.Rows.Cast(Of DataRow)().Any(Function(r) r.Item("Dokumentart") = row.Item("DOKUMENTART") AndAlso r.Item("Indexname") = row.Item("INDEXNAME"))
For Each rowTemp As DataRow In DTTemp.Rows If rowexists Then
'Wenn bereits ein Eintrag existiert..... DTTemp.Rows.Cast(Of DataRow)().First(Function(r) r.Item("Dokumentart") = row.Item("DOKUMENTART") AndAlso r.Item("Indexname") = row.Item("INDEXNAME")).Item("Value") = idxvalue
If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then Else
rowexists = True
'......überschreiben
rowTemp.Item("Value") = row.Item("Indexwert")
End If
Next
'.....ansonsten neu anlegen
If rowexists = False Then
Dim newRow As DataRow = DTTemp.NewRow() Dim newRow As DataRow = DTTemp.NewRow()
newRow("Dokumentart") = row.Item("DOKUMENTART").ToString newRow("Dokumentart") = row.Item("DOKUMENTART").ToString
newRow("Indexname") = row.Item("INDEXNAME").ToString newRow("Indexname") = row.Item("INDEXNAME").ToString
newRow("Value") = row.Item("Indexwert") newRow("Value") = idxvalue
DTTemp.Rows.Add(newRow) DTTemp.Rows.Add(newRow)
End If End If
End If End If
_Logger.Debug($"Manueller Indexvalue [{idxvalue}]...NOW THE INDEXING...") ' Indextyp prüfen
Count += 1
' den Typ des Zielindexes auslesen
Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname) Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname)
_Logger.Debug($"oIndexType [{oIndexType}]...")
If oIndexType = 0 Then If oIndexType = 0 Then
LOGGER.Error("Could not get the Windream index type for [{0}]. Check configuration.", indexname)
MsgBox("Could not get the windream-indextype. Check Your Configuration", MsgBoxStyle.Information, "Attention") MsgBox("Could not get the windream-indextype. Check Your Configuration", MsgBoxStyle.Information, "Attention")
Return False Return False
End If End If
If oIndexType > 4095 Then
_Logger.Debug($"Indexing Vektor - oIndexType [{oIndexType}] ...")
Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR)
Dim oListofString As New List(Of String)
'If oSplitArray.Length <= 1 Then
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
'Else
For Each oStr In oSplitArray
oListofString.Add(oStr)
Next
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE)
'End If
' Vektor oder normal
If oIndexType > 4095 Then
_Logger.Debug("Index [{0}] is a vector type.", indexname)
Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR)
Dim oListOfString As New List(Of String)(oSplitArray)
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, indexname, oListOfString, CURR_DOKART_OBJECTTYPE)
Else Else
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE) indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE)
End If End If
'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue)
If indexierung_erfolgreich = False Then If indexierung_erfolgreich = False Then
LOGGER.Error("Failed to index manual field [{0}] with value [{1}]", indexname, idxvalue)
MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical) MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical)
Return False Return False
Exit For
End If End If
Else Else
_Logger.Warn("Skipping manual index: Indexname empty. Optional: {0}", optional_Index)
_Logger.Debug("No Indexing: indexname: " & indexname)
_Logger.Debug("No Indexing: is optional? " & optional_Index.ToString)
End If End If
Else Else
_Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname) _Logger.Debug("Skipping manual index [{0}] - value empty or not indexed.", indexname)
_Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname)
End If End If
Next Next
Else
_Logger.Debug("No manual indexes to process.")
End If End If
'Automatische Indexe Indexieren
' ----------------------
' Automatische Indizes
' ----------------------
Dim DTAut As DataTable = MyDataset.VWDDINDEX_AUTOM Dim DTAut As DataTable = MyDataset.VWDDINDEX_AUTOM
If DTAut.Rows.Count > 0 Then If DTAut.Rows.Count > 0 Then
_Logger.Debug(" #### Es gibt automatische Atrribute - Anzahl: " & DTAut.Rows.Count.ToString & " #####") _Logger.Info("Processing {0} automatic indexes...", DTAut.Rows.Count)
Dim Count As Integer = 0
For Each row As DataRow In DTAut.Rows For Each row As DataRow In DTAut.Rows
Dim oIsIndexed = CBool(row.Item("Indexiert")) Dim oIsIndexed = CBool(row.Item("Indexiert"))
Dim oIndexValue = row.Item("Indexwert").ToString Dim oIndexValue = row.Item("Indexwert").ToString
@ -1243,81 +1405,70 @@ Public Class frmIndex
Dim oOverwrite As Boolean = row.ItemEx("VKT_OVERWRITE", False) Dim oOverwrite As Boolean = row.ItemEx("VKT_OVERWRITE", False)
Dim oPreventMultipleValues As Boolean = row.ItemEx("VKT_PREVENT_MULTIPLE_VALUES", False) Dim oPreventMultipleValues As Boolean = row.ItemEx("VKT_PREVENT_MULTIPLE_VALUES", False)
If oIsIndexed = True And oIndexValue <> "" Then If oIsIndexed AndAlso Not String.IsNullOrEmpty(oIndexValue) AndAlso oIndexValue <> "EMPTY_OI" Then
If oIndexValue <> "EMPTY_OI" Then _Logger.Info("Automatic Index: [{0}] Value: [{1}]", oIndexName, oIndexValue)
_Logger.Info("Auto Indexname: " & oIndexName.ToString) Dim oIndexType As Integer = WINDREAM.GetIndexType(oIndexName)
_Logger.Info("Indexvalue: " & oIndexValue.ToString) _Logger.Debug("WMIndexType for [{0}] = {1}", oIndexName, oIndexType)
Count += 1
' den Typ des Zielindexes auslesen If oIndexType > 4095 Then
Dim oIndexType As Integer = WINDREAM.GetIndexType(oIndexName) _Logger.Debug("Index [{0}] is a vector type.", oIndexName)
_Logger.Debug("WMIndexType: " & oIndexType.ToString) Dim oExistingItems = WINDREAM.GetIndexValue(CURRENT_NEWFILENAME, oIndexName)
If oIndexType > 4095 Then Dim oSplitArray = Split(oIndexValue, ClassConstants.VECTORSEPARATOR)
_Logger.Debug("Es Handelt sich um einen VektorIndex...") Dim oListOfString As New List(Of String)(oSplitArray)
Dim oExistingItems = WINDREAM.GetIndexValue(CURRENT_NEWFILENAME, oIndexName)
Dim oSplitArray = Split(oIndexValue, ClassConstants.VECTORSEPARATOR) If Not oOverwrite AndAlso oExistingItems.Count > 0 AndAlso oIndexType <> 4100 Then
Dim oListofString As New List(Of String) oListOfString = oExistingItems.Concat(oListOfString).ToList()
If oSplitArray.Length = 0 Then _Logger.Debug("Concatenated existing values for vector index [{0}]", oIndexName)
_Logger.Debug("oSplitArray.Length = 0")
oListofString.Add(oIndexValue)
Else
_Logger.Debug("oSplitArray is > 0 ...")
For Each oStr In oSplitArray
_Logger.Debug("oSplitArray - oStr: {0}", oStr)
oListofString.Add(oStr)
Next
End If
'If oSplitArray.Length <= 1 Then
' indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
'Else
If oOverwrite = False And oExistingItems.Count > 0 And oIndexType <> 4100 Then
_Logger.Debug("oOverwrite = False and WMObject already contains [{0}] values in attribute,Values will be concatted", oExistingItems.Count)
oListofString = oExistingItems.Concat(oListofString).ToList()
End If
If oPreventMultipleValues = True Then
_Logger.Debug("Preventing multiple values in Vektor")
oListofString = oListofString.Distinct().ToList()
End If
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, oIndexName, oListofString, CURR_DOKART_OBJECTTYPE)
'End If
Else
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
End If End If
'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) If oPreventMultipleValues Then
If indexierung_erfolgreich = False Then oListOfString = oListOfString.Distinct().ToList()
MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical) _Logger.Debug("Removed duplicate values for vector index [{0}]", oIndexName)
Return False
Exit For
End If End If
indexierung_erfolgreich = WINDREAM.SetFileIndexLoS(CURRENT_NEWFILENAME, oIndexName, oListOfString, CURR_DOKART_OBJECTTYPE)
Else
indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, oIndexName, oIndexValue, CURR_DOKART_OBJECTTYPE)
End If
If Not indexierung_erfolgreich Then
LOGGER.Error("Failed to index automatic field [{0}] with value [{1}]", oIndexName, oIndexValue)
MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical)
Return False
End If End If
End If End If
Next Next
Else
_Logger.Debug("No automatic indexes to process.")
End If End If
' ----------------------
' E-Mail Indexing
' ----------------------
If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".MSG") Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".EML") Then If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".MSG") Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".EML") Then
_Logger.Info("Indexing email content for main email.")
indexierung_erfolgreich = SetEmailIndicies(False) indexierung_erfolgreich = SetEmailIndicies(False)
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
Return False
End If
ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then
_Logger.Info("Indexing email content for attachment.")
indexierung_erfolgreich = SetEmailIndicies(True) indexierung_erfolgreich = SetEmailIndicies(True)
If indexierung_erfolgreich = False Then
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
Return False
End If
End If End If
If Not indexierung_erfolgreich Then
LOGGER.Error("SetEmailIndices failed. See previous logs.")
MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical)
Return False
End If
_Logger.Info("Indexing completed successfully for file [{0}].", CURRENT_NEWFILENAME)
Return True
Catch ex As Exception Catch ex As Exception
ShowErrorMessage(ex, "Write_Indizes") ShowErrorMessage(ex, "Write_Indizes")
LOGGER.Error(ex, "Unexpected exception in Write_Indizes for file [{0}]", CURRENT_NEWFILENAME)
Return False Return False
Finally
End Try End Try
Return True
End Function End Function
Private Function WriteIndex2File(pIndexName As String, pIndexValue As String) Private Function WriteIndex2File(pIndexName As String, pIndexValue As String)
Try Try
_Logger.Info($"Indexing with Name {pIndexName} and Value: {pIndexValue}") _Logger.Info($"Indexing with Name {pIndexName} and Value: {pIndexValue}")
@ -1328,6 +1479,122 @@ Public Class frmIndex
End Try End Try
End Function End Function
'Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean
' Try
' Dim oIndexNames As Dictionary(Of String, Object)
' Dim oSQL As String = $"SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '{CURR_DOKART_OBJECTTYPE}'"
' Dim oTable As DataTable = DATABASE_ECM.GetDatatable(oSQL)
' If IsNothing(oTable) Then
' _Logger.Info("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
' Return False
' End If
' If oTable.Rows.Count = 0 Then
' LOGGER.Warn("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
' MsgBox($"Definition von Email Indizes für den Objekttyp [{oTable}] fehlt." + vbNewLine + "Bitte informieren Sie Ihren Systembetreuer.", MsgBoxStyle.Critical)
' Return False
' End If
' If oTable.Rows.Count > 1 Then
' LOGGER.Warn("Got multiple rows for Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE)
' Return False
' End If
' Dim oRow As DataRow = oTable.Rows.Item(0)
' ' If file is an email files (eml,msg) parse it to extract email data and save for later
' ' If file is an attachment, rely on the previously extracted value
' If pIndexAttachment = False Then
' LOGGER.Debug("Indexing Email File: [{0}]", CURRENT_NEWFILENAME)
' ' This cannot use Path.Combine, otherwise the WINDREAM_BASEPATH will be swallowed... lol
' 'Dim oMsgFilePath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME)
' Dim oMsgFilePath As String = CURRENT_NEWFILENAME
' If CURRENT_NEWFILENAME.StartsWith(WINDREAM_BASEPATH) = False Then
' oMsgFilePath = WINDREAM_BASEPATH & oMsgFilePath
' End If
' Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath)
' Dim oMessageId As String = oMail.MessageID
' LOGGER.Debug("MessageId: [{0}]", oMessageId)
' Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail)
' Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail)
' LOGGER.Debug("oMessageTo: [{0}]", oMessageTo.ToString)
' Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail)
' LOGGER.Debug("oDateIn: [{0}]", oDateIn.ToString)
' Dim oSubject As String = oMail.Subject
' LOGGER.Debug("oSubject: [{0}]", oSubject)
' CURRENT_MESSAGEID = oMessageId
' CURRENT_MESSAGEDATE = oDateIn
' If oSubject IsNot Nothing Then
' CURRENT_MESSAGESUBJECT = oSubject
' Else
' CURRENT_MESSAGESUBJECT = "<No Subject>"
' LOGGER.Info("No subject - Default <No Subject> will be used!")
' End If
' oIndexNames = New Dictionary(Of String, Object) From {
' {"IDX_EMAIL_ID", oMessageId},
' {"IDX_EMAIL_FROM", oMessageFrom},
' {"IDX_EMAIL_TO", oMessageTo},
' {"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
' {"IDX_EMAIL_DATE_IN", oDateIn}
' }
' Else
' oIndexNames = New Dictionary(Of String, Object) From {
' {"IDX_EMAIL_ID", CURRENT_MESSAGEID},
' {"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
' {"IDX_EMAIL_DATE_IN", CURRENT_MESSAGEDATE},
' {"IDX_CHECK_ATTACHMENT", True}
' }
' End If
' For Each oIndex In oIndexNames
' Try
' If oIndex.Value Is Nothing Then
' LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key)
' Continue For
' 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)
' Continue For
' End If
' Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value)
' If oIndexingSuccessful = False Then
' 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
' Next
' Return True
' Catch ex As Exception
' LOGGER.Error(ex)
' Return False
' End Try
'End Function
Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean
Try Try
Dim oIndexNames As Dictionary(Of String, Object) Dim oIndexNames As Dictionary(Of String, Object)
@ -1336,51 +1603,50 @@ Public Class frmIndex
Dim oTable As DataTable = DATABASE_ECM.GetDatatable(oSQL) Dim oTable As DataTable = DATABASE_ECM.GetDatatable(oSQL)
If IsNothing(oTable) Then If IsNothing(oTable) Then
_Logger.Info("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE) LOGGER.Error("Database returned NULL for Email Indicies query (OBJECTTYPE = [{0}]).", CURR_DOKART_OBJECTTYPE)
Return False Return False
End If End If
If oTable.Rows.Count = 0 Then If oTable.Rows.Count = 0 Then
LOGGER.Warn("Could not get Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE) LOGGER.Warn("No Email Indicies defined for OBJECTTYPE = [{0}].", CURR_DOKART_OBJECTTYPE)
MsgBox($"Definition von Email Indizes für den Objekttyp [{oTable}] fehlt." + vbNewLine + "Bitte informieren Sie Ihren Systembetreuer.", MsgBoxStyle.Critical) MsgBox($"Definition von Email Indizes für den Objekttyp [{CURR_DOKART_OBJECTTYPE}] fehlt." + vbNewLine + "Bitte informieren Sie Ihren Systembetreuer.", MsgBoxStyle.Critical)
Return False Return False
End If End If
If oTable.Rows.Count > 1 Then If oTable.Rows.Count > 1 Then
LOGGER.Warn("Got multiple rows for Email Indicies for OBJECTTYPE = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE) LOGGER.Warn("Multiple Email Indicies definitions found for OBJECTTYPE = [{0}]. Using none and exiting.", CURR_DOKART_OBJECTTYPE)
Return False Return False
End If End If
Dim oRow As DataRow = oTable.Rows.Item(0) Dim oRow As DataRow = oTable.Rows.Item(0)
' If file is an email files (eml,msg) parse it to extract email data and save for later
' If file is an attachment, rely on the previously extracted value
If pIndexAttachment = False Then If pIndexAttachment = False Then
LOGGER.Debug("Indexing Email File: [{0}]", CURRENT_NEWFILENAME) LOGGER.Info("Indexing main Email file for OBJECTTYPE = [{0}].", CURR_DOKART_OBJECTTYPE)
LOGGER.Debug("Original filename: [{0}]", CURRENT_NEWFILENAME)
' This cannot use Path.Combine, otherwise the WINDREAM_BASEPATH will be swallowed... lol
'Dim oMsgFilePath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME)
Dim oMsgFilePath As String = CURRENT_NEWFILENAME Dim oMsgFilePath As String = CURRENT_NEWFILENAME
If CURRENT_NEWFILENAME.StartsWith(WINDREAM_BASEPATH) = False Then If CURRENT_NEWFILENAME.StartsWith(WINDREAM_BASEPATH) = False Then
oMsgFilePath = WINDREAM_BASEPATH & oMsgFilePath oMsgFilePath = WINDREAM_BASEPATH & oMsgFilePath
End If End If
LOGGER.Debug("Email file path: [{0}]", oMsgFilePath)
Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath) Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath)
LOGGER.Debug($"Load Email from path: {oMail}")
Dim oMessageId As String = oMail.MessageID Dim oMessageId As String = oMail.MessageID
LOGGER.Debug("MessageId: [{0}]", oMessageId) LOGGER.Debug($"MessageId: {oMessageId}")
Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail) Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail)
LOGGER.Debug($"MessageForm: {oMessageFrom}")
Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail) Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail)
LOGGER.Debug("oMessageTo: [{0}]", oMessageTo.ToString) LOGGER.Debug($"Receiver: {oMessageTo}")
Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail) Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail)
LOGGER.Debug("oDateIn: [{0}]", oDateIn.ToString) LOGGER.Debug($"Date: {oDateIn}")
Dim oSubject As String = oMail.Subject Dim oSubject As String = oMail.Subject
LOGGER.Debug("oSubject: [{0}]", oSubject) LOGGER.Debug($"Subject: {oSubject}")
LOGGER.Debug("Extracted Email fields → ID=[{0}], From=[{1}], To=[{2}], Date=[{3}], Subject=[{4}]",
oMessageId, oMessageFrom, oMessageTo, oDateIn, oSubject)
CURRENT_MESSAGEID = oMessageId CURRENT_MESSAGEID = oMessageId
CURRENT_MESSAGEDATE = oDateIn CURRENT_MESSAGEDATE = oDateIn
@ -1389,61 +1655,63 @@ Public Class frmIndex
CURRENT_MESSAGESUBJECT = oSubject CURRENT_MESSAGESUBJECT = oSubject
Else Else
CURRENT_MESSAGESUBJECT = "<No Subject>" CURRENT_MESSAGESUBJECT = "<No Subject>"
LOGGER.Info("No subject - Default <No Subject> will be used!") LOGGER.Info("Email has no subject. Using default '<No Subject>'.")
End If End If
oIndexNames = New Dictionary(Of String, Object) From { oIndexNames = New Dictionary(Of String, Object) From {
{"IDX_EMAIL_ID", oMessageId}, {"IDX_EMAIL_ID", oMessageId},
{"IDX_EMAIL_FROM", oMessageFrom}, {"IDX_EMAIL_FROM", oMessageFrom},
{"IDX_EMAIL_TO", oMessageTo}, {"IDX_EMAIL_TO", oMessageTo},
{"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT}, {"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
{"IDX_EMAIL_DATE_IN", oDateIn} {"IDX_EMAIL_DATE_IN", oDateIn}
} }
Else Else
oIndexNames = New Dictionary(Of String, Object) From { LOGGER.Info("Indexing Email attachment for OBJECTTYPE = [{0}].", CURR_DOKART_OBJECTTYPE)
{"IDX_EMAIL_ID", CURRENT_MESSAGEID},
{"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
{"IDX_EMAIL_DATE_IN", CURRENT_MESSAGEDATE},
{"IDX_CHECK_ATTACHMENT", True}
}
End If
oIndexNames = New Dictionary(Of String, Object) From {
{"IDX_EMAIL_ID", CURRENT_MESSAGEID},
{"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT},
{"IDX_EMAIL_DATE_IN", CURRENT_MESSAGEDATE},
{"IDX_CHECK_ATTACHMENT", True}
}
End If
For Each oIndex In oIndexNames For Each oIndex In oIndexNames
Try Try
If oIndex.Value Is Nothing Then If oIndex.Value Is Nothing Then
LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) LOGGER.Warn("Skipping Index [{0}] because value was NULL.", oIndex.Key)
Continue For Continue For
End If End If
If TypeOf oIndex.Value Is String AndAlso oIndex.Value = String.Empty Then If TypeOf oIndex.Value Is String AndAlso oIndex.Value = String.Empty Then
LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) LOGGER.Warn("Skipping Index [{0}] because value was empty.", oIndex.Key)
Continue For Continue For
End If End If
Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value) Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value)
If oIndexingSuccessful = False Then If oIndexingSuccessful = False Then
LOGGER.Error("Indexing failed at Index [{0}] with value [{1}].", oIndex.Key, oIndex.Value)
MsgBox($"Error while Indexing Email at Index [{oIndex.Key}]", MsgBoxStyle.Critical) MsgBox($"Error while Indexing Email at Index [{oIndex.Key}]", MsgBoxStyle.Critical)
Return False Return False
End If End If
LOGGER.Debug("Index [{0}] successfully written with value [{1}].", oIndex.Key, oIndex.Value)
Catch ex As Exception Catch ex As Exception
LOGGER.Warn("Error while Indexing Email at Index [{0}]", oIndex.Key) LOGGER.Error(ex, "Exception while indexing Email at Index [{0}].", oIndex.Key)
LOGGER.Error(ex)
Return False Return False
End Try End Try
Next Next
LOGGER.Info("Successfully indexed Email (OBJECTTYPE = [{0}]).", CURR_DOKART_OBJECTTYPE)
Return True Return True
Catch ex As Exception Catch ex As Exception
LOGGER.Error(ex) LOGGER.Error(ex, "Unexpected exception in SetEmailIndicies.")
Return False Return False
End Try End Try
End Function End Function
'Private Function SetEmailIndicesOld() 'Private Function SetEmailIndicesOld()
' Dim indexierung_erfolgreich As Boolean = False ' Dim indexierung_erfolgreich As Boolean = False
' Dim _step As String = "1" ' Dim _step As String = "1"