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

Version 2.4.2.2 - Remove Independentsoft Email, Replace with Limilabs.Mail, Remove manual Email Data Exctraction, Support Eml Files

Browse Source
This commit is contained in:
Jonathan Jenne 2021-08-23 10:47:04 +02:00
parent 3da7e37c91
commit 0704b07de7
11 changed files with 604 additions and 580 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

179
Global_Indexer/ClassEmailHeaderExtractor.vb
View File

@ -1,106 +1,105 @@
Imports Independentsoft
Imports Limilabs.Mail
Imports Limilabs.Mail
Imports Limilabs.Mail.MSG
Imports System.Text.RegularExpressions
Public Class ClassEmailHeaderExtractor
''' <summary>
''' Extrahiert die Headerinformationen aus einem msg Objekt mithilfe der MSG.NET Klasse
''' </summary>
''' <param name="msg">Eine Email vom Typ Msg.Message</param>
''' <returns>Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist.</returns>
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
'''' <summary>
'''' Extrahiert die Headerinformationen aus einem msg Objekt mithilfe der MSG.NET Klasse
'''' </summary>
'''' <param name="msg">Eine Email vom Typ Msg.Message</param>
'''' <returns>Headerinformationen als String oder Nothing wenn ein Fehler aufgetreten ist.</returns>
'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
''' <summary>
''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Absenderadresse.
''' </summary>
''' <param name="messageHeaders">Headerinformationen die von getMessageHeaders erzeugt wurden.</param>
''' <param name="RegexList">Eine Liste von Regular Expressions</param>
''' <param name="RegexGroup">Die Ergebnisgruppe, die die Adresse enthält</param>
''' <returns>Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte.</returns>
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
'''' <summary>
'''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Absenderadresse.
'''' </summary>
'''' <param name="messageHeaders">Headerinformationen die von getMessageHeaders erzeugt wurden.</param>
'''' <param name="RegexList">Eine Liste von Regular Expressions</param>
'''' <param name="RegexGroup">Die Ergebnisgruppe, die die Adresse enthält</param>
'''' <returns>Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte.</returns>
'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
''' <summary>
''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Empfängeradresse.
''' </summary>
''' <param name="messageHeaders">Headerinformationen die von getMessageHeaders erzeugt wurden.</param>
''' <param name="RegexList">Eine Liste von Regular Expressions</param>
''' <param name="RegexGroup">Die Ergebnisgruppe, die die Adresse enthält</param>
''' <returns>Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte.</returns>
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
'''' <summary>
'''' Extrahiert aus den Headerinformationen anhand einer Liste von Regular Expressions eine Empfängeradresse.
'''' </summary>
'''' <param name="messageHeaders">Headerinformationen die von getMessageHeaders erzeugt wurden.</param>
'''' <param name="RegexList">Eine Liste von Regular Expressions</param>
'''' <param name="RegexGroup">Die Ergebnisgruppe, die die Adresse enthält</param>
'''' <returns>Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte.</returns>
'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

175
Global_Indexer/ClassFilehandle.vb
View File

@ -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)
'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
' 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")
' '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 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
' 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)
' 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
' 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)

1
Global_Indexer/ClassFolderWatcher.vb
View File

@ -1,5 +1,4 @@
Imports System.IO
Imports Independentsoft
Imports System.Threading
Public Class ClassFolderWatcher

2
Global_Indexer/ClassInit.vb
View File

@ -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

7
Global_Indexer/Global_Indexer.vbproj
View File

@ -189,10 +189,6 @@
<SpecificVersion>False</SpecificVersion>
<HintPath>P:\Visual Studio Projekte\Bibliotheken\DLLLicenseManager.dll</HintPath>
</Reference>
<Reference Include="Independentsoft.Msg, Version=2.0.570.21482, Culture=neutral, PublicKeyToken=76be97fe952f1ec7, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>P:\Visual Studio Projekte\Bibliotheken\MSG .NET\Bin\22_11_19\Independentsoft.Msg.dll</HintPath>
</Reference>
<Reference Include="Interop.WINDREAMLib">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\windream\Interop.WINDREAMLib.dll</HintPath>
<EmbedInteropTypes>False</EmbedInteropTypes>
@ -780,6 +776,9 @@
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</Content>
<Content Include="globe_handdrawn.ico" />
<Content Include="MailLicense.xml">
<CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>
</Content>
<Content Include="Resources\DD_Icons_ICO_GLOBIX_1.ico" />
<None Include="Resources\itemtypechecked.svg" />
<None Include="Resources\trackingchanges_next.svg" />

23
Global_Indexer/MailLicense.xml Normal file
View File

@ -0,0 +1,23 @@
<?xml version="1.0" encoding="utf-8"?>
<License>
<Id>4dc5ef40-f1a9-468b-994c-b7ed600ad878</Id>
<ProductName>Mail.dll</ProductName>
<SubscriptionUntil>2022-07-29</SubscriptionUntil>
<RegisteredTo>Digital Data GmbH</RegisteredTo>
<LicenseType>single developer</LicenseType>
<BuyerName>Digital Data GmbH</BuyerName>
<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
<SignedInfo>
<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />
<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />
<Reference URI="">
<Transforms>
<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />
</Transforms>
<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />
<DigestValue>75MRtl4ipYelIZYlpT8O7QDX9Zc=</DigestValue>
</Reference>
</SignedInfo>
<SignatureValue>Raxfkz6DfQVs/sMvH+F2nH0eHXD8FoUFSdP3t7AgBUdpABJQx86srlyuMSEhXPlc1THCqPouEVob4RsWnd9OXvTiPPSOUSK9zuNG6uz93KLAhpSD5PraAgBCF4jwZArlAp7aCNfZpHqQ3w6TRHS+CfravUU0AHHG3MZ1ZcRkGuo=</SignatureValue>
</Signature>
</License>

2
Global_Indexer/My Project/AssemblyInfo.vb
View File

@ -33,7 +33,7 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("2.4.2.1")>
<Assembly: AssemblyVersion("2.4.2.2")>
<Assembly: AssemblyFileVersion("1.0.0.0")>
<Assembly: NeutralResourcesLanguageAttribute("")>

7
Global_Indexer/frmConfig_Basic.vb
View File

@ -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

784
Global_Indexer/frmIndex.vb
View File

@ -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"
'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"
' 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 = ""
' '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)
' ' 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
' 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
' 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)
' 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)
' 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)
' 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
' '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"
' 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
' If Not IsNothing(emailFrom) Then
' emailFrom = emailFrom.Replace("<", "")
' emailFrom = emailFrom.Replace(">", "")
' Else
' _step = "6.1.x"
' _Logger.Info("emailFrom is Nothing?!")
' 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
' 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("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
' _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
_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("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
' 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
' ' 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("Now all email-items will be indexed!")
' _Logger.Info("Now all email-items will be indexed!")
_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("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
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
' Return indexierung_erfolgreich
' End If
' Catch ex As Exception
' ShowErrorMessage(ex, "SetEmailIndices")
' Return False
' End Try
'End Function
Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo"
Dim dommain As String = "com" '<change this value to your actual domain region. For example: "com" as in "yahoo.com"
'Public Function GetUserEmailfromLDAP(ByVal userName As String) As String
Dim path As String = String.Format("LDAP://CN=User,DC={0}", domainName)
Dim userEmail As String = String.Empty
' Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo"
' Dim dommain As String = "com" '<change this value to your actual domain region. For example: "com" as in "yahoo.com"
Using search As DirectorySearcher = New DirectorySearcher(path)
Dim result As SearchResult
Try
search.Filter = "(SAMAccountName=" & userName & ")"
search.PropertiesToLoad.Add("mail")
result = search.FindOne()
Catch ex As Exception
_Logger.Error(ex)
search.Filter = ""
search.Filter = "(GivenName=" & userName & ")"
search.PropertiesToLoad.Add("mail")
End Try
' Dim path As String = String.Format("LDAP://CN=User,DC={0}", domainName)
' Dim userEmail As String = String.Empty
Try
result = search.FindOne()
If result IsNot Nothing Then userEmail = result.Properties("mail").ToString
Catch ex As Exception
_Logger.Info(">> Unexpected Error in GetUserEmail from LDAP: " & ex.Message)
_Logger.Error(ex)
End Try
End Using
' Using search As DirectorySearcher = New DirectorySearcher(path)
' Dim result As SearchResult
' Try
' search.Filter = "(SAMAccountName=" & userName & ")"
' search.PropertiesToLoad.Add("mail")
' result = search.FindOne()
' Catch ex As Exception
' _Logger.Error(ex)
' search.Filter = ""
' search.Filter = "(GivenName=" & userName & ")"
' search.PropertiesToLoad.Add("mail")
' End Try
Return userEmail
' Try
' result = search.FindOne()
' If result IsNot Nothing Then userEmail = result.Properties("mail").ToString
' Catch ex As Exception
' _Logger.Info(">> Unexpected Error in GetUserEmail from LDAP: " & ex.Message)
' _Logger.Error(ex)
' End Try
' End Using
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
' Return userEmail
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
'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
End Function
' 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
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()

1
Global_Indexer/frmStart.vb
View File

@ -1,6 +1,5 @@
Imports System.IO
Imports Microsoft.Office.Interop
Imports Independentsoft
Imports DLLLicenseManager
Imports System.Text
Imports System.Globalization

3
SetupVS19/Product.wxs
View File

@ -119,6 +119,9 @@
<File Id="Windream" Name="DigitalData.Modules.Windream.dll" Source="DigitalData.Modules.Windream.dll" KeyPath="no" />
<File Id="Windows" Name="DigitalData.Modules.Windows.dll" Source="DigitalData.Modules.Windows.dll" KeyPath="no" />
<File Id="Language" Name="DigitalData.Modules.Language.dll" Source="DigitalData.Modules.Language.dll" KeyPath="no" />
<File Id="Messaging" Name="DigitalData.Modules.Messaging.dll" Source="DigitalData.Modules.Messaging.dll" KeyPath="no" />
<File Id="Messaging.License" Name="MailLicense.xml" Source="MailLicense.xml" KeyPath="no" />
</Component>
<Component Id="GDPictureLibs" Guid="9ea5ab43-58ff-4813-9a8b-f854784f0275">