Imports System.IO Imports System.Text.RegularExpressions Imports System.Text Imports System.Security.AccessControl Imports System.Security.Principal Imports DigitalData.Modules.Logging Imports DigitalData.Controls.LookupGrid Imports DigitalData.GUIs.GlobalIndexer Imports DevExpress.XtraEditors.Controls Imports Limilabs.Mail Imports DevExpress.XtraEditors Imports DigitalData.GUIs.Common Imports DigitalData.Modules.Base Public Class frmIndex #Region "+++++ Variablen ++++++" Public vPathFile As String Private MULTIFILES As Integer Private ReadOnly akttxtbox As TextBox Dim DT_INDEXEMAN As DataTable Public FormLoaded As Boolean = False Private Shared ReadOnly _Instance As frmIndex = Nothing Dim DropType As String Private Shared WMDirect As Boolean = False 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_DE = "Bitte vervollständigen Sie die Eingaben!" Private Const TEXT_MISSING_INPUT_EN = "Please complete your entries!" Private Const TEXT_CHECK_MANUAL_INDEXES_DE = "Die Überprüfung der manuellen Indexe ist fehlerhaft. Bitte informieren Sie Ihrenm Systembetreuer." Private Const TEXT_CHECK_MANUAL_INDEXES_EN = "There is an error in the validation settings of the manual indexes. Please inform your administrator." Private Const TEXT_CATCH_BLOCK_DE = "Unvorhergesehener Fehler in {0}: Fehlermeldung {1}" Private Const TEXT_CATCH_BLOCK_EN = "Unexpected Error in {0}: Errormessage {1}" Private Const LANG_DE = "de-DE" Private Property DocTypes As New List(Of DocType) Private ReadOnly _Logger As Logger Private ReadOnly _FormHelper As FormHelper Private ReadOnly _PostProcessing As ClassPostprocessing #End Region Public Class DocType Public Property Guid Public Property Name Public Overrides Function ToString() As String Return Name End Function End Class Private Sub ShowErrorMessage(Exception As Exception, MethodTitle As String, Optional MoreInfo As String = "") Dim oMessage As String Dim oMoreInfo As String = IIf(MoreInfo = "", "", "(" & MoreInfo & ")") If USER_LANGUAGE = LANG_DE Then oMessage = String.Format(TEXT_CATCH_BLOCK_DE, MethodTitle, Exception.Message) & oMoreInfo Else oMessage = String.Format(TEXT_CATCH_BLOCK_EN, MethodTitle, Exception.Message) & oMoreInfo End If _Logger.Warn(oMessage) _Logger.Error(Exception) MsgBox(oMessage, MsgBoxStyle.Critical, Text) End Sub Public Sub New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. _Logger = LOGCONFIG.GetLogger() _FormHelper = New FormHelper(LOGCONFIG, Me) _PostProcessing = New ClassPostprocessing(LOGCONFIG) Localizer.Active = New LookupGridLocalizer() End Sub Public Sub CloseViewer() If DocumentViewer1 Is Nothing Then LOGGER.Warn("DocumentViewer is already closed!") End If Try LOGGER.Debug("Calling CloseDocument on Viewer") DocumentViewer1.CloseDocument() Catch ex As Exception LOGGER.Warn("Calling CloseDocument on Viewer FAILED") LOGGER.Error(ex) End Try Try LOGGER.Debug("Calling Done on Viewer") DocumentViewer1?.Done() Catch ex As Exception LOGGER.Warn("Calling Done on Viewer FAILED") LOGGER.Error(ex) End Try End Sub Public Sub DisposeViewer() DocumentViewer1.Dispose() End Sub '#Region "+++++ Allgemeine Funktionen ++++++" 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 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 SetFilePreview(ShowPreview As Boolean) If ShowPreview Then SplitContainer1.Panel2Collapsed = False PreviewFile() checkItemPreview.Checked = True Else SplitContainer1.Panel2Collapsed = True checkItemPreview.Checked = False End If End Sub Sub addLabel(indexname As String, hinweis As String, ylbl As Integer, anz As String) Dim lbl As New Label With { .Name = "lbl" & indexname, .AutoSize = True, .Text = hinweis, .Location = New Point(11, ylbl) } pnlIndex.Controls.Add(lbl) End Sub Function Indexwert_checkValueDB(indexname As String, wert As String) Try Dim DR As DataRow 'DT = DD_DMSLiteDataSet.VWINDEX_MAN For Each DR In DT_INDEXEMAN.Rows If DR.Item("NAME") = indexname Then If DR.Item("SQL_CHECK").ToString <> String.Empty Then Dim connectionString As String Dim sql As String connectionString = DATABASE_ECM.Get_ConnectionStringforID(DR.Item("CONNECTION_ID")) If connectionString <> "" Then Dim sqlscalar = DR.Item("SQL_CHECK") Select Case DR.Item("DATENTYP") Case ClassConstants.INDEX_TYPE_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) LOGGER.Warn("Oracle is not supported") Else 'MSQL ergebnis = DATABASE_ECM.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 ShowErrorMessage(ex, "Indexwert_checkValue") Return False End Try End Function Function GetManIndex_Value(indexname As String, RequestFor As String, opt As Boolean) Try Dim DT As DataTable Dim DR As DataRow DT = MyDataset.VWDDINDEX_MAN For Each DR In DT.Rows If DR.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then If DR.Item("Indexiert") = True Then _Logger.Info("## Manueller Index: " & indexname) Select Case RequestFor Case "FILE" If DR.Item("Indexwert_File").ToString <> String.Empty Then _Logger.Info(" >>Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & DR.Item("Indexwert_File").ToString) _Logger.Info(" >>Zurückgegebener NachbearbeitungsWert: " & DR.Item("Indexwert_File")) Return DR.Item("Indexwert_File") Else If DR.Item("Indexwert").ToString <> String.Empty Then _Logger.Info("Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert")) Return DR.Item("Indexwert") 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 If Case Else If DR.Item("Indexwert").ToString <> String.Empty Then _Logger.Info(" >>Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert")) Return DR.Item("Indexwert") 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 ShowErrorMessage(ex, "GetManIndex_Value") Return Nothing End Try End Function Function GetAutoIndex_Value(indexname As String) Try Dim oDataTable As DataTable oDataTable = MyDataset.VWDDINDEX_AUTOM For Each oDataRow As DataRow In oDataTable.Rows If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then Dim oIndexWert = oDataRow.Item("Indexwert") Dim oIsIndexed = oDataRow.Item("Indexiert") 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 ShowErrorMessage(ex, "GetAutoIndex_Value") Return "" End Try End Function Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String Try Dim oConnectionString As String oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(vconnectionID) If oConnectionString <> "" Then 'NEU Dim oErgebnis 'Welcher Provider? If vProvider.ToLower = "oracle" Then 'oErgebnis = ClassDatabase.OracleExecute_Scalar(SQLCommand, oConnectionString) LOGGER.Warn("Oracle Database Queries are not supported") Else 'im Moment nur SQL-Server oErgebnis = DATABASE_ECM.GetScalarValueWithConnection(SQLCommand, oConnectionString) End If If LogErrorsOnly = False Then _Logger.Info(" >>SQL-ConnectionString: " & oConnectionString.Substring(0, oConnectionString.LastIndexOf("="))) End If 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 ShowErrorMessage(ex, "GetAutomaticIndexSQLValue") Return "" End Try End Function '#End Region '#Region "+++++ Funktionen bei OK - schliessen ++++++" Function CheckWrite_IndexeMan(oDocumentTypeId As Integer) '#### Zuerst manuelle Werte indexieren #### Try _Logger.Info("In CheckWrite_IndexeMan") 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 = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(box.Name, "txt", "") & "'") If optional_index = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, "Fehlende Eingabe:") Else MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, "Missing Input:") End If box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") oResult = True End If Else If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then Dim oMessage, oTitle As String If USER_LANGUAGE = LANG_DE Then oTitle = "Fehlerhafte Indexierung:" oMessage = "Der eingegebene Wert wurde nicht in der Datenbank gefunden!" Else oTitle = "Erroneous Indexing:" oMessage = "The value was not found in the Database!" End If _Logger.Info(oMessage) MsgBox(oMessage, MsgBoxStyle.Exclamation, oTitle) box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) oResult = True End If End If End If If oControl.Name.StartsWith("cmbMulti") Then Dim oLookup = DirectCast(oControl, DigitalData.Controls.LookupGrid.LookupControl3) Dim oValues As List(Of String) = oLookup.Properties.SelectedValues If oValues.Count = 0 Then Dim oIsOptionalIndex As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'") If oIsOptionalIndex = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) Else MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text) End If oLookup.Focus() Return False Else Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") oResult = True End If Else Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, oValues) Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) oResult = True End If ElseIf oControl.Name.StartsWith("cmbSingle") Then Dim cmbSingle As TextBox = oControl If cmbSingle.Text = "" Then Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'") If optional_index = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) Else MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text) End If cmbSingle.Focus() Return False Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") oResult = True End If Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) oResult = True End If ElseIf oControl.Name.StartsWith("cmb") Then Dim cmb As ComboBox = oControl If cmb.Text = "" Then Dim optional_index As Boolean = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & oDocumentTypeId & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'") If optional_index = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) Else MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text) End If cmb.Focus() Return False Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") oResult = True End If Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) oResult = 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 = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {oDocumentTypeId} AND NAME = '{oIndexName}'") If optional_index = False Then If USER_LANGUAGE = LANG_DE Then MsgBox(TEXT_MISSING_INPUT_DE, MsgBoxStyle.Exclamation, Text) Else MsgBox(TEXT_MISSING_INPUT_EN, MsgBoxStyle.Exclamation, Text) End If dtp.Focus() Return False Else Indexwert_Postprocessing(oIndexName, "") oResult = True End If Else Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) oResult = True End If End If If oControl.Name.StartsWith("chk") Then Dim chk As CheckEdit = oControl Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked) oResult = True End If If TypeOf (oControl) Is Button Then Continue For End If If oControl.Name.StartsWith("lbl") = False And oResult = False Then _Logger.Info(TEXT_CHECK_MANUAL_INDEXES_EN) Return False End If Next Return True Catch ex As Exception ShowErrorMessage(ex, "CheckWrite_IndexeMan") Return False End Try End Function Sub Indexwert_Postprocessing(indexname As String, wert_in As String) Try Dim DT As DataTable Dim DR As DataRow DT = MyDataset.VWDDINDEX_MAN Dim value_post As String = "" For Each DR In DT.Rows If DR.Item("INDEXNAME") = indexname Then Dim idxid As Integer = DR.Item("GUID") If idxid > 0 Then ' In jedem Fall schon mal den Wert einfügen DR.Item("Indexwert") = wert_in 'Die Nachbearbeitungsschritte laden 'FILE AND INDEX 'Zuerst nur die Fälle für die Variante ONLY FILE/FOLDER Dim DTNB As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'ONLY FILE/FOLDER' ORDER BY SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then value_post = _PostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) DR.Item("Indexwert") = wert_in DR.Item("Indexwert_File") = value_post End If End If 'Jetzt die Fälle für die Variante FILE AND INDEX DTNB = Nothing DTNB = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX' ORDER BY SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then value_post = _PostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) DR.Item("Indexwert") = value_post End If End If End If DR.Item("Indexiert") = True End If Next Catch ex As Exception ShowErrorMessage(ex, "Indexwert_Postprocessing") End Try End Sub Function Name_Generieren() Try _Logger.Debug("#### Name_Generieren ####") Dim sql As String = "select VERSION_DELIMITER, FILE_DELIMITER FROM TBDD_MODULES WHERE GUID = 1" Dim DT1 As DataTable = DATABASE_ECM.GetDatatable(sql) For Each row As DataRow In DT1.Rows FILE_DELIMITER = row.Item("FILE_DELIMITER") VERSION_DELIMITER = row.Item("VERSION_DELIMITER") Next Dim err As Boolean = False Dim folder_Created As Boolean = False Dim oRAWZielordner As String Dim extension As String = System.IO.Path.GetExtension(CURRENT_WORKFILE) Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKART_ID) sql_history_INSERT_INTO = "INSERT INTO TBGI_HISTORY (FILENAME_ORIGINAL,FILENAME_NEW" sql_history_Index_Values = "" Dim AnzahlIndexe As Integer = 1 CURR_DOKART_WD_DIRECT = DT.Rows(0).Item("WINDREAM_DIRECT") CURR_DOKART_OBJECTTYPE = DT.Rows(0).Item("OBJEKTTYP") CURR_WORKFILE_EXTENSION = extension oRAWZielordner = WINDREAM.GetNormalizedPath(DT.Rows(0).Item("ZIEL_PFAD"), True) oRAWZielordner = WINDREAM_BASEPATH & oRAWZielordner '#### ' 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 = DT.Rows(0).Item("NAMENKONVENTION") & CURR_WORKFILE_EXTENSION 'oRAWZielordner & "\" & DT.Rows(0).Item("NAMENKONVENTION") 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 Files 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 = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{Indexname}')") 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(CURRENT_WORKFILE)) Case "Username".ToUpper oNamenkonvention = oNamenkonvention.Replace(oElement.Value, Environment.UserName) Case "Usercode".ToUpper oNamenkonvention = oNamenkonvention.Replace(oElement.Value, 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(VERSION_DELIMITER, "") _neuername = _neuername.Replace(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 += 1 _neuername = Stammname.Replace(extension, "") & 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 CURRENT_NEWFILENAME = FILESYSTEM.GetCleanFilename(NewFileString) 'CURRENT_NEWFILENAME = ClassFilehandle.CleanFilename(NewFileString, "") CURRENT_NEWFILENAME = Path.Combine(oRAWZielordner, CURRENT_NEWFILENAME) _Logger.Debug("#### ENDE Name_Generieren ####") _Logger.Debug("") If err = False Then Return True Else Return False End If Catch ex As Exception ShowErrorMessage(ex, "Name_Generieren") Return False End Try End Function Private Function Write_Indizes() As Boolean Try _Logger.Info("Indexing file [{0}]", CURRENT_NEWFILENAME) Dim indexierung_erfolgreich As Boolean = False 'Manuelle Indexe Indexieren Dim DTMan As DataTable = MyDataset.VWDDINDEX_MAN If DTMan.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In DTMan.Rows Dim idxvalue = row.Item("Indexwert") Dim indexname = row.Item("WD_INDEX").ToString _Logger.Debug($"Write_Indizes - Index [{indexname}]...") Dim optional_Index = CBool(row.Item("OPTIONAL")) Dim indexiert = CBool(row.Item("Indexiert")) If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then If indexname <> String.Empty Then If row.Item("SAVE_VALUE") = True Then 'Den Indexwert zwischenspeichern Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS Dim rowexists As Boolean = False For Each rowTemp As DataRow In DTTemp.Rows 'Wenn bereits ein Eintrag existiert..... If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then rowexists = True '......überschreiben rowTemp.Item("Value") = row.Item("Indexwert") End If Next '.....ansonsten neu anlegen If rowexists = False Then Dim newRow As DataRow = DTTemp.NewRow() newRow("Dokumentart") = row.Item("DOKUMENTART").ToString newRow("Indexname") = row.Item("INDEXNAME").ToString newRow("Value") = row.Item("Indexwert") DTTemp.Rows.Add(newRow) End If End If _Logger.Debug($"Manueller Indexvalue [{idxvalue}]...NOW THE INDEXING...") Count += 1 ' den Typ des Zielindexes auslesen Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname) _Logger.Debug($"oIndexType [{oIndexType}]...") If oIndexType < WINDREAM.WMObjectVariableValueTypeVector Then _Logger.Debug($"Indexing oIndexType < WINDREAM.WMObjectVariableValueTypeVector...") indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE) Else Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR) Dim oListofString As New List(Of String) If oSplitArray.Count = 0 Then oListofString.Add(idxvalue) Else For Each oStr In oSplitArray oListofString.Add(oStr) Next End If indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) End If 'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue) If indexierung_erfolgreich = False Then MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical) Return False Exit For End If Else _Logger.Debug("No Indexing: indexname: " & indexname) _Logger.Debug("No Indexing: is optional? " & optional_Index.ToString) End If Else _Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname) _Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname) End If Next End If 'Automatische Indexe Indexieren Dim DTAut As DataTable = MyDataset.VWDDINDEX_AUTOM If DTAut.Rows.Count > 0 Then Dim Count As Integer = 0 For Each row As DataRow In DTAut.Rows Dim indexiert = CBool(row.Item("Indexiert")) Dim Indexvalue = row.Item("Indexwert").ToString Dim indexname = row.Item("INDEXNAME").ToString If indexiert = True And Indexvalue <> "" Then If Indexvalue <> "EMPTY_OI" Then _Logger.Info("Auto Indexname: " & indexname.ToString) _Logger.Info("Indexvalue: " & Indexvalue.ToString) Count += 1 ' den Typ des Zielindexes auslesen Dim indexType As Integer = WINDREAM.GetIndexType(indexname) If indexType < WINDREAM.WMObjectVariableValueTypeVector Then indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) Else Dim oSplitArray = Split(Indexvalue, ClassConstants.VECTORSEPARATOR) Dim oListofString As New List(Of String) If oSplitArray.Count = 0 Then oListofString.Add(Indexvalue) Else For Each oStr In oSplitArray oListofString.Add(oStr) Next End If indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) End If 'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) If indexierung_erfolgreich = False Then MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical) Return False Exit For End If End If End If Next End If If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".MSG") Or CURRENT_NEWFILENAME.ToUpper.EndsWith(".EML") Then indexierung_erfolgreich = SetEmailIndicies(pIndexAttachment:=False) If indexierung_erfolgreich = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then indexierung_erfolgreich = SetEmailIndicies(pIndexAttachment:=True) If indexierung_erfolgreich = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If End If Catch ex As Exception ShowErrorMessage(ex, "Write_Indizes") Return False Finally End Try Return True End Function Private Function WriteIndex2File(pIndexName As String, pIndexValue As String) Try _Logger.Info($"Indexing with Name {pIndexName} and Value: {pIndexValue}") Return WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, pIndexName, pIndexValue, CURR_DOKART_OBJECTTYPE) Catch ex As Exception ShowErrorMessage(ex, "WriteIndex2File") Return False End Try End Function Private Function SetEmailIndicies(pIndexAttachment As Boolean) As Boolean Try Dim oIndexNames As Dictionary(Of String, Object) Dim oSQL As String = $"SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '{CURR_DOKART_OBJECTTYPE}'" Dim oTable As DataTable = DATABASE_ECM.GetDatatable(oSQL) If IsNothing(oTable) Then _Logger.Info("Could not get Email Indicies for DocType = [{0}]. Exiting.", CURR_DOKART_OBJECTTYPE) Return False End If If oTable.Rows.Count = 0 Then LOGGER.Warn("Could not get Email Indicies for DocType = [{0}]. Exiting.") Return False End If If oTable.Rows.Count > 1 Then LOGGER.Warn("Got multiple rows for Email Indicies for DocType = [{0}]. Exiting.") Return False End If Dim oRow As DataRow = oTable.Rows.Item(0) ' If file is an email files (eml,msg) parse it to extract email data and save for later ' If file is an attachment, rely on the previously extracted value If pIndexAttachment = False Then LOGGER.Debug("Indexing Email File: [{0}]", CURRENT_NEWFILENAME) ' This cannot use Path.Combine, otherwise the WINDREAM_BASEPATH will be swallowed... lol 'Dim oMsgFilePath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME) Dim oMsgFilePath As String = CURRENT_NEWFILENAME If CURRENT_NEWFILENAME.StartsWith(WINDREAM_BASEPATH) = False Then oMsgFilePath = WINDREAM_BASEPATH & oMsgFilePath End If Dim oMail As IMail = EMAIL.Load_Email(oMsgFilePath) Dim oMessageId As String = oMail.MessageID LOGGER.Debug("MessageId: [{0}]", oMessageId) Dim oMessageFrom As String = EMAIL.Get_MessageSender(oMail) Dim oMessageTo As String = EMAIL.Get_MessageReceiver(oMail) Dim oDateIn As Date = EMAIL.Get_MessageDate(oMail) Dim oSubject As String = oMail.Subject CURRENT_MESSAGEID = oMessageId CURRENT_MESSAGEDATE = oDateIn CURRENT_MESSAGESUBJECT = oSubject oIndexNames = New Dictionary(Of String, Object) From { {"IDX_EMAIL_ID", oMessageId}, {"IDX_EMAIL_FROM", oMessageFrom}, {"IDX_EMAIL_TO", oMessageTo}, {"IDX_EMAIL_SUBJECT", oSubject}, {"IDX_EMAIL_DATE_IN", oDateIn} } Else oIndexNames = New Dictionary(Of String, Object) From { {"IDX_EMAIL_ID", CURRENT_MESSAGEID}, {"IDX_EMAIL_SUBJECT", CURRENT_MESSAGESUBJECT}, {"IDX_EMAIL_DATE_IN", CURRENT_MESSAGEDATE}, {"IDX_CHECK_ATTACHMENT", True} } End If For Each oIndex In oIndexNames Try If oIndex.Value Is Nothing Then LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) Continue For End If If TypeOf oIndex.Value Is String AndAlso oIndex.Value = String.Empty Then LOGGER.Warn("Value for Index [{0}] was empty. Skipping.", oIndex.Key) Continue For End If Dim oIndexingSuccessful = WriteIndex2File(oRow.Item(oIndex.Key), oIndex.Value) If oIndexingSuccessful = False Then MsgBox($"Error while Indexing Email at Index [{oIndex.Key}]", MsgBoxStyle.Critical) Return False End If Catch ex As Exception LOGGER.Warn("Error while Indexing Email at Index [{0}]", oIndex.Key) LOGGER.Error(ex) Return False End Try Next Return True Catch ex As Exception LOGGER.Error(ex) Return False End Try End Function 'Private Function SetEmailIndicesOld() ' Dim indexierung_erfolgreich As Boolean = False ' Dim _step As String = "1" ' Try ' Dim oTempPath As String = Path.Combine(WINDREAM_BASEPATH, CURRENT_NEWFILENAME) ' Dim msg As Msg.Message = New Msg.Message(oTempPath) ' Dim msgDisplayTo = msg.DisplayTo ' Dim msgInternetAccountName = msg.InternetAccountName ' If LogErrorsOnly = False Then ' _Logger.Info("") ' _Logger.Info("msgInternetAccountName: " & msgInternetAccountName) ' _Logger.Info("SenderName: " & msg.SenderName) ' _Logger.Info("SenderEmailAddress: " & msg.SenderEmailAddress) ' _Logger.Info("ReceivedByName: " & msg.ReceivedByName) ' _Logger.Info("ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress) ' _Logger.Info("") ' End If ' _step = "2" ' 'Console.WriteLine("Subject: " + msg.Subject) ' 'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime) ' 'Console.WriteLine("SenderName: " + msg.SenderName) ' 'Console.WriteLine("SenderEmailAddress: " + msg.SenderEmailAddress) ' 'Console.WriteLine("ReceivedByName: " + msg.ReceivedByName) ' 'Console.WriteLine("ReceivedByEmailAddress: " + msg.ReceivedByEmailAddress) ' 'Console.WriteLine("DisplayTo: " + msg.DisplayTo) ' 'Console.WriteLine("DisplayCc: " + msg.DisplayCc) ' 'Console.WriteLine("Body: " + msg.Body) ' 'Console.WriteLine("-----------------------------------------------------------------------") ' 'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText) ' Dim fromPattern As String = "" ' Dim toPattern As String = "" ' Dim messageIDPattern As String = "" ' Dim finalize_pattern As String = "" ' ' Email Header auslesen ' Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg) ' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows ' If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then ' fromPattern = rowregex.Item("REGEX") ' ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then ' toPattern = rowregex.Item("REGEX") ' ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then ' messageIDPattern = rowregex.Item("REGEX") ' ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then ' finalize_pattern = rowregex.Item("REGEX") ' End If ' Next ' Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") ' If IsNothing(DT) Then ' _Logger.Info("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "' RESULTED in NOTHING") ' Return False ' End If ' If DT.Rows.Count = 1 Then ' _step = "3" ' CURRENT_MESSAGEDATE = "" ' CURRENT_MESSAGESUBJECT = "" ' 'Message-ID nur auswerten wenn vorher nicht gestzt wurde! ' If CURRENT_MESSAGEID = "" Then ' If Not msg.InternetMessageId Is Nothing Then ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, msg.InternetMessageId) ' 'Die aktuelle Message-ID zwischenspeichern ' CURRENT_MESSAGEID = msg.InternetMessageId ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) ' Return False ' End If ' Else ' If messageIDPattern = String.Empty Then ' _Logger.Info("A messageID could not be read!") ' Else ' If Not IsNothing(headers) Then ' CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern) ' If IsNothing(CURRENT_MESSAGEID) Then ' CURRENT_MESSAGEID = "" ' End If ' Else ' _Logger.Info("A messageID could not be read - messageheader nothing/messagIDpattern value!") ' End If ' End If ' End If ' Else ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetEmailIndices-EmailID - See log", MsgBoxStyle.Critical) ' Return False ' End If ' End If ' _step = "4" ' ' Regular Expressions vorbereiten ' If fromPattern <> "" And toPattern <> "" Then ' _step = "4.1" ' Dim FromRegexList As New List(Of Regex) ' Dim ToRegexList As New List(Of Regex) ' Dim fromRegex As New Regex(fromPattern, RegexOptions.IgnoreCase) ' Dim toRegex As New Regex(toPattern, RegexOptions.IgnoreCase) ' FromRegexList.Add(fromRegex) ' ToRegexList.Add(toRegex) ' Dim emailFrom ' Dim emailTo ' ' Email Absender und Empfänger ' If headers Is Nothing Then ' _step = "4.2" ' If IsNothing(msgDisplayTo) Then ' _step = "4.3" ' _Logger.Info("DisplayTo in email is nothing - default will be set") ' emailTo = "NO RECIPIENT" ' Else ' _step = "4.4" ' emailTo = msgDisplayTo.ToString.Replace("'", "") ' End If ' If IsNothing(msgInternetAccountName) Then ' _step = "4.5" ' _Logger.Info("InternetAccountName in email is nothing - default will be set") ' emailFrom = "" ' Else ' _step = "4.6" ' emailFrom = msgInternetAccountName.ToString.Replace("'", "") ' End If ' Else ' _step = "5" ' _Logger.Info("emailTo and From Extraction via messageheader.") ' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(headers, fromPattern) 'FromRegexList) ' emailTo = ClassEmailHeaderExtractor.extractFromHeader(headers, toPattern) ' extractToAddress(headers, ToRegexList) ' 'Handler für leere emailTo-Adresse ' If IsNothing(emailTo) Then ' _step = "5.1" ' _Logger.Info("emailTo couldn't be extracted from messageheader...") ' If (headers.Contains("exc") Or headers.Contains("exchange")) Then ' _step = "5.2" ' _Logger.Info("...try with LDAP-option") ' Dim _email = GetUserEmailfromLDAP(msgDisplayTo) ' _step = "5.3" ' If _email <> "" Then ' emailTo = _email ' Else ' _Logger.Info(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'") ' MsgBox("Could't get 'emailto' from messageHeader and later on with LDAP-Option." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) ' Return False ' End If ' Else ' _step = "5.4" ' CURR_MISSING_PATTERN_NAME = "Email To" ' CURR_MISSING_SEARCH_STRING = headers ' CURR_MISSING_MANUAL_VALUE = String.Empty ' frmMissingInput.ShowDialog() ' _step = "5.4.1" ' If CURR_MISSING_MANUAL_VALUE <> String.Empty Then ' _step = "5.4.2" ' emailTo = CURR_MISSING_MANUAL_VALUE ' Else ' _step = "5.4.3" ' _Logger.Info("no exchange patterns found in headers!") ' MsgBox("Could't get 'emailto' from messageHeader and exhange-Patterns weren't found." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) ' Return False ' End If ' End If ' End If ' _step = "6" ' emailTo = ClassEmailHeaderExtractor.extractFromHeader(emailTo, finalize_pattern) ' emailFrom = ClassEmailHeaderExtractor.extractFromHeader(emailFrom, finalize_pattern) ' _step = "6.1" ' If Not IsNothing(emailFrom) Then ' emailFrom = emailFrom.Replace("<", "") ' emailFrom = emailFrom.Replace(">", "") ' Else ' _step = "6.1.x" ' _Logger.Info("emailFrom is Nothing?!") ' End If ' 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("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 ' _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 ' Return indexierung_erfolgreich ' End If ' Catch ex As Exception ' ShowErrorMessage(ex, "SetEmailIndices") ' Return False ' End Try 'End Function 'Public Function GetUserEmailfromLDAP(ByVal userName As String) As String ' Dim domainName As String = Environment.UserDomainName '"PutYourDomainNameHere" '< Change this value to your actual domain name. For example: "yahoo" ' Dim dommain As String = "com" '> Unexpected Error in GetUserEmail from LDAP: " & ex.Message) ' _Logger.Error(ex) ' End Try ' End Using ' Return userEmail 'End Function 'Private Function SetAttachmentIndices() ' Dim indexierung_erfolgreich As Boolean = True ' Try ' Dim DT As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & CURR_DOKART_OBJECTTYPE & "'") ' If DT.Rows.Count = 1 Then ' If Not CURRENT_MESSAGEID Is Nothing Then ' If CURRENT_MESSAGEID <> "" Then ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_ID").ToString, CURRENT_MESSAGEID) ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices MESSAGE-ID - See log", MsgBoxStyle.Critical) ' Return False ' End If ' End If ' End If ' 'Das Subject speichern ' If CURRENT_MESSAGESUBJECT <> "" Then ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, CURRENT_MESSAGESUBJECT) ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices SUBJECT - See log", MsgBoxStyle.Critical) ' Return False ' End If ' End If ' 'Das MesageDate speichern ' If CURRENT_MESSAGEDATE <> "" Then ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_DATE_IN").ToString, CURRENT_MESSAGEDATE) ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices DATE - See log", MsgBoxStyle.Critical) ' Return False ' End If ' End If ' 'Kennzeichnen das es ein Anhang war! ' indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_CHECK_ATTACHMENT").ToString, True) ' If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices ATTACHMENT Y/N - See log", MsgBoxStyle.Critical) ' Return False ' End If ' Return indexierung_erfolgreich ' End If ' Catch ex As Exception ' ShowErrorMessage(ex, "SetAttachmentIndices") ' Return False ' End Try 'End Function Private Function SINGLEFILE_2_WINDREAM(_Objekttyp As String) As Boolean Try CURR_DOKART_OBJECTTYPE = _Objekttyp Dim oWMCheckPath = WINDREAM.VersionWMFilename(CURRENT_NEWFILENAME, System.IO.Path.GetExtension(CURRENT_NEWFILENAME)) If CURRENT_NEWFILENAME.ToUpper <> oWMCheckPath.ToString.ToUpper Then _Logger.Info($"Target [{CURRENT_NEWFILENAME}] already existed!! - NewWMFilename [{oWMCheckPath}]") CURRENT_NEWFILENAME = oWMCheckPath End If Dim oStreamSuccessful = WINDREAM.NewFileStream(CURRENT_WORKFILE, CURRENT_NEWFILENAME, CURR_DOKART_OBJECTTYPE) Dim oTempPath As String = WINDREAM_BASEPATH & CURRENT_NEWFILENAME _Logger.Debug("Checks for file [{0}]", oTempPath) _Logger.Debug("File streamed to Windream: {0}", oStreamSuccessful) _Logger.Debug("File exists in Destination: {0}", File.Exists(oTempPath)) Return oStreamSuccessful Catch ex As Exception ShowErrorMessage(ex, "SINGLEFILE_2_WINDREAM") Return False End Try End Function Function Move_Rename_Only(Quelle As String, _NewFilename As String, extension As String, _versionTz As String) 'Überprüfen ob File existiert If File.Exists(_NewFilename) = False Then CURRENT_NEWFILENAME = _NewFilename Else 'Versionieren Dim version As Integer = 1 Dim Stammname As String = _NewFilename Dim neuername As String = _NewFilename Do While File.Exists(neuername) version += 1 neuername = Stammname.Replace(extension, "") & _versionTz & version & extension CURRENT_NEWFILENAME = neuername Loop End If 'Die Datei wird nun an den neuen Ort kopiert My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME) 'If CURR_DELETE_ORIGIN = True Then ' My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME) 'Else ' My.Computer.FileSystem.CopyFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME) 'End If Dim Insert_String As String Try Dim oCurrentWorkfile = CURRENT_WORKFILE.Replace("'", "''") Dim oCurrentNewFilename = CURRENT_NEWFILENAME.Replace("'", "''") Dim oUser As String = $"{Environment.UserDomainName}\{Environment.UserName}" Insert_String = sql_history_INSERT_INTO & $",ADDED_WHO, ADDED_WHERE, FILE_HASH) VALUES ('{oCurrentWorkfile}','{oCurrentNewFilename}'{sql_history_Index_Values},'{oUser}','{Environment.MachineName}','{CURRENT_WORKFILE_HASH}')" If DATABASE_ECM.ExecuteNonQuery(Insert_String) = True Then If CURRENT_MESSAGEID <> "" Then Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" Dim GUID = DATABASE_ECM.GetScalarValue(max) Try If GUID > 0 Then Dim sql As String If CURRENT_ISATTACHMENT = True Then sql = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID DATABASE_ECM.GetScalarValue(sql) Else sql = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID DATABASE_ECM.GetScalarValue(sql) End If End If Catch ex As Exception End Try End If End If Return False Catch ex As Exception ShowErrorMessage(ex, "Move_Rename_Only") Return True End Try End Function '#End Region Private Sub frmIndex_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing If File.Exists(CURRENT_FILENAME) Then 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) Else MsgBox($"Please Index file completely{vbNewLine}(Abort 1 of Indexdialog)", MsgBoxStyle.Information) End If 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) 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 ABORT_INDEXING = True Dim sql As String = $"SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('{Environment.UserName}')" Dim DT As DataTable = DATABASE_ECM.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 DATABASE_ECM.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then If containsfw_file = True Then If USER_LANGUAGE = LANG_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 INDEXING_ACTIVE = False CloseViewer() ClassWindowLocation.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 INDEXING_ACTIVE = False CloseViewer() ClassWindowLocation.SaveFormLocationSize(Me) My.Settings.Save() Catch ex As Exception ShowErrorMessage(ex, "Form Close") End Try End Select Else INDEXING_ACTIVE = False End If End Sub Private Sub frmIndex_Load(sender As Object, e As System.EventArgs) Handles Me.Load ' Abbruchzähler zurücksetzen CancelAttempts = 0 INDEXING_ACTIVE = True Try CURRENT_ISATTACHMENT = False DropType = DATABASE_ECM.GetScalarValue("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID) CURR_DELETE_ORIGIN = CONFIG.Config.DeleteOriginalFile checkItemDeleteSource.Enabled = True checkItemDeleteSource.Checked = CONFIG.Config.DeleteOriginalFile VIEWER_LICENSE = DATABASE_ECM.GetScalarValue("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'") DocumentViewer1.Init(LOGCONFIG, VIEWER_LICENSE) If DropType Is Nothing Then _Logger.Debug("File with Id [{0}] was not found in TBGI_FILES_USER. Exiting.", CURRENT_WORKFILE_GUID) CancelAttempts = MaxCancelAttempts Close() Else 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 CURR_DELETE_ORIGIN = True checkItemDeleteSource.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 CURR_DELETE_ORIGIN = False checkItemDeleteSource.Visibility = DevExpress.XtraBars.BarItemVisibility.Never Else checkItemDeleteSource.Visibility = DevExpress.XtraBars.BarItemVisibility.Always End If If DropType = "|DROPFROMFSYSTEM|" Then If USER_LANGUAGE <> LANG_DE Then Me.Text = "Indexing of dropped file" Else Me.Text = "Indexierung der gedroppten Datei" End If ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Then Select Case DropType Case "|FW_MSGONLY|" _Logger.Info(".msg-file from folderwatch") If USER_LANGUAGE <> LANG_DE Then Me.Text = "Indexing of msg-File (without Attachments) - from Folderwatch" Else Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch" End If Case "|OUTLOOK_MESSAGE|" _Logger.Info(".msg-file through dragdrop") If USER_LANGUAGE <> LANG_DE Then Me.Text = "Indexing of msg-File (without Attachments)" Else Me.Text = "Indexierung der msg-Datei (ohne Anhang)" End If End Select ElseIf DropType = "|MSGONLY|" Then If USER_LANGUAGE = LANG_DE Then Me.Text = "Indexierung der msg-Datei (ohne Anhang)" Else Me.Text = "Indexing of msg-File (without Attachments)" End If ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then CURRENT_ISATTACHMENT = True If USER_LANGUAGE = LANG_DE Then Me.Text = "Indexierung eines Email-Attachments" Else Me.Text = "Indexing of email-Attachment" End If ElseIf DropType = "|FW_SIMPLEINDEXER|" Then If USER_LANGUAGE = LANG_DE Then Me.Text = "Indexierung einer Folderwatch-Datei" Else Me.Text = "Indexing of Folderwatch-File" End If End If labelFilePath.Caption = CURRENT_WORKFILE ClassWindowLocation.LoadFormLocationSize(Me) SetFilePreview(CONFIG.Config.FilePreview) SplitContainer1.SplitterDistance = CONFIG.Config.SplitterDistanceViewer Load_String() DTTBGI_REGEX_DOCTYPE = DATABASE_ECM.GetDatatable("SELECT DISTINCT T1.DOCTYPE as DocType, T.* FROM TBGI_REGEX_DOCTYPE T, VWGI_DOCTYPE T1 WHERE T.DOCTYPE_ID = T1.DOCTYPE_ID") MULTIFILES = DATABASE_ECM.GetScalarValue("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") MULTIINDEXING_ACTIVE = False If MULTIFILES > 0 Then If USER_LANGUAGE = LANG_DE Then checkMultiindex.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" Else checkMultiindex.Text = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically" End If checkMultiindex.Checked = False checkMultiindex.Visible = True BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Else checkMultiindex.Visible = False BarButtonItem1.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If End If Catch ex As Exception ShowErrorMessage(ex, "Form Open") End Try End Sub Sub Load_String() Try Me.VWDDINDEX_MANTableAdapter.Connection.ConnectionString = MyConnectionString Me.VWINDEX_AUTOMTableAdapter.Connection.ConnectionString = MyConnectionString Catch ex As Exception _Logger.Warn(" - Unexpected error in Speichern der Verbindung - Fehler: " & vbNewLine & ex.Message) _Logger.Error(ex.Message) MsgBox("Unexpected error in Speichern der Verbindung: " & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Private Sub frmIndex_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown BringToFront() Focus() Cursor = Cursors.Default Refresh_Dokart() pnlIndex.Controls.Clear() checkItemTopMost.Checked = CONFIG.Config.TopMost TopMost = CONFIG.Config.TopMost BringToFront() FormLoaded = True Try _Logger.Info("Profile Preselected enabled: {0}", CONFIG.Config.ProfilePreselection) ' Letzte Auswahl merken überschreibt die automatische selektion If CONFIG.Config.ProfilePreselection Then checkItemPreselection.Checked = True If CURRENT_LASTDOKART <> "" Then _Logger.Info("Last Saved DocType: {0}", CURRENT_LASTDOKART) Dim oDocTypes As List(Of DocType) = DocTypes Dim oFoundDocType = oDocTypes. Where(Function(dt) dt.Name = CURRENT_LASTDOKART). FirstOrDefault() If oFoundDocType IsNot Nothing Then _Logger.Info("Setting Last Saved DocType: {0}", CURRENT_LASTDOKART) ComboboxDoctype.EditValue = oFoundDocType End If End If End If Dim oApplyRegex = ComboboxDoctype.EditValue Is Nothing And DTTBGI_REGEX_DOCTYPE.Rows.Count > 0 _Logger.Info("Applying Profile Selection Regex: [{0}]", oApplyRegex) If oApplyRegex Then For Each oRoW As DataRow In DTTBGI_REGEX_DOCTYPE.Rows Dim oOnlyFilename = Path.GetFileName(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 oDoctypes As List(Of DocType) = DocTypes Dim oFoundDocType As DocType = oDoctypes. Where(Function(dt) dt.Guid = oRoW.Item("DOCTYPE_ID")). FirstOrDefault() If oFoundDocType IsNot Nothing Then _Logger.Debug("DocType found: [{0}]", oFoundDocType) ComboboxDoctype.EditValue = oFoundDocType Exit For End If End If Next End If Catch ex As Exception ShowErrorMessage(ex, "Form Shown") End Try End Sub Sub Refresh_Dokart() Try Dim sql = String.Format("SELECT DISTINCT DOCTYPE_ID, DOCTYPE, SEQUENCE FROM VWGI_DOCTYPE where USERNAME = '{0}' ORDER BY SEQUENCE", Environment.UserName) _Logger.Info("SQL DoctypeList: " & sql) Dim oDoctypes = DATABASE_ECM.GetDatatable(sql) ComboboxDoctype.EditValue = Nothing ComboboxDoctype.Properties.DataSource = Nothing DocTypes.Clear() For Each oRow As DataRow In oDoctypes.Rows Dim oDocType = New DocType With { .Guid = oRow.Item("DOCTYPE_ID"), .Name = oRow.Item("DOCTYPE") } DocTypes.Add(oDocType) Next ComboboxDoctype.Properties.DataSource = DocTypes Catch ex As Exception ShowErrorMessage(ex, "Refresh_Dokart") End Try End Sub Private Sub ComboBoxEdit1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboboxDoctype.EditValueChanged If ComboboxDoctype.EditValue IsNot Nothing And FormLoaded = True Then Dim oSelectedItem As DocType = ComboboxDoctype.EditValue CURRENT_DOKART_ID = oSelectedItem.Guid CURRENT_LASTDOKART = oSelectedItem.Name 'lblhinweis.Visible = False ClearNotice() 'lblerror.Visible = False ClearError() pnlIndex.Controls.Clear() Dim sql As String = "Select WINDREAM_DIRECT, ZIEL_PFAD, DUPLICATE_HANDLING from TBDD_DOKUMENTART WHERE GUID = " & oSelectedItem.Guid Dim oDoctypes As DataTable = DATABASE_ECM.GetDatatable(sql) Dim oDocType As DataRow = oDoctypes.Rows.Item(0) WMDirect = oDocType.Item("WINDREAM_DIRECT") Dim oDestination As String = oDocType.Item("ZIEL_PFAD") Dim oNewDestination As String If WMDirect Then Dim oNormalized As String = WINDREAM.GetNormalizedPath(oDestination, False) oNewDestination = Path.Combine(WINDREAM.ClientBasePath, oNormalized) Else oNewDestination = oDestination End If LOGGER.Debug("Path from Database is [{0}]", oDestination) LOGGER.Debug("Checking for path [{0}]", oNewDestination) Dim oPathExists As Boolean If WMDirect Then oPathExists = WINDREAM.TestFolderExists(oNewDestination) Else oPathExists = Directory.Exists(oNewDestination) End If If oPathExists = False Then Dim oMessage As String If USER_LANGUAGE = "de-DE" Then oMessage = $"Der Pfad für das ausgewählte Profil ist nicht erreichbar:{vbNewLine}[{oNewDestination}].{vbNewLine}{vbNewLine}Bitte wählen Sie ein anderes Profil." Else oMessage = $"Profile Path is not available:{vbNewLine}[{oNewDestination}].{vbNewLine}{vbNewLine}Please select another profile." End If MsgBox(oMessage, MsgBoxStyle.Information, Text) ComboboxDoctype.EditValue = Nothing Else CURRENT_DOKART_DUPLICATE_HANDLING = oDocType.Item("DUPLICATE_HANDLING") Refresh_IndexeMan(oSelectedItem.Guid) End If End If End Sub Private Sub Refresh_IndexeMan(dokartid As Integer) Dim sql Try sql = "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" DT_INDEXEMAN = DATABASE_ECM.GetDatatable(sql) pnlIndex.Visible = True LoadIndexe_Man() Catch ex As System.Exception ShowErrorMessage(ex, "Refresh_IndexeMan", "DOKART-ID: " & dokartid) End Try End Sub ' _ Function Check_HistoryValues(Indexname As String, Dokart As String) As String Try Dim result = Nothing Dim DT As DataTable = MyDataset.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 ShowErrorMessage(ex, "Check_HistoryValues") Return Nothing End Try End Function 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 _Logger.Info("Loading Indicies for Screen Scaling Factor [{0}]", oDpiscale) Dim oControls As New ControlCreator(LOGCONFIG, pnlIndex, Me) With { .OnControlChanged = AddressOf PrepareDependingControl, .OnLookupData = AddressOf GetLookupData } 'Dim oControls As New ClassControls(pnlIndex, Me) If DT_INDEXEMAN.Rows.Count = 0 Then ' ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert") '_Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert") ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.Text & " definiert") _Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & ComboboxDoctype.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 = oRow.ItemEx("CONNECTION_ID", 0) Dim oSQLSuggestion = oRow.Item("SUGGESTION") Dim oSQLResult = oRow.Item("SQL_RESULT") LOGGER.Debug("IndexName: {0}", oControlName) LOGGER.Debug("SQL: {0}", oSQLResult) If oDataType <> ClassConstants.INDEX_TYPE_BOOLEAN Then addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount) End If Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART")) If DefaultValue Is Nothing Then DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), CURRENT_WORKFILE, USER_SHORTNAME) End If Select Case oDataType Case ClassConstants.INDEX_TYPE_BOOLEAN Dim chk As CheckEdit = oControls.AddCheckBox(oControlName, oControlPosition, DefaultValue, oRow.Item("COMMENT").ToString) If Not IsNothing(chk) Then pnlIndex.Controls.Add(chk) End If Case ClassConstants.INDEX_TYPE_INTEGER If (oSQLSuggestion = True And oSQLResult.ToString.Length > 0) Or MultiSelect = True Then Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oSQLResult, oConnectionId, DefaultValue, AddNewItems, PreventDuplicates) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If Else 'nur eine Textbox Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, DefaultValue, oDataType) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If End If Case ClassConstants.INDEX_TYPE_VARCHAR If (oSQLSuggestion = True And oSQLResult.ToString.Length > 0) Or MultiSelect = True Then Dim oControl = oControls.AddLookupControl(oControlName, oControlPosition, MultiSelect, oDataType, oSQLResult, oConnectionId, DefaultValue, 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(CURRENT_WORKFILE), oDataType) If Not IsNothing(oControl) Then pnlIndex.Controls.Add(oControl) End If Else Dim VORBELGUNG As String = DefaultValue 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, DefaultValue) pnlIndex.Controls.Add(oPicker) Case Else If USER_LANGUAGE = LANG_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 ShowErrorMessage(ex, "LoadIndexe_Man") End Try End Sub Private Function GetLookupData(pLookup As LookupControl3, pSQLCommand As String, pConnectionId As Integer) Dim oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(pConnectionId) If oConnectionString IsNot Nothing And pSQLCommand.Length > 0 Then LOGGER.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30)) If ClassPatterns.HasComplexPatterns(pSQLCommand) Then LOGGER.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) Return Nothing Else pSQLCommand = ClassPatterns.ReplaceInternalValues(pSQLCommand) pSQLCommand = ClassPatterns.ReplaceUserValues(pSQLCommand, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID) 'Dim oDatatable = ClassDatabase.Return_Datatable_Combined(pSQLCommand, oConnectionString, False) Dim oDatatable = DATABASE_ECM.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 Private Sub PrepareDependingControl(Control As Control) If TypeOf Control Is Label Then Exit Sub End If Try Dim oMeta = DirectCast(Control.Tag, ControlCreator.ControlMeta) Dim oIndexName As String = oMeta.IndexName Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%' AND DOK_ID = {CURRENT_DOKART_ID}" Dim oDatatable As DataTable = DATABASE_ECM.GetDatatable(oSQL) If Not IsNothing(oDatatable) Then LOGGER.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, Control.Name) For Each oRow As DataRow In oDatatable.Rows Dim oControlName As String = oRow.ItemEx("NAME", "") Dim oConnectionId As Integer = oRow.ItemEx("CONNECTION_ID", -1) Dim oControlSql As String = oRow.ItemEx("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 = ClassPatterns.ReplaceUserValues(oControlSql, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID) oControlSql = ClassPatterns.ReplaceInternalValues(oControlSql) oControlSql = ClassPatterns.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, SqlCommand As String, SqlConnectionId As Integer) Try If SqlCommand Is Nothing OrElse SqlCommand = String.Empty Then LOGGER.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.") Exit Sub End If Dim oConnectionString = DATABASE_ECM.Get_ConnectionStringforID(SqlConnectionId) Dim oDatatable As DataTable = DATABASE_ECM.GetDatatableWithConnection(SqlCommand, 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, ControlCreator.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) Exit Sub End If If oDatatable Is Nothing Then LOGGER.Warn("Error in SQL Command: {0}", SqlCommand) Exit Sub End If Select Case oFoundControl.GetType.Name Case GetType(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, TextEdit).Text = oValue End If End If Case GetType(LookupControl3).Name LOGGER.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") Dim oLookupControl = DirectCast(oFoundControl, LookupControl3) oLookupControl.Properties.DataSource = oDatatable If oDatatable.Columns.Count > 0 Then oLookupControl.Properties.ValueMember = oDatatable.Columns.Item(0).ColumnName oLookupControl.Properties.DisplayMember = oDatatable.Columns.Item(0).ColumnName End If Case GetType(Windows.Forms.ComboBox).Name LOGGER.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") DirectCast(oFoundControl, Windows.Forms.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 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 StripPlaceholder(Placeholder As String) As String Dim oResult = Placeholder oResult = Regex.Replace(oResult, "^\[%", "") oResult = Regex.Replace(oResult, "\]$", "") Return oResult End Function Function FillIndexe_Autom(dokart_id As Integer) Try VWINDEX_AUTOMTableAdapter.Fill(MyDataset.VWDDINDEX_AUTOM, CURRENT_DOKART_ID) Dim oDatatable = MyDataset.VWDDINDEX_AUTOM Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}") If oDatatable.Rows.Count = 0 Then Return True End If ' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen For Each oRow As DataRow In oDatatable _Logger.Info("Working on AutomaticIndex: " & oRow.Item("INDEXNAME") & "...") Dim oSqlResult As String = oRow.ItemEx("SQL_RESULT", "") Dim oSqlActive As Boolean = oRow.ItemEx("SQL_ACTIVE", False) Dim oSqlConnectionId As Integer = oRow.ItemEx("CONNECTION_ID", -1) Dim oSqlProvider As String = oRow.ItemEx("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 = oRow.ItemEx("VALUE", "") oPlaceholderResult = GetPlaceholderValue(oValue, CURRENT_WORKFILE, USER_SHORTNAME) If Not IsNothing(oPlaceholderResult) Then oValue = oPlaceholderResult End If oRow.Item("Indexiert") = True oRow.Item("Indexwert") = 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, CURRENT_WORKFILE, USER_SHORTNAME) ' Einfachen Platzhalter ersetzen If Not IsNothing(oPlaceholderResult) Then oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult) End If oOptionalIndex = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')") 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 oSqlResult = ClassPatterns.ReplaceControlValues(oSqlResult, pnlIndex) oSqlResult = ClassPatterns.ReplaceInternalValues(oSqlResult) oSqlResult = ClassPatterns.ReplaceUserValues(oSqlResult, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_DOKART_ID) If oSqlResult <> String.Empty Then _Logger.Debug("oSqlResult after Replace [" & oSqlResult & "]") End If ' Ergebnis: Es wurden alle einfachen Platzhalter ersetz't, 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 = DATABASE_ECM.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')") 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 oRow.Item("Indexiert") = True oRow.Item("Indexwert") = String.Join(ClassConstants.VECTORSEPARATOR, oEndResult.ToArray) Next Else Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider) _Logger.Info("Got a simple SQLResult: " & oResult.ToString) oRow.Item("Indexiert") = True oRow.Item("Indexwert") = oResult End If Next Return True Catch ex As Exception ShowErrorMessage(ex, "FillIndexe_Autom") Return False End Try End Function Private Sub btnVorschau_Click(sender As System.Object, e As System.EventArgs) PreviewFile() End Sub Sub PreviewFile() Try DocumentViewer1.LoadFile(CURRENT_WORKFILE) Catch ex As Exception ShowErrorMessage(ex, "PreviewFile") End Try End Sub Private Function UnicodeBytesToString(ByVal bytes() As Byte) As String Return System.Text.Encoding.UTF8.GetString(bytes) End Function Public Function TextStringToByteArray(ByRef str As String) As Byte() Dim enc As System.Text.Encoding = Encoding.GetEncoding(65001) Return enc.GetBytes(str) End Function Public Shared Function encode(ByVal str As String) As String 'supply True as the construction parameter to indicate 'that you wanted the class to emit BOM (Byte Order Mark) 'NOTE: this BOM value is the indicator of a UTF-8 string Dim utf8Encoding As New System.Text.UTF8Encoding(True) Dim encodedString() As Byte encodedString = utf8Encoding.GetBytes(str) Return utf8Encoding.GetString(encodedString) End Function Private Function WORK_FILE() As Boolean Try Me.VWDDINDEX_MANTableAdapter.Fill(Me.MyDataset.VWDDINDEX_MAN, CURRENT_DOKART_ID) _Logger.Debug("Manuelle Indexe geladen") If MyDataset.VWDDINDEX_MAN.Rows.Count > 0 Then Dim oDokart As DocType = ComboboxDoctype.EditValue CURRENT_DOKART_ID = oDokart.Guid If CheckWrite_IndexeMan(oDokart.Guid) = True Then '##### Manuelle Indexe indexiert ##### _Logger.Info("Datei [" & 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 'Die Datei verschieben If Move_File2_Target() = True Then _Logger.Debug(" ...Move_File2_Target durchlaufen") _Logger.Info("Datei '" & CURRENT_NEWFILENAME & "' erfolgreich erzeugt.") Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID DATABASE_ECM.ExecuteNonQuery(oDEL) 'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren CloseViewer() _Logger.Debug(" ...Viewer geschlossen") If CURR_DELETE_ORIGIN = True Then _Logger.Info("Datei [" & CURRENT_WORKFILE & "] wird gelöscht.") Try File.SetAttributes(CURRENT_WORKFILE, FileAttributes.Normal) File.Delete(CURRENT_WORKFILE) Catch ex As Exception _Logger.Error(ex) End Try _Logger.Info("Datei [" & CURRENT_WORKFILE & "] wurde gelöscht.") End If Return True End If Else If USER_LANGUAGE = LANG_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 USER_LANGUAGE = LANG_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 USER_LANGUAGE = LANG_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 ShowErrorMessage(ex, "WORK_FILE") Return False End Try End Function 'Private Sub OK_Button_Click(sender As Object, e As EventArgs) ' ClearError() ' ClearNotice() ' 'lblhinweis.Visible = False ' 'lblerror.Visible = False ' Me.Cursor = Cursors.WaitCursor ' ClassHelper.Refresh_RegexTable() ' For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows ' If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then ' REGEX_CLEAN_FILENAME = rowregex.Item("REGEX") ' End If ' Next ' If checkMultiindex.Visible = True And checkMultiindex.Checked = True Then ' 'Die erste Datei indexieren ' If WORK_FILE() = True Then ' 'Und nun die folgenden ' Dim DTFiles2Work As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") ' If Not DTFiles2Work Is Nothing Then ' Dim err = False ' For Each filerow As DataRow In DTFiles2Work.Rows ' CURRENT_WORKFILE_GUID = filerow.Item("GUID") ' CURRENT_WORKFILE_HASH = NotNull(filerow.Item("FILE_HASH"), "") ' 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 USER_LANGUAGE = LANG_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 ' Me.Close() ' End If ' End If ' End If ' Else ' If WORK_FILE() = True Then ' Me.Cursor = Cursors.Default ' If CONFIG.Config.ShowIndexResult = True Then ' If USER_LANGUAGE = LANG_DE Then ' MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung") ' Else ' MsgBox("File sucessfully processed!" & vbNewLine & "Path:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success") ' End If ' End If ' Me.Close() ' End If ' End If ' Me.Cursor = Cursors.Default 'End Sub Private Function Move_File2_Target() Dim oError As Boolean Try Dim oSQL As String = "SELECT FOLDER_FOR_INDEX FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKART_ID Dim oFolderForIndex = DATABASE_ECM.GetScalarValue(oSQL) If Not IsDBNull(oFolderForIndex) Then CreateFolderForIndex(oFolderForIndex) Else CreateFolderForIndex(String.Empty) End If If CURR_DOKART_WD_DIRECT = False Then 'Datei verschieben oError = Move_Rename_Only(CURRENT_WORKFILE, CURRENT_NEWFILENAME, CURR_WORKFILE_EXTENSION, VERSION_DELIMITER) Else Dim oExportSuccessful As Boolean = False 'Variable Folder If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then oExportSuccessful = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE) ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then oExportSuccessful = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE) End If If oExportSuccessful = 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 = CURRENT_WORKFILE.Replace("'", "''") Dim tempCur_New_FN = CURRENT_NEWFILENAME.Replace("'", "''") Dim oUser As String = $"{Environment.UserDomainName}\{Environment.UserName}" Insert_String = sql_history_INSERT_INTO & $",ADDED_WHO, ADDED_WHERE, FILE_HASH) VALUES ('{tempCur_WF}','{tempCur_New_FN}'{sql_history_Index_Values},'{oUser}','{Environment.MachineName}','{CURRENT_WORKFILE_HASH}')" DATABASE_ECM.GetScalarValue(Insert_String) If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then If CURRENT_MESSAGEID <> "" Then Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" Dim GUID = DATABASE_ECM.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 = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID DATABASE_ECM.ExecuteNonQuery(sqlUpdate) Else sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID DATABASE_ECM.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 If USER_LANGUAGE = LANG_DE Then MsgBox("Der Export nach windream war nicht erfolgreich - Check LogFile", MsgBoxStyle.Exclamation) Else MsgBox("Export to windream was unsucessful - Check LogFile", MsgBoxStyle.Exclamation) End If End If 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 ShowErrorMessage(ex, "Move_File2_Target") Return False End Try End Function Private Function CreateFolderForIndex(DynamicFolderConfig As String) Try Dim oRootFolder As String = Path.GetDirectoryName(CURRENT_NEWFILENAME) 'Dim oFilesystem As New Filesystem(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 = DATABASE_ECM.GetScalarValue("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & oManIndexName & "')") _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 = FILESYSTEM.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 = FILESYSTEM.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 USER_LANGUAGE = LANG_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 CURRENT_NEWFILENAME = Path.Combine(oNewFullPath, Path.GetFileName(CURRENT_NEWFILENAME)) Return True Catch ex As Exception ShowErrorMessage(ex, "CreateFolderForIndex") Return False End Try End Function Private Sub Button1_Click(sender As Object, e As EventArgs) If File.Exists(CURRENT_FILENAME) Then 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) Else MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information) End If CancelAttempts += 1 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) Else result = MessageBox.Show("You are aborting 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 DT As DataTable = DATABASE_ECM.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 DATABASE_ECM.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then If containsfw_file = True Then If USER_LANGUAGE = LANG_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 Close() End If End Select End If End Sub Private Sub BarCheckItem1_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemTopMost.CheckedChanged If FormLoaded = True Then TopMost = checkItemTopMost.Checked CONFIG.Config.TopMost = checkItemTopMost.Checked CONFIG.Save() End If End Sub Private Sub checkItemDeleteSource_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemDeleteSource.CheckedChanged If FormLoaded = True And checkItemDeleteSource.Visibility <> DevExpress.XtraBars.BarItemVisibility.Never Then CURR_DELETE_ORIGIN = checkItemDeleteSource.Checked CONFIG.Config.DeleteOriginalFile = checkItemDeleteSource.Checked CONFIG.Save() End If End Sub Private Sub labelFilePath_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles labelFilePath.ItemClick Clipboard.SetText(CURRENT_WORKFILE) If USER_LANGUAGE = LANG_DE Then MsgBox("Aktuellen Pfad in die Zwischenablage kopiert!", MsgBoxStyle.Information, Text) Else MsgBox("Current Path copied to Clipboard!", MsgBoxStyle.Information, Text) End If End Sub Private Sub SimpleButton1_Click(sender As Object, e As EventArgs) Handles btnOK.Click Try ClearError() ClearNotice() Me.Cursor = Cursors.WaitCursor CURRENT_DT_REGEX = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FUNCTION_REGEX") For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows If rowregex.Item("FUNCTION_NAME") = "CLEAN_FILENAME" Then REGEX_CLEAN_FILENAME = rowregex.Item("REGEX") End If Next If checkMultiindex.Visible = True And checkMultiindex.Checked = True Then 'Die erste Datei indexieren If WORK_FILE() = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = DATABASE_ECM.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") If DTFiles2Work IsNot Nothing Then Dim err = False For Each oRow As DataRow In DTFiles2Work.Rows CURRENT_WORKFILE_GUID = oRow.Item("GUID") CURRENT_WORKFILE = oRow.Item("FILENAME2WORK") CURRENT_WORKFILE_HASH = oRow.ItemEx("FILE_HASH", "") DropType = oRow.Item("HANDLE_TYPE") If WORK_FILE() = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then If USER_LANGUAGE = LANG_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 CloseViewer() CancelAttempts = 2 Me.Close() End If End If End If Else If WORK_FILE() = True Then Me.Cursor = Cursors.Default If CONFIG.Config.ShowIndexResult = True Then If USER_LANGUAGE = LANG_DE Then ' MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung") _FormHelper.ShowSuccessMessage($"Die Datei wurde erfolgreich verarbeitet!{vbNewLine}Ablagepfad:{vbNewLine}{CURRENT_NEWFILENAME}", "Erfolgsmeldung") Else 'MsgBox($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}" & vbNewLine & "Path:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success") _FormHelper.ShowSuccessMessage($"File sucessfully processed!{vbNewLine}Path:{vbNewLine}{CURRENT_NEWFILENAME}", "Success") End If End If CloseViewer() CancelAttempts = 2 Me.Close() End If End If Catch ex As Exception MsgBox("Uncaught error while indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, Text) Finally Me.Cursor = Cursors.Default End Try End Sub Private Sub checkItemPreview_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreview.CheckedChanged SetFilePreview(checkItemPreview.Checked) CONFIG.Config.FilePreview = checkItemPreview.Checked CONFIG.Save() End Sub Private Sub checkMultiindex_CheckedChanged(sender As Object, e As EventArgs) Handles checkMultiindex.CheckedChanged If USER_LANGUAGE = LANG_DE Then If checkMultiindex.Checked Then Me.btnOK.Text = "Dateien indexieren" MULTIINDEXING_ACTIVE = True Else Me.btnOK.Text = "Datei indexieren" MULTIINDEXING_ACTIVE = False End If Else If checkMultiindex.Checked Then Me.btnOK.Text = "Index Files" MULTIINDEXING_ACTIVE = True Else Me.btnOK.Text = "Index File" MULTIINDEXING_ACTIVE = False End If End If End Sub Private Sub SplitContainer1_SplitterMoved(sender As Object, e As SplitterEventArgs) Handles SplitContainer1.SplitterMoved CONFIG.Config.SplitterDistanceViewer = SplitContainer1.SplitterDistance End Sub Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick DATABASE_ECM.ExecuteNonQuery($"DELETE FROM TBGI_FILES_USER WHERE GUID = {CURRENT_WORKFILE_GUID}") CancelAttempts = 2 Close() End Sub Private Sub checkItemPreselection_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged CONFIG.Config.ProfilePreselection = checkItemPreselection.Checked CONFIG.Save() End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem2.ItemClick Try MsgBox($"Deleting [{CURRENT_WORKFILE}]", MsgBoxStyle.Information, Text) File.SetAttributes(CURRENT_WORKFILE, FileAttributes.Normal) File.Delete(CURRENT_WORKFILE) 'IO.File.Delete(CURRENT_WORKFILE) Catch ex As Exception _Logger.Error(ex) MsgBox(ex.Message) End Try End Sub End Class