Option Explicit On Imports System.DirectoryServices Imports System.IO Imports System.Security.AccessControl Imports System.Security.Principal Imports System.Text.RegularExpressions Imports DigitalData.GUIs.GlobalIndexer Imports DigitalData.Modules.Logging Imports DigitalData.Modules.Language.Utils Imports DigitalData.Controls.LookupGrid Imports Independentsoft Imports DevExpress.XtraEditors.Controls Public Class frmGlobix_Index #Region "+++++ Variablen ++++++" Public vPathFile As String Private MULTIFILES As Integer Private akttxtbox As TextBox Dim DT_VWGI_DOCTYPE As DataTable Public FormLoaded As Boolean = False Dim DropType As String Private DT_INDEXEMAN As DataTable Dim sql_history_INSERT_INTO As String Dim sql_history_Index_Values As String Private NewFileString As String Private CancelAttempts As Integer = 0 Private Const MaxCancelAttempts = 2 Private Property ViewerString As String Private Const TEXT_MISSING_INPUT = "Bitte vervollständigen Sie die Eingaben!" Private _LogConfig As LogConfig Private _Logger As Logger Private clswindowLocation As ClassWindowLayout Private clsPatterns As GlobixPatterns Private clsPostProcessing As GlobixPostprocessing Private _DataASorDB As ClassDataASorDB Private _idbdata As ClassIDBData Private _Patterns As GlobixPatterns Private _Controls As DigitalData.GUIs.GlobalIndexer.ControlCreator Private _FileEx As DigitalData.Modules.Filesystem.File Public Class DocType Public Property Guid Public Property Name Public Overrides Function ToString() As String Return Name End Function End Class Public Class ControlMeta Public Property IndexName As String Public Property IndexType As String Public Property MultipleValues As Boolean = False End Class #End Region Public Sub New(LogConfig As LogConfig) ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. _Logger = LogConfig.GetLogger() _LogConfig = LogConfig _DataASorDB = New ClassDataASorDB(LogConfig) clswindowLocation = New ClassWindowLayout(LogConfig) clsPatterns = New GlobixPatterns(LogConfig) clsPostProcessing = New GlobixPostprocessing(LogConfig) _idbdata = New ClassIDBData(LogConfig) _Patterns = New GlobixPatterns(LogConfig) _FileEx = New Modules.Filesystem.File(LogConfig) Localizer.Active = New LookupGridLocalizer() End Sub Private Sub frmGlobix_Index_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.ColorizeInactiveIcon = False ' Abbruchzähler zurücksetzen CancelAttempts = 0 My.Application.Globix.INDEXING_ACTIVE = True Try My.Application.Globix.CURRENT_ISATTACHMENT = False DropType = My.DatabaseECM.GetScalarValue("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & My.Application.Globix.CURRENT_WORKFILE_GUID).ToString My.Application.Globix.CURR_DELETE_ORIGIN = My.UIConfig.Globix.DeleteOriginalFile SourceDeleteItem.Enabled = True SourceDeleteItem.Checked = My.UIConfig.Globix.DeleteOriginalFile DocumentViewer1.Init(_LogConfig, My.Application.Settings.GdPictureKey) If DropType Is Nothing Then _Logger.Debug("File with Id [{0}] was not found in TBGI_FILES_USER. Exiting.", My.Application.Globix.CURRENT_WORKFILE_GUID) CancelAttempts = MaxCancelAttempts Close() Else My.Application.Globix.CURRENT_DROPTYPE = DropType.Replace("|", "") If DropType.StartsWith("|FW") Then ' Eine Datei aus FolderWatch wird IMMER gelöscht, egal wie die Einstellung in der Config lautet My.Application.Globix.CURR_DELETE_ORIGIN = True SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Never ElseIf DropType.Contains("|OUTLOOK_MESSAGE|") Then ' Eine (DragDrop)-Outlook Nachricht wird NIE gelöscht, egal wie die Einstellung in der Config lautet My.Application.Globix.CURR_DELETE_ORIGIN = False SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Never Else SourceDeleteItem.Visibility = DevExpress.XtraBars.BarItemVisibility.Always End If If DropType = "|DROPFROMFSYSTEM|" Then If My.Application.User.Language <> "de-DE" Then Me.Text = "Storage-Flow of dropped file" Else Me.Text = "Ablage-Flow - Dropped File" End If ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then Select Case DropType Case "|FW_MSGONLY|" _Logger.Info(".msg-file from folderwatch") If My.Application.User.Language <> "de-DE" Then Me.Text = "Storage-Flow - msg-File (without Attachments) - from Folderwatch" Else Me.Text = "Ablage-Flow - msg-Datei (ohne Anhang) - aus Folderwatch" End If Case "|OUTLOOK_MESSAGE|" _Logger.Info(".msg-file through dragdrop") If My.Application.User.Language <> "de-DE" Then Me.Text = "Storage-Flow - msg-File (without Attachments)" Else Me.Text = "Ablage-Flow - msg-Datei (ohne Anhang)" End If End Select ElseIf DropType = "|MSGONLY|" Then If My.Application.User.Language = "de-DE" Then Me.Text = "Ablage-Flow der msg-Datei (ohne Anhang)" Else Me.Text = "Storage-Flow of msg-File (without Attachments)" End If ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then My.Application.Globix.CURRENT_ISATTACHMENT = True If My.Application.User.Language = "de-DE" Then Me.Text = "Ablage-Flow eines Email-Attachments" Else Me.Text = "Storage-Flow of email-Attachment" End If ElseIf DropType = "|FW_SIMPLEINDEXER|" Then If My.Application.User.Language = "de-DE" Then Me.Text = "Ablage-Flow einer Folderwatch-Datei" Else Me.Text = "Storage-Flow of Folderwatch-File" End If End If labelFilePath.Caption = My.Application.Globix.CURRENT_WORKFILE clswindowLocation.LoadFormLocationSize(Me) SetFilePreview(My.UIConfig.Globix.FilePreview) SplitContainerControl1.SplitterPosition = My.UIConfig.Globix.SplitterDistanceViewer Dim oSQL As String = "SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID" My.Application.Globix.DTTBGI_REGEX_DOCTYPE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "DTTBGI_REGEX_DOCTYPE", "", "") oSQL = "SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING" My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING = _DataASorDB.GetDatatable("DD_ECM", oSQL, "TBDD_INDEX_MAN_POSTPROCESSING", "", "") MULTIFILES = My.DatabaseECM.GetScalarValue("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") My.Application.Globix.MULTIINDEXING_ACTIVE = False If MULTIFILES > 0 Then If My.Application.User.Language = "de-DE" Then chkMultiindexing.Caption = "Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" Else chkMultiindexing.Caption = "All following files (" & MULTIFILES & ") will be indexed identically" End If chkMultiindexing.Checked = False chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Else chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If End If Catch ex As Exception _Logger.Warn(" - Unexpected error in Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Öffnen des Formulares:") End Try End Sub Private Sub SetFilePreview(ShowPreview As Boolean) If ShowPreview Then SplitContainerControl1.Collapsed = False PreviewFile() PreviewItem.Checked = True Else SplitContainerControl1.Collapsed = True PreviewItem.Checked = False End If End Sub Sub PreviewFile() Try DocumentViewer1.LoadFile(My.Application.Globix.CURRENT_WORKFILE) Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in PreviewFile:") End Try End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SourceDeleteItem.ItemClick If SourceDeleteItem.Visibility <> DevExpress.XtraBars.BarItemVisibility.Never Then My.Application.Globix.CURR_DELETE_ORIGIN = SourceDeleteItem.Checked My.UIConfig.Globix.DeleteOriginalFile = SourceDeleteItem.Checked My.SystemConfigManager.Save() End If End Sub Private Sub SkipItem_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SkipItem.ItemClick My.DatabaseECM.ExecuteNonQuery($"DELETE FROM TBGI_FILES_USER WHERE GUID = {My.Application.Globix.CURRENT_WORKFILE_GUID}") CancelAttempts = 2 Close() End Sub Private Sub BarCheckItem3_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles chkMultiindexing.CheckedChanged If chkMultiindexing.Checked Then chkMultiindexing.Caption = "Active" Else chkMultiindexing.Caption = "Inactive" End If End Sub Private Sub frmGlobix_Index_Shown(sender As Object, e As EventArgs) Handles Me.Shown BringToFront() Focus() Cursor = Cursors.Default Refresh_Dokart() pnlIndex.Controls.Clear() checkItemTopMost.Checked = My.UIConfig.Globix.TopMost TopMost = My.UIConfig.Globix.TopMost BringToFront() FormLoaded = True Try ' Letzte Auswahl merken überschreibt die automatische selektion If My.UIConfig.Globix.ProfilePreselection Then checkItemPreselection.Checked = True If My.Application.Globix.CURRENT_LASTDOCTYPE <> "" Then Dim oFoundDocType = ComboBoxEdit1.Properties.Items. Cast(Of DocType)(). Where(Function(dt) dt.Name = My.Application.Globix.CURRENT_LASTDOCTYPE). FirstOrDefault() If oFoundDocType IsNot Nothing Then ComboBoxEdit1.SelectedItem = oFoundDocType End If End If Else If My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows.Count > 0 Then For Each oRoW As DataRow In My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows Dim oOnlyFilename = Path.GetFileName(My.Application.Globix.CURRENT_WORKFILE) If Regex.IsMatch(oOnlyFilename, oRoW.Item("Regex")) Then _Logger.Debug("There is a match on REGEX_DOCTYPE: [{0}]", oRoW.Item("DOCTYPE")) _Logger.Debug("Regex: [{0}], FileName: [{1}]", oRoW.Item("Regex"), oOnlyFilename) Dim oFoundDocType = ComboBoxEdit1.Properties.Items. Cast(Of DocType)(). Where(Function(dt) dt.Name = My.Application.Globix.CURRENT_LASTDOCTYPE). FirstOrDefault() If oFoundDocType IsNot Nothing Then ComboBoxEdit1.SelectedItem = oFoundDocType End If Exit For End If Next End If End If Catch ex As Exception _Logger.Warn("Unexpected error DTTBGI_REGEX_DOCTYPE - ErrorMessage: " & vbNewLine & ex.Message) End Try End Sub Private Sub checkItemPreselection_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged My.UIConfig.Globix.ProfilePreselection = checkItemPreselection.Checked My.SystemConfigManager.Save() End Sub Sub Refresh_Dokart() Try Dim oSql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", My.Application.User.UserName) Dim oFilter = $"USERNAME = '{My.Application.User.UserName}'" DT_VWGI_DOCTYPE = _DataASorDB.GetDatatable("DD_ECM", oSql, "VWGI_DOCTYPE", oFilter, "SEQUENCE") For Each oRow As DataRow In DT_VWGI_DOCTYPE.Rows ComboBoxEdit1.Properties.Items.Add(New DocType With { .Guid = oRow.Item("DOCTYPE_ID"), .Name = oRow.Item("DOCTYPE") }) Next Catch ex As Exception _Logger.Warn("Unexpected error in Refresh_Dokart: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Laden der Dokumentarten:") End Try End Sub Private Sub ComboBoxEdit1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBoxEdit1.SelectedIndexChanged If ComboBoxEdit1.SelectedIndex <> -1 And FormLoaded = True Then Dim oSelectedItem As DocType = ComboBoxEdit1.SelectedItem My.Application.Globix.CURRENT_DOCTYPE_ID = oSelectedItem.Guid 'lblhinweis.Visible = False ClearNotice() 'lblerror.Visible = False ClearError() pnlIndex.Controls.Clear() Dim oSql As String = "Select * from TBDD_DOKUMENTART WHERE GUID = " & oSelectedItem.Guid Dim oFilter = "GUID = " & oSelectedItem.Guid My.Application.Globix.CURR_DT_DOCTYPE = _DataASorDB.GetDatatable("DD_ECM", oSql, "TBDD_DOKUMENTART", oFilter, "") My.Application.Globix.CURRENT_DOCTYPE_DuplicateHandling = My.Application.Globix.CURR_DT_DOCTYPE.Rows(0).Item("DUPLICATE_HANDLING").ToString Refresh_IndexeMan(My.Application.Globix.CURRENT_DOCTYPE_ID) End If End Sub Private Sub Refresh_IndexeMan(dokartid As Integer) Dim oSql Try oSql = "select T1.BEZEICHNUNG AS DOKUMENTART,T.* from TBDD_INDEX_MAN T, TBDD_DOKUMENTART T1 where T.ACTIVE = 1 AND T.DOK_ID = T1.GUID AND T.DOK_ID = " & dokartid & " ORDER BY T.SEQUENCE" Dim oFilter = "DOK_ID = " & dokartid DT_INDEXEMAN = _DataASorDB.GetDatatable("DD_ECM", oSql, "DT_INDEXE_MAN", oFilter, "SEQUENCE") pnlIndex.Visible = True LoadIndexe_Man() Catch ex As System.Exception _Logger.Error(ex) _Logger.Warn("Fehler Refresh_IndexeMan: DOKART-ID: " & dokartid & " - Fehler: " & vbNewLine & ex.Message & vbNewLine & oSql) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Refresh_IndexeMan:") End Try End Sub Sub addLabel(pIndexName As String, hinweis As String, ylbl As Integer, anz As String) Dim lbl As New Label With { .Name = "lbl" & pIndexName, .AutoSize = True, .Text = hinweis, .Location = New Point(11, ylbl) } pnlIndex.Controls.Add(lbl) End Sub Sub ShowError(text As String) 'lblerror.Visible = True 'lblerror.Text = text 'lblerror.ForeColor = Color.Red labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Always labelError.Caption = text End Sub Private Sub LoadIndexe_Man() Try Dim oScreen As New DigitalData.Modules.Windows.Screen() Dim oDpiScale = oScreen.GetScreenScaling(Me) Dim oControlCount As Integer = 1 Dim oLabelPosition As Integer = 11 * oDpiScale Dim oControlPosition As Integer = 33 * oDpiScale Dim oControls As New DigitalData.GUIs.GlobalIndexer.ControlCreator(_LogConfig, pnlIndex, Me) With { .OnControlChanged = AddressOf PrepareDependingControl, .OnLookupData = AddressOf GetLookupData } _Logger.Info("Loading Indicies for Screen Scaling Factor [{0}]", oDpiScale) _Controls = oControls If DT_INDEXEMAN.Rows.Count = 0 Then ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboBoxEdit1.Text & " definiert") _Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboBoxEdit1.Text & " definiert") End If For Each oRow As DataRow In DT_INDEXEMAN.Rows Dim oDataType = oRow.Item("DATATYPE") Dim MultiSelect As Boolean = oRow.Item("MULTISELECT") Dim AddNewItems As Boolean = oRow.Item("VKT_ADD_ITEM") Dim PreventDuplicates As Boolean = oRow.Item("VKT_PREVENT_MULTIPLE_VALUES") Dim oControlName As String = oRow.Item("NAME") Dim oConnectionId = NotNull(oRow.Item("CONNECTION_ID"), 0) Dim oSQLSuggestion = oRow.Item("SUGGESTION") If oDataType <> "BOOLEAN" Then addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount) End If Dim oDefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART")) If oDefaultValue Is Nothing Then oDefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) End If Select Case oDataType Case "BOOLEAN" Dim chk As CheckBox = oControls.AddCheckBox(oControlName, oControlPosition, oDefaultValue, oRow.Item("COMMENT").ToString) If Not IsNothing(chk) Then pnlIndex.Controls.Add(chk) End If Case "INTEGER" If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oRow.Item("SQL_RESULT"), oConnectionId, oDefaultValue, AddNewItems, PreventDuplicates) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If Else 'nur eine Textbox Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, oDefaultValue, oDataType) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If End If Case "VARCHAR" If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oRow.Item("SQL_RESULT"), oConnectionId, oDefaultValue, AddNewItems, PreventDuplicates) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If Else If oControlName.ToString.ToLower = "dateiname" Then Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE), oDataType) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If Else Dim VORBELGUNG As String = oDefaultValue Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, VORBELGUNG, oDataType) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If End If End If Case "DATE" Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, oDataType) pnlIndex.Controls.Add(oPicker) Case Else If My.Application.User.Language = "de-DE" Then MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") Else MsgBox("Please check Datatype of Indexvalue!", MsgBoxStyle.Critical, "Warning:") End If _Logger.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man") End Select oControlCount += 1 oLabelPosition += 50 * oDpiScale oControlPosition += 50 * oDpiScale 'make y as height in fom Next Dim oPanelHeight = oControlPosition - 30 If pnlIndex.Height < oPanelHeight Then If (Me.Height - 315) < oPanelHeight Then Me.Height = (Me.Height - 315) + oPanelHeight End If pnlIndex.Height = oPanelHeight End If SendKeys.Send("{TAB}") Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in LoadIndexe_Man:") End Try End Sub Private Sub PrepareDependingControl(pControl As Control) If TypeOf pControl Is Label Then Exit Sub End If Try Dim oMeta = DirectCast(pControl.Tag, ControlMeta) Dim oIndexName As String = oMeta.IndexName Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%' AND DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}" Dim oDatatable As DataTable = My.DatabaseECM.GetDatatable(oSQL) If Not IsNothing(oDatatable) Then _Logger.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, pControl.Name) For Each oRow As DataRow In oDatatable.Rows Dim oControlName As String = NotNull(oRow.Item("NAME"), "") Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), -1) Dim oControlSql As String = NotNull(oRow.Item("SQL_RESULT"), "") If oConnectionId = -1 Or oControlSql = String.Empty Then _Logger.Warn("Missing SQL Query or ConnectionId for Control [{0}]! Continuing.", oControlName) Continue For End If oControlSql = _Patterns.ReplaceUserValues(oControlSql, My.Application.Globix.CURRENT_DOCTYPE_ID) oControlSql = _Patterns.ReplaceInternalValues(oControlSql) oControlSql = _Patterns.ReplaceControlValues(oControlSql, pnlIndex) _Logger.Debug("Setting new value for [{0}]", oControlName) SetDependingControlResult(oControlName, oControlSql, oConnectionId) Next End If Catch ex As Exception _Logger.Error(ex) End Try End Sub Private Sub SetDependingControlResult(IndexName As String, pSqlCommand As String, SqlConnectionId As Integer) Try If pSqlCommand Is Nothing OrElse pSqlCommand = String.Empty Then _Logger.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.") Exit Sub End If Dim oConnectionString = GetConnectionString(SqlConnectionId) Dim oDatatable As DataTable = My.DatabaseECM.GetDatatableWithConnection(pSqlCommand, oConnectionString) Dim oFoundControl As Control = Nothing For Each oControl As Control In pnlIndex.Controls If TypeOf oControl Is Label Then Continue For End If Dim oMeta = DirectCast(oControl.Tag, ControlMeta) Dim oIndex As String = oMeta.IndexName If oIndex = IndexName Then oFoundControl = oControl Exit For End If Next If oFoundControl Is Nothing Then _Logger.Warn("Depending Control for Index [{0}] not found!", IndexName) End If If oDatatable Is Nothing Then _Logger.Warn("Error in SQL Command: {0}", pSqlCommand) End If Select Case oFoundControl.GetType.Name Case GetType(DevExpress.XtraEditors.TextEdit).Name If oDatatable.Rows.Count > 0 Then Dim oFirstRow As DataRow = oDatatable.Rows.Item(0) If oFirstRow.ItemArray.Length > 0 Then Dim oValue = oFirstRow.Item(0).ToString() _Logger.Debug("Setting Value for TextEdit [{0}]: [{1}]", oFoundControl.Name, oValue) DirectCast(oFoundControl, DevExpress.XtraEditors.TextEdit).Text = oValue End If End If Case GetType(LookupControl3).Name _Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") DirectCast(oFoundControl, LookupControl3).Properties.DataSource = oDatatable Case GetType(ComboBox).Name _Logger.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") DirectCast(oFoundControl, ComboBox).DataSource = oDatatable Case Else _Logger.Debug("Could not set depending control result for [{0}]", oFoundControl.GetType.Name) End Select Catch ex As Exception _Logger.Error(ex) End Try End Sub Private Function GetLookupData(pLookup As LookupControl3, pSQLCommand As String, pConnectionId As Integer) Dim oConnectionString = GetConnectionString(pConnectionId) If oConnectionString IsNot Nothing And pSQLCommand.Length > 0 Then _Logger.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30)) If _Patterns.HasComplexPatterns(pSQLCommand) Then _Logger.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) Return Nothing Else pSQLCommand = _Patterns.ReplaceInternalValues(pSQLCommand) pSQLCommand = _Patterns.ReplaceUserValues(pSQLCommand, My.Application.Globix.CURRENT_DOCTYPE_ID) Dim oDatatable = My.DatabaseECM.GetDatatableWithConnection(pSQLCommand, oConnectionString) Return oDatatable End If Else _Logger.Warn("Connection String for control [{0}] is empty!", pLookup.Name) Return Nothing End If End Function Function GetPlaceholderValue(InputValue As String, FileName As String, UserShortName As String) As String Dim oResult As String Try Select Case InputValue.ToString.ToUpper Case "$filename_ext".ToUpper oResult = Path.GetFileName(FileName) Case "$filename".ToUpper oResult = Path.GetFileNameWithoutExtension(FileName) Case "$extension".ToUpper oResult = Path.GetExtension(FileName).Replace(".", "") Case "$FileCreateDate".ToUpper Dim oFileInfo As New FileInfo(FileName) Dim oCreationDate As Date = oFileInfo.CreationTime oResult = oCreationDate.ToShortDateString Case "$FileCreatedWho".ToUpper Dim oFileSecurity As FileSecurity = File.GetAccessControl(FileName) Dim oSecurityId As IdentityReference = oFileSecurity.GetOwner(GetType(SecurityIdentifier)) Dim oNTAccount As IdentityReference = oSecurityId.Translate(GetType(NTAccount)) Dim oOwner As String = oNTAccount.ToString() oResult = oOwner Case "$DateDDMMYYY".ToUpper oResult = System.DateTime.Now.ToShortDateString Case "$Username".ToUpper oResult = Environment.UserName Case "$Usercode".ToUpper oResult = UserShortName Case Else oResult = InputValue End Select Catch ex As Exception _Logger.Warn("Error in ReplacePlaceholders: " & ex.Message) _Logger.Error(ex.Message) oResult = Nothing End Try Return oResult End Function Function Check_HistoryValues(Indexname As String, Dokart As String) As String Try Dim result = Nothing Dim DT As DataTable = GlobixDataset.TBTEMP_INDEXRESULTS If DT.Rows.Count > 0 Then For Each row As DataRow In DT.Rows If row.Item("Indexname") = Indexname And row.Item("Dokumentart") = Dokart Then result = row.Item("Value") Return result End If Next Else Return Nothing End If Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Check_HistoryValues:") Return Nothing End Try End Function Sub ClearError() labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Never labelError.Caption = String.Empty End Sub Sub ShowNotice(text As String) 'lblhinweis.Visible = True 'lblhinweis.Text = text labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Always labelNotice.Caption = text End Sub Sub ClearNotice() labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Never labelNotice.Caption = String.Empty End Sub Private Sub frmGlobix_Index_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing If File.Exists(My.Application.Globix.CURRENT_FILENAME) Then Select Case CancelAttempts Case 0 If My.Application.User.Language = "de-DE" Then 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) End If CancelAttempts = CancelAttempts + 1 e.Cancel = True Case 1 Dim result As MsgBoxResult If My.Application.User.Language = "de-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) 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) End If If result = MsgBoxResult.Yes Then Dim containsfw_file As Boolean = False Try My.Application.Globix.ABORT_INDEXING = True Dim sql As String = $"SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('{My.Application.User.UserName}')" Dim DT As DataTable = My.DatabaseECM.GetDatatable(sql) Dim anz = DT.Rows.Count For Each Filerow As DataRow In DT.Rows Dim filestring As String = Filerow.Item("FILENAME2WORK") Dim handletype As String = Filerow.Item("HANDLE_TYPE") If handletype = "|MSGONLY|" Or handletype = "|ATTMNTEXTRACTED|" Then Try System.IO.File.Delete(filestring) Catch ex As Exception End Try ElseIf handletype.StartsWith("|FW") Then containsfw_file = True End If Next 'Zuerst die Daten des Ablaufs löschen If My.DatabaseECM.ExecuteNonQuery($"DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('{My.Application.User.UserName}')") = True Then If containsfw_file = True Then If My.Application.User.Language = "de-DE" Then MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:") Else MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:") End If End If End If Catch ex As Exception _Logger.Error(ex) MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Try My.Application.Globix.INDEXING_ACTIVE = False DocumentViewer1.CloseDocument() DocumentViewer1.Done() clswindowLocation.SaveFormLocationSize(Me) My.Settings.Save() Catch ex As Exception _Logger.Info(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") End Try e.Cancel = False Else e.Cancel = True End If Case Else Try My.Application.Globix.INDEXING_ACTIVE = False DocumentViewer1.CloseDocument() DocumentViewer1.Done() clswindowLocation.SaveFormLocationSize(Me) My.Settings.Save() Catch ex As Exception _Logger.Warn(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") End Try End Select Else My.Application.Globix.INDEXING_ACTIVE = False End If End Sub Private Sub GlobixFlow() ClearError() ClearNotice() Me.Cursor = Cursors.WaitCursor Refresh_RegexTable() For Each rowregex As DataRow In My.Application.Globix.DT_FUNCTION_REGEX.Rows If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then My.Application.Globix.REGEX_CLEAN_FILENAME = rowregex.Item("REGEX") End If Next If chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Always And chkMultiindexing.Checked = True Then 'Die erste Datei indexieren If WORK_FILE() = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = My.DatabaseECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & My.Application.User.UserName & "')") If Not DTFiles2Work Is Nothing Then Dim err = False For Each filerow As DataRow In DTFiles2Work.Rows My.Application.Globix.CURRENT_WORKFILE_GUID = filerow.Item("GUID") My.Application.Globix.CURRENT_WORKFILE = filerow.Item("FILENAME2WORK") DropType = filerow.Item("HANDLE_TYPE") If WORK_FILE() = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then If My.Application.User.Language = "de-DE" Then MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:") Else MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success") End If 'DTACTUAL_FILES.Clear() DocumentViewer1.CloseDocument() DocumentViewer1.Done() CancelAttempts = 2 Me.Close() End If End If End If Else If WORK_FILE() = True Then Me.Cursor = Cursors.Default If My.UIConfig.Globix.ShowIndexResult = True Then NI_TYPE = "INFO" If My.Application.User.Language = "de-DE" Then NI_TITLE = "Globix Flow erfolgreich" NI_MESSAGE = "Die Datei wurde erfolgreich verarbeitet" Else NI_TITLE = "Success Globix Flow" NI_MESSAGE = "File successfully processed" End If End If DocumentViewer1.CloseDocument() DocumentViewer1.Done() CancelAttempts = 2 Me.Close() End If End If Me.Cursor = Cursors.Default End Sub Private Function WORK_FILE() Try Dim oSQL = $"SELECT * ,CONVERT(VARCHAR(512),'') As IndexValueGUI,CONVERT(VARCHAR(512),'') As IndexValue_File,CONVERT(Bit,0) as Indexed FROM VWDDINDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}" Dim oFilter = "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID My.Application.Globix.CURR_DT_MAN_INDEXE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "VWDDINDEX_MAN", oFilter, "") _Logger.Debug("Manuelle Indexe geladen") If My.Application.Globix.CURR_DT_MAN_INDEXE.Rows.Count > 0 Then Dim oDokart As DocType = ComboBoxEdit1.SelectedItem My.Application.Globix.CURRENT_DOCTYPE_ID = oDokart.Guid If CheckWrite_IndexeMan(oDokart.Guid) = True Then '##### Manuelle Indexe indexiert ##### _Logger.Info("Datei [" & My.Application.Globix.CURRENT_WORKFILE & "] wird nun indexiert...") If FillIndexe_Autom(oDokart.Guid) = True Then _Logger.Debug(" ...FillIndexe_Autom durchlaufen") 'Den Zielnamen zusammenbauen If Name_Generieren() = True Then 'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren DocumentViewer1.Done() DocumentViewer1.CloseDocument() _Logger.Debug(" ...Viewer geschlossen") 'Die Datei verschieben If Move_File2_Target() = True Then _Logger.Debug(" ...Move_File2_Target durchlaufen") My.Application.Globix.CURRENT_LASTDOCTYPE = oDokart.Name _Logger.Info("Datei '" & My.Application.Globix.CURRENT_NEWFILENAME & "' erfolgreich erzeugt.") Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & My.Application.Globix.CURRENT_WORKFILE_GUID My.DatabaseECM.ExecuteNonQuery(oDEL) If My.Application.Globix.CURR_DELETE_ORIGIN = True Then _Logger.Info("Datei [" & My.Application.Globix.CURRENT_WORKFILE & "] wird gelöscht.") Try System.IO.File.Delete(My.Application.Globix.CURRENT_WORKFILE) Catch ex As Exception _Logger.Error(ex) End Try _Logger.Info("Datei [" & My.Application.Globix.CURRENT_WORKFILE & "] wurde gelöscht.") End If Return True End If Else If My.Application.User.Language = "de-DE" Then MsgBox("Unerwarteter Fehler in Name_Generieren - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) Else MsgBox("Unexpected error in Name_Generieren - Please check the Logfile", MsgBoxStyle.Critical) End If Return False End If Else If My.Application.User.Language = "de-DE" Then MsgBox("Unerwarteter Fehler in FillIndexe_Autom - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) Else MsgBox("Unexpected error in FillIndexe_Autom - Please check the Logfile", MsgBoxStyle.Critical) End If Return False End If '#### Automatische Werte indexieren #### End If Else If My.Application.User.Language = "de-DE" Then MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation) Else MsgBox("Please check the configuration for this document-type." & vbNewLine & "There are NO manual indicies that are either configured or set to active!", MsgBoxStyle.Exclamation) End If Return False End If Catch ex As Exception _Logger.Error(ex) MsgBox("Unexpected Error in WORK_FILE:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Function Name_Generieren() Try _Logger.Debug("#### Name_Generieren ####") My.Application.Globix.FILE_DELIMITER = "~" My.Application.Globix.VERSION_DELIMITER = "~" Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) Dim err As Boolean = False Dim folder_Created As Boolean = False Dim oRAWZielordner As String Dim extension As String = System.IO.Path.GetExtension(My.Application.Globix.CURRENT_WORKFILE) sql_history_INSERT_INTO = "INSERT INTO TBGI_HISTORY (FILENAME_ORIGINAL,FILENAME_NEW" sql_history_Index_Values = "" Dim AnzahlIndexe As Integer = 1 'CURR_DOKART_OBJECTTYPE = DT.Rows(0).Item("OBJEKTTYP") My.Application.Globix.CURRENT_WORKFILE_EXTENSION = extension oRAWZielordner = My.Application.Globix.CURR_DT_DOCTYPE.Rows(0).Item("ZIEL_PFAD") '#### ' Regulären Ausdruck zum Auslesen der Indexe definieren Dim preg As String = "\[%{1}[a-zA-Z0-9ß\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" 'schonmal den gesamten Pfad laden Dim oNamenkonvention As String = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_DOCTYPE, $"", "NAMENKONVENTION", "").ToString & My.Application.Globix.CURRENT_WORKFILE_EXTENSION NewFileString = oNamenkonvention ' einen Regulären Ausdruck laden Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' die Vorkommen im SQL-String auslesen Dim oMatchelements As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(oNamenkonvention) '#### If oMatchelements.Count = 0 Then _Logger.Debug("No RegularExpression Fileds on Nameconvention!") End If ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each oElement As System.Text.RegularExpressions.Match In oMatchelements Select Case oElement.Value.Substring(2, 1).ToUpper 'Manueller Indexwert Case "M" _Logger.Debug("NameGenerieren: Manueller Index wird geprüft...") Dim Indexname = oElement.Value.Substring(3, oElement.Value.Length - 4) Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{Indexname}'", "OPTIONAL", "") Dim oManValue As String = GetManIndex_Value(Indexname, "FILE", optional_index) If oManValue <> String.Empty Then Dim firstVectorValue = oManValue.Split(ClassConstants.VECTORSEPARATOR).First() oNamenkonvention = oNamenkonvention.Replace(oElement.Value, firstVectorValue) NewFileString = oNamenkonvention sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" Else If optional_index = True Then oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "-", "-") oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "_", "_") oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "-", "_") oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "_", "-") oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value, "-") oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value, "_") oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "-", "-") oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "_", "_") oNamenkonvention = oNamenkonvention.Replace(oElement.Value, oManValue) Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oNamenkonvention) Dim oExtension = Path.GetExtension(oNamenkonvention) If oFilenameWithoutExtension.EndsWith("-") Or oFilenameWithoutExtension.EndsWith("_") Then oFilenameWithoutExtension = oFilenameWithoutExtension.Substring(0, oFilenameWithoutExtension.Count - 1) End If NewFileString = oFilenameWithoutExtension & oExtension sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" Else _Logger.Debug("Der Indexvalue für Index '" & Indexname & "' ist String.Empty") err = True End If End If Case "A" Dim value As String = GetAutoIndex_Value(oElement.Value.Substring(3, oElement.Value.Length - 4)) If value <> String.Empty Then If value = "EMPTY_OI" Then oNamenkonvention = oNamenkonvention.Replace(oElement.Value, "") NewFileString = oNamenkonvention Else oNamenkonvention = oNamenkonvention.Replace(oElement.Value, value) NewFileString = oNamenkonvention sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & value.Replace("'", "''") & "'" End If Else err = True End If Case "V" Dim datetemp As String Dim _Month As String = My.Computer.Clock.LocalTime.Month If _Month.Length = 1 Then _Month = "0" & _Month End If Dim _day As String = My.Computer.Clock.LocalTime.Day If _day.Length = 1 Then _day = "0" & _day End If Dim type = oElement.Value '.ToUpper.Replace("[v%", "") type = type.Replace("[%v_", "") type = type.Replace("[%v", "") type = type.Replace("]", "") Select Case type Case "YY_MM_DD" datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & "_" & _Month & "_" & _day Case "YYYY_MM_DD" datetemp = My.Computer.Clock.LocalTime.Year & "_" & _Month & "_" & _day Case "DD_MM_YY" datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) Case "DD_MM_YYYY" datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year Case "YYMMDD" datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & _Month & _day Case "YYYYMMDD" datetemp = My.Computer.Clock.LocalTime.Year & _Month & _day Case "DDMMYY" datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) Case "DDMMYYYY" datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year Case "OFilename" oNamenkonvention = oNamenkonvention.Replace(oElement.Value, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE)) Case "Username".ToUpper oNamenkonvention = oNamenkonvention.Replace(oElement.Value, Environment.UserName) Case "Usercode".ToUpper oNamenkonvention = oNamenkonvention.Replace(oElement.Value, My.Application.User.ShortName) Case "" End Select If datetemp <> "" Then oNamenkonvention = oNamenkonvention.Replace(oElement.Value, datetemp) End If NewFileString = oNamenkonvention Case "[%Version]".ToUpper Try Dim version As Integer = 1 Dim Stammname As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") Dim _neuername As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") Stammname = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") _neuername = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") 'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "") 'Überprüfen ob File existiert If File.Exists(_neuername) = False Then NewFileString = _neuername Else Do While File.Exists(_neuername) version = version + 1 _neuername = Stammname.Replace(extension, "") & My.Application.Globix.VERSION_DELIMITER & version & extension NewFileString = _neuername Loop End If Catch ex As Exception _Logger.Warn(" - Unexpected error in NameGenerieren - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Umbenennnen der Datei:") err = True End Try Case Else _Logger.Info(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper) MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") End Select Next My.Application.Globix.CURRENT_NEWFILENAME = oFilesystem.GetCleanFilename(NewFileString) 'CURRENT_NEWFILENAME = ClassFilehandle.CleanFilename(NewFileString, "") My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oRAWZielordner, My.Application.Globix.CURRENT_NEWFILENAME) _Logger.Debug("#### ENDE Name_Generieren ####") _Logger.Debug("") If err = False Then Return True Else Return False End If Catch ex As Exception _Logger.Warn(" - Unvorhergesehener Unexpected error in Name_Generieren - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Unexpected error in Name_Generieren:") Return False End Try End Function Private Function Move_File2_Target() Dim oError As Boolean Try Dim oFolderForIndex = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_DOCTYPE, $"", "FOLDER_FOR_INDEX", "") If Not IsDBNull(oFolderForIndex) Then CreateFolderForIndex(oFolderForIndex) Else CreateFolderForIndex(String.Empty) End If Dim oIDBImportResult As Boolean = False 'Variable Folder If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then oIDBImportResult = ImportFile2IDB() ' oExportSuccessful = SINGLEFILE_2_WINDREAM(My.Application.Globix.CURR_D) ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then oIDBImportResult = ImportFile2IDB() End If If oIDBImportResult = True Then 'Kein Fehler in Export2windream oError = False If Write_Indizes() = True Then 'Kein Fehler in Setzen der windream-Indizes Dim Insert_String As String Try Dim tempCur_WF = My.Application.Globix.CURRENT_WORKFILE.Replace("'", "''") Dim tempCur_New_FN = My.Application.Globix.CURRENT_NEWFILENAME.Replace("'", "''") Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')" My.DatabaseECM.ExecuteNonQuery(Insert_String) If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then If My.Application.Globix.CURRENT_MESSAGEID <> "" Then Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" Dim GUID = My.DatabaseECM.GetScalarValue(max) Try If GUID > 0 Then Dim sqlUpdate As String If DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID My.DatabaseECM.ExecuteNonQuery(sqlUpdate) Else sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID My.DatabaseECM.ExecuteNonQuery(sqlUpdate) End If End If Catch ex As Exception _Logger.Error(ex) End Try End If End If Catch ex As Exception _Logger.Error(ex) MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical) _Logger.Warn(" - Unexpected error in Insert-History - Fehler: " & vbNewLine & ex.Message) _Logger.Warn(" - Unexpected error in Insert-History - SQL: " & Insert_String) oError = True End Try Else oError = True End If Else oError = True NI_TYPE = "ERROR" If My.Application.User.Language = "de-DE" Then NI_TITLE = "Fehler Globix-Import" NI_MESSAGE = "Der Import war nicht erfolgreich - Check LogFile" Else NI_TITLE = "Error Globix-Import" NI_MESSAGE = "The import was not successful - Check LogFile" End If MsgBox(NI_MESSAGE, MsgBoxStyle.Critical, NI_TITLE) End If 'False oder True zurückgeben 'Kein Fehler aufgetreten If oError = False Then Return True Else 'Fehler aufgetreten Return False End If Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected Error in Move File2Target:") Return False End Try End Function Private Function ImportFile2IDB() As Boolean Try If Move_File(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME, My.Application.Globix.CURRENT_WORKFILE_EXTENSION, My.Application.Globix.VERSION_DELIMITER) = True Then Dim oEXEC As String = $"EXEC PRIDB_ADD_DOC_FROM_FOLDER '{My.Application.Globix.CURRENT_NEWFILENAME}','{My.Application.User.UserName}'" Dim oDTRESULT As DataTable = My.DatabaseIDB.GetDatatable(oEXEC) If IsNothing(oDTRESULT) Then Return False Else If oDTRESULT.Rows.Count = 0 Then Return False Else My.Application.Globix.CURRENT_IDB_OBJ_ID = oDTRESULT.Rows(0).Item(0) Return True End If End If Else Return False End If Catch ex As Exception _Logger.Error(ex) Return False End Try End Function Function Move_File(Quelle As String, _NewFilename As String, extension As String, _versionTz As String) As Boolean 'Überprüfen ob File existiert My.Application.Globix.CURRENT_NEWFILENAME = _FileEx.GetVersionedFilename(_NewFilename) Dim opath = Path.GetDirectoryName(My.Application.Globix.CURRENT_NEWFILENAME) If Directory.Exists(opath) = False Then Directory.CreateDirectory(opath) End If 'Die Datei wird nun an den neuen Ort kopiert My.Computer.FileSystem.MoveFile(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME) Dim Insert_String As String Try Dim tempCur_WF = My.Application.Globix.CURRENT_WORKFILE.Replace("'", "''") Dim tempCur_New_FN = My.Application.Globix.CURRENT_NEWFILENAME.Replace("'", "''") Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO,ADDED_WHERE) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "','" & Environment.MachineName & "')" If My.DatabaseECM.ExecuteNonQuery(Insert_String) = True Then If My.Application.Globix.CURRENT_MESSAGEID <> "" Then Dim oMax As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" Dim oGUID = My.DatabaseECM.GetScalarValue(oMax) Try If oGUID > 0 Then Dim oSql As String If My.Application.Globix.CURRENT_ISATTACHMENT = True Then oSql = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & oGUID My.DatabaseECM.GetScalarValue(oSql) Else oSql = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & oGUID My.DatabaseECM.GetScalarValue(oSql) End If End If Catch ex As Exception End Try End If End If Return True Catch ex As Exception _Logger.Error(ex.Message) _Logger.Warn(" - Unexpected error in Move_Rename - Insert_String: " & Insert_String) Return False End Try End Function Private Function Write_Indizes() Try Dim oSetVariableOK As Boolean = False Dim oAttributeValue As String Dim oAttributeName As String 'Manuelle Indexe Indexieren If My.Application.Globix.CURR_DT_MAN_INDEXE.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In My.Application.Globix.CURR_DT_MAN_INDEXE.Rows oAttributeValue = row.Item("IndexValueGUI") oAttributeName = row.Item("WD_INDEX").ToString _Logger.Debug($"Write_Indizes - Index [{oAttributeName}]...") Dim oIsOptional = CBool(row.Item("OPTIONAL")) Dim oIndexed = CBool(row.Item("Indexed")) If oIndexed And oAttributeValue.ToString <> "" And oAttributeValue <> "EMPTY_OI" Then If oAttributeName <> String.Empty Then If row.Item("SAVE_VALUE") = True Then 'Den Indexwert zwischenspeichern Dim oDTIndexResults As DataTable = GlobixDataset.TBTEMP_INDEXRESULTS Dim rowexists As Boolean = False For Each rowTemp As DataRow In oDTIndexResults.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("IndexValueGUI") End If Next '.....ansonsten neu anlegen If rowexists = False Then Dim newRow As DataRow = oDTIndexResults.NewRow() newRow("Dokumentart") = row.Item("DOKUMENTART").ToString newRow("Indexname") = row.Item("INDEXNAME").ToString newRow("Value") = row.Item("IndexValueGUI") oDTIndexResults.Rows.Add(newRow) End If End If End If _Logger.Debug($"Manueller Indexvalue [{oAttributeValue.ToString}]...NOW THE INDEXING...") Count += 1 ' den Typ des Zielindexes auslesen Dim oIndexType As Integer = _idbdata.GetTypeOfIndex(oAttributeName) _Logger.Debug($"oIndexType [{oIndexType.ToString}]...") _Logger.Debug($"Indexing oIndexType < 8...") oSetVariableOK = _idbdata.SetVariableValue(oAttributeName, oAttributeValue) 'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue) If oSetVariableOK = False Then MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical) Return False Exit For End If Else _Logger.Debug("No Indexing Attributename: " & oAttributeName) _Logger.Debug("is optional? " & oIsOptional.ToString) End If 'Else '_Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & oAttributeName) '_Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & oAttributeName) 'End If Next End If oSetVariableOK = False 'Automatische Indexe Indexieren If My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows oSetVariableOK = CBool(row.Item("Indexed")) oAttributeValue = row.Item("IndexValueGUI").ToString oAttributeName = row.Item("INDEXNAME").ToString If oSetVariableOK = True And oAttributeValue <> "" Then If oAttributeValue <> "EMPTY_OI" Then _Logger.Info("Auto Indexname: " & oAttributeName.ToString) _Logger.Info("oAttributeValue: " & oAttributeValue.ToString) Count += 1 ' den Typ des Zielindexes auslesen Dim indexType As Integer = _idbdata.GetTypeOfIndex(oAttributeName) oSetVariableOK = _idbdata.SetVariableValue(oAttributeName, oAttributeValue) If oSetVariableOK = 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 My.Application.Globix.CURRENT_NEWFILENAME.EndsWith(".msg") Then oSetVariableOK = SetEmailIndices() If oSetVariableOK = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then oSetVariableOK = SetAttachmentIndices() If oSetVariableOK = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If End If Return True Catch ex As Exception _Logger.Warn("Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox("Error in Write_Indizes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Private Function CreateFolderForIndex(DynamicFolderConfig As String) Try Dim oRootFolder As String = Path.GetDirectoryName(My.Application.Globix.CURRENT_NEWFILENAME) Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) If DynamicFolderConfig <> String.Empty Then '###### Dim oRegexString As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim oRegex As Regex = New Regex(oRegexString) ' die Vorkommen im Folder-String auslesen Dim oMatches As MatchCollection = oRegex.Matches(DynamicFolderConfig) '#### ' alle Vorkommen innerhalb des Ordnerstrings durchlaufen For Each oMatch As Match In oMatches _Logger.Info("Elementname in FolderString: '" & oMatch.ToString & "'") Select Case oMatch.Value.Substring(2, 1).ToUpper 'Manueller Indexwert Case "M" Dim oManIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) Dim oIsOptional As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{oManIndexName}'", "OPTIONAL", "") _Logger.Info("Versuch den Indexwert aus '" & oManIndexName & "' auszulesen.") Dim oManIndexValue As String = GetManIndex_Value(oManIndexName, "FILE", oIsOptional) _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oManIndexName & "'") If Not oManIndexValue = String.Empty Then If IsDate(oManIndexValue) Then oManIndexValue = CDate(oManIndexValue).ToString("yyyyMMdd") End If oManIndexValue = oFilesystem.GetCleanPath(oManIndexValue) 'oManIndexValue = ClassFilehandle.CleanFilename(oManIndexValue, "") DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oManIndexValue) _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") Else If oIsOptional = True Then _Logger.Info("Optionaler Indexwert ist NICHT gefüllt") DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, String.Empty) Else _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") Return True End If End If Case "A" Dim oAutoIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) _Logger.Info("Versuch den Auto-Indexwert aus '" & oAutoIndexName & "' auszulesen.") Dim oAutoIndexValue As String = GetAutoIndex_Value(oAutoIndexName) _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oAutoIndexName & "'") If Not oAutoIndexValue = String.Empty Then oAutoIndexValue = oFilesystem.GetCleanPath(oAutoIndexValue) 'oAutoIndexValue = ClassFilehandle.CleanFilename(oAutoIndexValue, "") If oAutoIndexValue = "EMPTY_OI" Then DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, "") Else DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oAutoIndexValue) _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") End If Else _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") End If Case "V" Dim oElementTemp As String Dim _Month As String = My.Computer.Clock.LocalTime.Month If _Month.Length = 1 Then _Month = "0" & _Month End If Dim _day As String = My.Computer.Clock.LocalTime.Day If _day.Length = 1 Then _day = "0" & _day End If Dim type = oMatch.Value.Substring(3, oMatch.Value.Length - 4) If type.StartsWith("_") Then type = type.Replace("_", "") End If Select Case type Case "YYYY/MM/DD" oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day Case "YYYY/MM" oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month Case "YYYY" oElementTemp = My.Computer.Clock.LocalTime.Year Case "YYYY-MM" oElementTemp = My.Computer.Clock.LocalTime.Year & "-" & _Month End Select DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oElementTemp) _Logger.Info("FolderPatter nach V-Element: '" & DynamicFolderConfig & "'") Case Else _Logger.Warn(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper) If My.Application.User.Language = "de-DE" Then MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") Else MsgBox("Attention - One element in Namingconvention could not be matched!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") End If End Select Next End If _Logger.Info("Den Root-Folder zusammenfügen>> ") Dim oNewFullPath As String = System.IO.Path.Combine(oRootFolder, DynamicFolderConfig) _Logger.Info("Fullpath (mit evtl. Sonderzeichen (SZ)) '" & oNewFullPath & "'") Dim invalidPathChars() As Char = Path.GetInvalidPathChars() For Each sonderChar As Char In invalidPathChars 'Sonderzeichen ausser Whitespace entfernen If Char.IsWhiteSpace(sonderChar) = False Then If oNewFullPath.Contains(sonderChar) Then oNewFullPath = oNewFullPath.Replace(sonderChar, "") End If End If Next sonderChar ' oNewFullPath = WINDREAM.GetCleanedPath(oNewFullPath) _Logger.Info("Fullpath (ohne SZ) '" & oNewFullPath & "'") If Directory.Exists(oNewFullPath) = False Then Try Dim oCreatedPath = Directory.CreateDirectory(oNewFullPath) oNewFullPath = oCreatedPath.FullName _Logger.Info("Folder '" & oNewFullPath & "' wurde angelegt") Catch ex As Exception _Logger.Info("Error in CreateFolderforIndex-Method - Root Folder '" & oNewFullPath & "' could not be created. " & ex.Message) _Logger.Error(ex.Message) MsgBox("Attention: Root Folder '" & oNewFullPath & "' could not be created." & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End If My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oNewFullPath, Path.GetFileName(My.Application.Globix.CURRENT_NEWFILENAME)) Return True Catch ex As Exception MsgBox("Unexpected Error in CreateFolderforIndex-Method:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) _Logger.Warn("Fehler in CrFolderForIndex: " & ex.Message) _Logger.Error(ex) Return False End Try End Function Function GetAutoIndex_Value(indexname As String) Try For Each oDataRow As DataRow In My.Application.Globix.CURR_DT_MAN_INDEXE.Rows If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then Dim oIndexWert = oDataRow.Item("IndexValueGUI") Dim oIsIndexed = oDataRow.Item("Indexed") If oIsIndexed = True Then If oIndexWert.ToString <> String.Empty Then oIndexWert = oIndexWert.ToString ' If Index is a vectorfield (read: Value contains the VECTORSEPARATOR character), use the first value If oIndexWert.Contains(ClassConstants.VECTORSEPARATOR) Then Return oIndexWert.ToString.Split(ClassConstants.VECTORSEPARATOR).FirstOrDefault() Else ' Else just return the normal value Return oIndexWert End If Else ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Else ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Exit For End If Next Catch ex As Exception _Logger.Warn(" - Unvorhergesehener Unexpected error in GetAutoIndex_Value - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetAutoIndex_Value:") Return "" End Try End Function Function GetManIndex_Value(indexname As String, RequestFor As String, opt As Boolean) Try For Each DR As DataRow In My.Application.Globix.CURR_DT_MAN_INDEXE.Rows If DR.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then If DR.Item("Indexed") = True Then _Logger.Info("## Manueller Index: " & indexname) Select Case RequestFor Case "FILE" If DR.Item("IndexValue_File").ToString <> String.Empty Then _Logger.Info("Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & DR.Item("IndexValue_File").ToString) _Logger.Info("Zurückgegebener NachbearbeitungsWert: " & DR.Item("IndexValue_File")) Return DR.Item("IndexValue_File") Else If DR.Item("IndexValueGUI").ToString <> String.Empty Then _Logger.Info("Zurückgegebener manueller Indexwert: " & DR.Item("IndexValueGUI")) Return DR.Item("IndexValueGUI") Else If opt = False Then _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") ShowNotice("Indexed = True - Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") Return Nothing Else Return "" End If End If End If Case Else If DR.Item("IndexValueGUI").ToString <> String.Empty Then _Logger.Info("Zurückgegebener manueller Indexwert: " & DR.Item("IndexValueGUI")) Return DR.Item("IndexValueGUI") Else If opt = False Then _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") ShowNotice("Indexiert = True - Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") Return Nothing Else Return "" End If End If End Select Else ShowNotice("Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") Return Nothing End If Exit For End If Next Catch ex As Exception _Logger.Warn(" - Unvorhergesehener Unexpected error in GetManIndex_Value - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetManIndex_Value:") Return Nothing End Try End Function Function CheckWrite_IndexeMan(dokartid As Integer) '#### Zuerst manuelle Werte indexieren #### Try _Logger.Info("In CheckWrite_IndexeMan") Dim result 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 oIndexName = Replace(box.Name, "txt", "") Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {dokartid} AND INDEXNAME = '{oIndexName}'", "OPTIONAL", "") If optional_index = False Then MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, "Fehlende Eingabe:") box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") result = True End If Else If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then _Logger.Info(" - Der eingegebene Wert wurde nicht in der Datenbank gefunden") MsgBox("Der eingegebene Wert wurde nicht in der Datenbank gefunden!", MsgBoxStyle.Exclamation, "Fehlerhafte Indexierung:") box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) result = True End If End If End If If oControl.Name.StartsWith("cmbMulti") Then Dim oLookup = DirectCast(oControl, LookupControl3) Dim values As List(Of String) = oLookup.Properties.SelectedValues If values.Count = 0 Then Dim oIndexName = Replace(oLookup.Name, "cmbMulti", "") Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {dokartid} AND INDEXNAME = '{oIndexName}'", "OPTIONAL", "") If optional_index = False Then MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) oLookup.Focus() Return False Else Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") result = True End If Else Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, values) Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) result = True End If ElseIf oControl.Name.StartsWith("cmbSingle") Then Dim cmbSingle As TextBox = oControl If cmbSingle.Text = "" Then Dim oIndexName = Replace(cmbSingle.Name, "cmbSingle", "") Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = dokartid AND INDEXNAME = '{oIndexName}'", "OPTIONAL", "") If optional_index = False Then MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) cmbSingle.Focus() Return False Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") result = True End If Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) result = True End If ElseIf oControl.Name.StartsWith("cmb") Then Dim cmb As ComboBox = oControl If cmb.Text = "" Then Dim oIndexName = Replace(cmb.Name, "cmb", "") Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = dokartid AND INDEXNAME = '{oIndexName}'", "OPTIONAL", "") If optional_index = False Then MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) cmb.Focus() Return False Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") result = True End If Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) result = True End If End If If oControl.Name.StartsWith("dtp") Then Dim dtp As DevExpress.XtraEditors.DateEdit = oControl Dim oIndexName As String = Replace(dtp.Name, "dtp", "") If dtp.Text = String.Empty Then Dim optional_index As Boolean = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = dokartid AND INDEXNAME = '{oIndexName}'", "OPTIONAL", "") If optional_index = False Then MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) dtp.Focus() Return False Else Indexwert_Postprocessing(oIndexName, "") result = True End If Else Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) result = 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 End If If TypeOf (oControl) Is Button Then Continue For End If If oControl.Name.StartsWith("lbl") = False And result = False Then _Logger.Info("Die Überprüfung der manuellen Indices ist fehlerhaft. Bitte informieren Sie den Systembetreuer") Return False End If Next Return True Catch ex As Exception _Logger.Warn(" - Unvorhergesehener Fehler in CheckWrite_IndexeMan - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unerwarteter Unexpected error in CheckWrite_IndexeMan:") Return False End Try End Function Private Function SetAttachmentIndices() Dim indexierung_erfolgreich As Boolean = True Try Dim DT As DataTable = My.DatabaseECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = 'DEFAULT'") If DT.Rows.Count = 1 Then If Not My.Application.Globix.CURRENT_MESSAGEID Is Nothing Then If My.Application.Globix.CURRENT_MESSAGEID <> "" Then indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, My.Application.Globix.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 My.Application.Globix.CURRENT_MESSAGESUBJECT <> "" Then indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, My.Application.Globix.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 My.Application.Globix.CURRENT_MESSAGEDATE <> "" Then indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, My.Application.Globix.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 = _idbdata.SetVariableValue(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 _Logger.Error(ex) MsgBox("Error in SetAttachmentIndices:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Function Indexwert_checkValueDB(indexname As String, wert As String) Try Dim oRow As DataRow 'DT = DD_DMSLiteDataSet.VWINDEX_MAN For Each oRow In DT_INDEXEMAN.Rows If oRow.Item("NAME") = indexname Then If oRow.Item("SQL_CHECK").ToString <> String.Empty Then Dim connectionString As String Dim sql As String connectionString = My.DatabaseECM.Get_ConnectionStringforID(oRow.Item("CONNECTION_ID")) If connectionString <> "" Then Dim sqlscalar = oRow.Item("SQL_CHECK") Select Case oRow.Item("DATENTYP") Case "INTEGER" sqlscalar = sqlscalar.ToString.Replace("@manValue", wert) Case Else sqlscalar = sqlscalar.ToString.Replace("@manValue", "'" & wert & "'") End Select sql = sqlscalar Dim ergebnis As Integer 'If DR.Item("SQL_PROVIDER") = "Oracle" Then ' ergebnis = ClassDatabase.OracleExecute_Scalar(sql, connectionString) 'Else 'MSQL ergebnis = My.DatabaseECM.GetScalarValueWithConnection(sql, connectionString) ' End If Select Case ergebnis Case 1 Return True Case 2 ShowNotice("Indexwert nicht eindeutig: " & sql) Return False Case 99 Return False End Select End If Else Return True End If End If Next Catch ex As Exception MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_checkValue:") _Logger.Info(" - Unvorhergesehener Unexpected error in Indexwert_checkValue - Fehler: " & vbNewLine & ex.Message) Return False End Try End Function Function FillIndexe_Autom(dokart_id As Integer) Try Dim oSQL = $"SELECT * FROM VWDDINDEX_AUTOM WHERE DOCTYPE_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}" Dim oFilter = $"DOCTYPE_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID}" My.Application.Globix.CURR_DT_AUTO_INDEXE = _DataASorDB.GetDatatable("DD_ECM", oSQL, "VWDDINDEX_AUTOM", oFilter, "") Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}") If My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows.Count = 0 Then Return True End If ' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen For Each oAutoIndexRow As DataRow In My.Application.Globix.CURR_DT_AUTO_INDEXE.Rows _Logger.Info("Working on AutomaticIndex: " & oAutoIndexRow.Item("INDEXNAME") & "...") Dim oSqlResult As String = NotNull(oAutoIndexRow.Item("SQL_RESULT"), "") Dim oSqlActive As Boolean = NotNull(oAutoIndexRow.Item("SQL_ACTIVE"), False) Dim oSqlConnectionId As Integer = NotNull(oAutoIndexRow.Item("CONNECTION_ID"), -1) Dim oSqlProvider As String = NotNull(oAutoIndexRow.Item("SQL_PROVIDER"), "") Dim oEndResult As New List(Of String) ' Wenn kein SQL Befehl vorhanden oder aktiv ist, ' versuchen wir, die Spalte VALUE zu ersetzen If oSqlResult = String.Empty Or oSqlActive = 0 Then Dim oPlaceholderResult As String Dim oValue As String = NotNull(oAutoIndexRow.Item("VALUE"), "") oPlaceholderResult = GetPlaceholderValue(oValue, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) If Not IsNothing(oPlaceholderResult) Then oValue = oPlaceholderResult End If oAutoIndexRow.Item("Indexed") = True oAutoIndexRow.Item("IndexValueGUI") = oValue Continue For End If ' Wenn ein SQL Befehl vorhanden und aktiv ist ' Alle Platzhalter finden Dim oMatches As MatchCollection = oRegex.Matches(oSqlResult) For Each oMatch As Match In oMatches Dim oIndexValue As String = StripPlaceholder(oMatch.Value) Dim oOptionalIndex = False Dim oPlaceholderResult As String = Nothing Dim oManualIndexResult As String = Nothing ' Einfachen Platzhalter Wert erzeugen oPlaceholderResult = GetPlaceholderValue(oIndexValue, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) ' Einfachen Platzhalter ersetzen If Not IsNothing(oPlaceholderResult) Then oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult) End If oOptionalIndex = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{oIndexValue}'", "OPTIONAL", "") oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) ' Wenn Ergebnis den VektorPlatzhalter enthält, soll nichts ersetzt werden. ' Werden im nächsten Schritt ersetzt. If oManualIndexResult.Contains(ClassConstants.VECTORSEPARATOR) Then oManualIndexResult = Nothing End If If Not IsNothing(oManualIndexResult) Then oSqlResult = oSqlResult.Replace(oMatch.Value, oManualIndexResult) End If Next 'TODO: Replace Windream Patterns? oSqlResult = clsPatterns.ReplaceControlValues(oSqlResult, pnlIndex) oSqlResult = clsPatterns.ReplaceInternalValues(oSqlResult) If oSqlResult <> String.Empty Then _Logger.Debug("oSqlResult after Replace [" & oSqlResult & "]") End If ' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl, ' der nur noch vektorfelder-platzhalter enthält ' 2. Schritt: Vektorfelder ersetzen Dim oVectorMatches As MatchCollection = oRegex.Matches(oSqlResult) If oVectorMatches.Count > 0 Then _Logger.Info(" There are " & oVectorMatches.Count & " matches for vectors!") Dim oIsFirstMatch = True For Each oVectorMatch As Match In oVectorMatches Dim oIndexValue As String = StripPlaceholder(oVectorMatch.Value) Dim oOptionalIndex = False Dim oManualIndexResult As String = Nothing oOptionalIndex = My.Helpers.GetValueFromDatatable(My.Application.Globix.CURR_DT_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{oIndexValue}'", "OPTIONAL", "") oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) Dim oVectorIndexValues = oManualIndexResult.Split(ClassConstants.VECTORSEPARATOR).ToList() For Each oVectorIndexValue In oVectorIndexValues Dim oTempSql = oSqlResult.Replace(oVectorMatch.Value, oVectorIndexValue) Dim oResult = GetAutomaticIndexSQLValue(oTempSql, oSqlConnectionId, oSqlProvider) oEndResult.Add(oResult) Next ' Verhindert, dass die Schleife mehrmals durchlaufen wird If oIsFirstMatch Then Exit For End If oAutoIndexRow.Item("Indexed") = True oAutoIndexRow.Item("IndexValueGUI") = String.Join(ClassConstants.VECTORSEPARATOR, oEndResult.ToArray) Next Else Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider) _Logger.Info("Got a simple SQLResult: " & oResult.ToString) oAutoIndexRow.Item("Indexed") = True oAutoIndexRow.Item("IndexValueGUI") = oResult End If Next Return True Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message) Return False End Try End Function Function StripPlaceholder(Placeholder As String) As String Dim oResult = Placeholder oResult = Regex.Replace(oResult, "^\[%", "") oResult = Regex.Replace(oResult, "\]$", "") Return oResult End Function Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String Try Dim oConnectionString As String oConnectionString = My.DatabaseECM.Get_ConnectionStringforID(vconnectionID) If oConnectionString <> "" Then 'NEU Dim oErgebnis 'Welcher Provider? 'If vProvider.ToLower = "oracle" Then 'oErgebnis = My.Database.leExecute_Scalar(SQLCommand, oConnectionString) 'Else 'im Moment nur SQL-Server oErgebnis = My.DatabaseECM.GetScalarValueWithConnection(SQLCommand, oConnectionString) 'End If _Logger.Debug("SQL-ConnectionString: " & oConnectionString.Substring(0, oConnectionString.LastIndexOf("="))) If oErgebnis Is Nothing Then 'showlblhinweis("Kein Ergebnis für automatisches SQL: " & vsqlstatement) Return "" Else Return oErgebnis End If End If Catch ex As Exception _Logger.Warn(" - Unexpected error in Get_AutomatischerIndex_SQL - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_AutomatischerIndex_SQL:") Return "" End Try End Function Sub Indexwert_Postprocessing(indexname As String, wert_in As String) Try Dim value_post As String = "" For Each oDataRow As DataRow In My.Application.Globix.CURR_DT_MAN_INDEXE.Rows If oDataRow.Item("INDEXNAME") = indexname Then Dim idxid As Integer = oDataRow.Item("GUID") If idxid > 0 Then ' In jedem Fall schon mal den Wert einfügen oDataRow.Item("IndexValueGUI") = wert_in 'Die Nachbearbeitungsschritte laden 'FILE AND INDEX 'Zuerst nur die Fälle für die Variante ONLY FILE/FOLDER Dim DTNB As DataTable = My.Helpers.GetFilteredDatatable(My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING, $"IDXMAN_ID = {idxid} AND VARIANT = 'ONLY FILE/FOLDER'", "SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) oDataRow.Item("IndexValueGUI") = value_post oDataRow.Item("IndexValue_File") = value_post End If End If 'Jetzt die Fälle für die Variante FILE AND INDEX DTNB = Nothing DTNB = My.Helpers.GetFilteredDatatable(My.Application.Globix.CURR_INDEX_MAN_POSTPROCESSING, "IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX'", "SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) oDataRow.Item("IndexValueGUI") = value_post End If End If End If oDataRow.Item("Indexed") = True End If Next Catch ex As Exception _Logger.Warn(" - Unvorhergesehener Unexpected error in Indexwert_Postprocessing - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_Postprocessing:") End Try End Sub Private Function SetEmailIndices() Dim indexierung_erfolgreich As Boolean = False Dim _step As String = "1" Try Dim msg As Msg.Message = New Msg.Message(My.Application.Globix.CURRENT_NEWFILENAME) Dim msgDisplayTo = msg.DisplayTo Dim msgInternetAccountName = msg.InternetAccountName _Logger.Debug("") _Logger.Debug("msgInternetAccountName: " & msgInternetAccountName) _Logger.Debug("SenderName: " & msg.SenderName) _Logger.Debug("SenderEmailAddress: " & msg.SenderEmailAddress) _Logger.Debug("ReceivedByName: " & msg.ReceivedByName) _Logger.Debug("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress) _Logger.Debug("") _step = "2" 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 My.Application.Globix.DT_FUNCTION_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 = My.DatabaseECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = 'DEFAULT'") If IsNothing(DT) Then _Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX RESULTED in NOTHING") Return False End If If DT.Rows.Count = 1 Then _step = "3" My.Application.Globix.CURRENT_MESSAGEDATE = "" My.Application.Globix.CURRENT_MESSAGESUBJECT = "" 'Message-ID nur auswerten wenn vorher nicht gestzt wurde! If My.Application.Globix.CURRENT_MESSAGEID = "" Then If Not msg.InternetMessageId Is Nothing Then indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId) 'Die aktuelle Message-ID zwischenspeichern My.Application.Globix.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 My.Application.Globix.CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern) If IsNothing(My.Application.Globix.CURRENT_MESSAGEID) Then My.Application.Globix.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 = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_ID").ToStrin, My.Application.Globix.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 frmGlobixMissingInput.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 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 frmGlobixMissingInput.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 = _idbdata.SetVariableValue(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 = _idbdata.SetVariableValue(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 = 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("subj: " & subj) indexierung_erfolgreich = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, subj) My.Application.Globix.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 = _idbdata.SetVariableValue(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, msg.MessageDeliveryTime) My.Application.Globix.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 MsgBox("Error in SetEmailIndices:" & vbNewLine & ex.Message & vbNewLine & "Please check the configuration Email-Indexing!", MsgBoxStyle.Critical) _Logger.Warn("Error in SetEmailIndices (Step finisched: " & _step & "): " & ex.Message) _Logger.Error(ex) 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 Sub PictureEdit1_EditValueChanged(sender As Object, e As EventArgs) End Sub Private Sub btnAblageFlow_Click(sender As Object, e As EventArgs) Handles btnAblageFlow.Click GlobixFlow() End Sub End Class