Imports System.Windows.Forms Imports System.Data.SqlClient Imports System.IO Imports System.Text.RegularExpressions Imports Independentsoft Imports Oracle.ManagedDataAccess.Client Imports System.Text Imports System.Security.AccessControl Imports System.Security.Principal Imports System.DirectoryServices Imports DevExpress.XtraEditors.Controls Public Class frmIndex #Region "+++++ Variablen ++++++" Public vPathFile As String Private MULTIFILES As Integer Private akttxtbox As TextBox Dim DT_INDEXEMAN As DataTable Dim DT_DOKART As DataTable Private formloaded As Boolean = False Private Shared _Instance As frmIndex = Nothing Dim DropType As String Private Shared WDDirect As Boolean = False Dim sql_history_INSERT_INTO As String Dim sql_history_Index_Values As String Dim NewFileString As String Private CancelAttempts As Integer = 0 Private Property viewer_string As String 'Dim DocView 'Dim viewer_string As String Public Shared Function Instance() As frmIndex If _Instance Is Nothing OrElse _Instance.IsDisposed = True Then _Instance = New frmIndex End If _Instance.BringToFront() _Instance.TopMost = True _Instance.Focus() Return _Instance End Function #End Region '#Region "+++++ Allgemeine Funktionen ++++++" Sub ShowError(text As String) lblerror.Visible = True lblerror.Text = text lblerror.ForeColor = Color.Red End Sub Sub showlblhinweis(text As String) lblhinweis.Visible = True lblhinweis.Text = text End Sub Sub addLabel(indexname As String, hinweis As String, ylbl As Integer, anz As String) Dim lbl As New Label lbl.Name = "lbl" & indexname lbl.Size = New Size(CInt(hinweis.Length * 15), 18) 'CInt(hinweis.Length * 9) lbl.Text = hinweis pnlIndex.Controls.Add(lbl) lbl.Location = New Point(11, ylbl) End Sub Function AddTextBox(indexname As String, y As Integer, text As String) Dim txt As New TextBox txt.Name = "txt" & indexname txt.Size = New Size(260, 27) 'txt.AutoSize = True pnlIndex.Controls.Add(txt) txt.Location = New Point(11, y) If text <> "" Then txt.Text = text txt.Size = New Size(CInt(text.Length * 15), 27) txt.SelectAll() End If AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp AddHandler txt.TextChanged, AddressOf OnTextBoxTextChanged Return txt End Function Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.Lime box.SelectAll() End Sub Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender 'If box.Text.Length > 15 Then Dim g As Graphics = box.CreateGraphics box.Width = g.MeasureString(box.Text, box.Font).Width + 15 g.Dispose() ' End If End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.White End Sub Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) Dim box As TextBox = sender If (e.KeyCode = Keys.Return) Then SendKeys.Send("{TAB}") End If End Sub Sub AddDateTimePicker(indexname As String, y As Integer) Dim dtp As New DateTimePicker dtp.Name = "dtp" & indexname dtp.Format = DateTimePickerFormat.Short dtp.Size = New Size(133, 27) pnlIndex.Controls.Add(dtp) dtp.Location = New Point(11, y) AddHandler dtp.ValueChanged, AddressOf OndtpChanged End Sub Sub OndtpChanged() 'offen was hier zu tun ist End Sub ' _ Function addCombobox(indexname As String, y As Integer) Dim cmb As New ComboBox cmb.Name = "cmb" & indexname cmb.AutoSize = True cmb.Size = New Size(300, 27) pnlIndex.Controls.Add(cmb) cmb.Location = New Point(11, y) 'cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend 'cmb.AutoCompleteSource = AutoCompleteSource.ListItems 'AddHandler cmb.KeyUp, AddressOf AutoCompleteCombo_KeyUp AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged AddHandler cmb.GotFocus, AddressOf OncmbGotFocus AddHandler cmb.LostFocus, AddressOf OncmbLostFocus AddHandler cmb.KeyDown, AddressOf OncmbKeyDown Return cmb End Function ' _ Public Sub OncmbKeyDown(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender ' Verhindert, dass Auswahlliste und Autocompleteliste übereinander liegen If cmb.DroppedDown = True Then cmb.DroppedDown = False End If End Sub ' _ Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.Lime End Sub ' _ Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender cmb.BackColor = Color.White End Sub ' _ Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs) If formloaded = False Then Exit Sub End If Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 Then If cmb.Text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics cmb.Width = g.MeasureString(cmb.Text, cmb.Font).Width + 30 g.Dispose() End If Get_NextComboBoxResults(cmb) SendKeys.Send("{TAB}") End If End Sub Sub Get_NextComboBoxResults(cmb As ComboBox) Try Dim indexname = cmb.Name.Replace("cmb", "") Dim sql = "SELECT GUID,NAME,SQL_RESULT FROM TBDD_INDEX_MAN where SUGGESTION = 1 AND SQL_RESULT like '%@" & indexname & "%' and DOK_ID = " & CURRENT_DOKART_ID & " ORDER BY SEQUENCE" Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, True) If Not IsNothing(DT) Then If DT.Rows.Count > 0 Then Dim cmbname = "cmb" & DT.Rows(0).Item("NAME") Renew_ComboboxResults(DT.Rows(0).Item("GUID"), indexname, cmb.Text) End If End If Catch ex As Exception MsgBox("Error in Get_NextComboBoxResults:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub ' 'Public Sub AutoCompleteCombo_KeyUp(ByVal cbo As ComboBox, ByVal e As KeyEventArgs) ' ' System.Threading.Thread.Sleep(400) ' ' Dim sTypedText As String ' ' Dim iFoundIndex As Integer ' ' Dim oFoundItem As Object ' ' Dim sFoundText As String ' ' Dim sAppendText As String ' ' 'Allow select keys without Autocompleting ' ' Select Case e.KeyCode ' ' Case Keys.Left, Keys.Right, Keys.Up, Keys.Delete, Keys.Down, Keys.Enter, Keys.Tab ' ' Return ' ' Case Keys.Escape, Keys.Back ' ' Return ' ' End Select ' ' 'Get the Typed Text and Find it in the list ' ' sTypedText = cbo.Text ' ' iFoundIndex = cbo.FindString(sTypedText) ' ' 'If we found the Typed Text in the list then Autocomplete ' ' If iFoundIndex >= 0 Then ' ' 'Get the Item from the list (Return Type depends if Datasource was bound ' ' ' or List Created) ' ' oFoundItem = cbo.Items(iFoundIndex) ' ' 'Use the ListControl.GetItemText to resolve the Name in case the Combo ' ' ' was Data bound ' ' sFoundText = cbo.GetItemText(oFoundItem) ' ' 'Append then found text to the typed text to preserve case ' ' sAppendText = sFoundText.Substring(sTypedText.Length) ' ' cbo.Text = sTypedText & sAppendText ' ' 'Select the Appended Text ' ' cbo.SelectionStart = sTypedText.Length ' ' cbo.SelectionLength = sAppendText.Length ' ' cbo.DroppedDown = True ' ' Else ' ' cbo.DroppedDown = False ' ' End If ' ' Me.Cursor = Cursors.Default ' 'End Sub '#End Region '#Region "+++++ Datenbankfunktionen (CS, GetValues, CheckValues) ++++++" ' _ 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 = ClassFormFunctions.GetConnectionString(DR.Item("CONNECTION_ID")) If connectionString <> "" Then Dim sqlscalar = DR.Item("SQL_CHECK") Select Case DR.Item("DATENTYP") Case "INTEGER" sqlscalar = sqlscalar.ToString.Replace("@manValue", wert) Case Else sqlscalar = sqlscalar.ToString.Replace("@manValue", "'" & wert & "'") End Select sql = sqlscalar Dim ergebnis As Integer If DR.Item("SQL_PROVIDER") = "Oracle" Then ergebnis = ClassDatabase.OracleExecute_Scalar(sql, connectionString) Else 'MSQL ergebnis = ClassDatabase.Execute_Scalar(sql, connectionString) End If Select Case ergebnis Case 1 Return True Case 2 showlblhinweis("Indexwert nicht eindeutig: " & sql) Return False Case 99 Return False End Select End If Else Return True End If End If Next Catch ex As Exception MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_checkValue:") ClassLogger.Add(" - Unvorhergesehener Unexpected error in Indexwert_checkValue - Fehler: " & vbNewLine & ex.Message) Return False End Try End Function ' Function Execute_Scalar_SQLServer(vsql_statement As String, vconnectionString As String, check As Boolean) ' Try ' Dim cnn As SqlConnection ' cnn = New SqlConnection(vconnectionString) ' Dim cmd As SqlCommand ' cnn.Open() ' cmd = New SqlCommand(vsql_statement, cnn) ' If check = True Then ' 'ERgebnis muss immer 1 oder mehr ergeben ' Dim count As Int32 = Convert.ToInt32(cmd.ExecuteScalar()) ' If count = 1 Then ' cmd.Dispose() ' cnn.Close() ' Return 1 ' Else ' cmd.Dispose() ' cnn.Close() ' Return 2 ' End If ' Else ' 'Ergebnis ' Dim ergebnis As String = cmd.ExecuteScalar() ' Return ergebnis ' End If ' Catch ex As Exception ' MsgBox("Unvorhergesehener Unexpected error in Execute_Scalar_SQLServer" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Ausführen sql:") ' ClassLogger.Add(" - Unvorhergesehener Unexpected error in Execute_Scalar_SQLServer" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler: " & vbNewLine & ex.Message) ' ClassLogger.Add(" - SQL: " & vsql_statement, False) ' ClassLogger.Add(" - Connection: " & vconnectionString, False) ' Return 99 ' End Try ' End Function ' Function Execute_Scalar_Oracle(vsql_statement As String, vconnectionString As String, check As Boolean) ' Try ' Dim cnn As OracleConnection ' cnn = New OracleConnection(vconnectionString) ' Dim cmd As OracleCommand ' cnn.Open() ' cmd = New OracleCommand(vsql_statement, cnn) ' If check = True Then ' 'Ergebnis muss immer 1 oder mehr ergeben ' Dim count As Int32 = Convert.ToInt32(cmd.ExecuteScalar()) ' If count = 1 Then ' Return 1 ' Else ' Return 2 ' End If ' Else ' 'Ergebnis ' Dim ergebnis As String = cmd.ExecuteScalar() ' Return ergebnis ' End If ' cmd.Dispose() ' cnn.Close() ' Catch ex As Exception ' MsgBox("Unvorhergesehener Unexpected error in Execute_Scalar_Oracle" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Ausführen sql:") ' ClassLogger.Add(" - Unvorhergesehener Unexpected error in Execute_Scalar_Oracle" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler: " & vbNewLine & ex.Message) ' ClassLogger.Add(" - SQL: " & vsql_statement, False) ' ClassLogger.Add(" - Connection: " & vconnectionString, False) ' Return 99 ' 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 If LogErrorsOnly = False Then ClassLogger.Add(" >>Manueller Index: " & indexname, False) Select Case RequestFor Case "FILE" If DR.Item("Indexwert_File").ToString <> String.Empty Then If LogErrorsOnly = False Then ClassLogger.Add(" >>Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & DR.Item("Indexwert_File").ToString, False) If LogErrorsOnly = False Then ClassLogger.Add(" >>Zurückgegebener NachbearbeitungsWert: " & DR.Item("Indexwert_File"), False) Return DR.Item("Indexwert_File") Else If DR.Item("Indexwert").ToString <> String.Empty Then If LogErrorsOnly = False Then ClassLogger.Add(" >>Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert"), False) Return DR.Item("Indexwert") Else If opt = False Then ClassLogger.Add(" >> Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!", False) showlblhinweis("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 If LogErrorsOnly = False Then ClassLogger.Add(" >>Zurückgegebener manueller Indexwert: " & DR.Item("Indexwert"), False) Return DR.Item("Indexwert") Else 'Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & indexname & "')", MyConnectionString, True) If opt = False Then ClassLogger.Add(" >> Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!", False) showlblhinweis("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 showlblhinweis("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 ClassLogger.Add(" - Unvorhergesehener Unexpected error in GetManIndex_Value - Fehler: " & vbNewLine & ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in 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 showlblhinweis("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Else showlblhinweis("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Exit For End If Next Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in GetAutoIndex_Value - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetAutoIndex_Value:") Return "" End Try End Function Function GetAutomaticIndexSQLValue(vsqlstatement As String, vconnectionID As Integer, vProvider As String) Try Dim connectionString As String connectionString = ClassFormFunctions.GetConnectionString(vconnectionID) If connectionString <> "" Then 'NEU Dim ergebnis 'Welcher Provider? If vProvider.ToLower = "oracle" Then ergebnis = ClassDatabase.OracleExecute_Scalar(vsqlstatement, connectionString) Else 'im Moment nur SQL-Server ergebnis = ClassDatabase.Execute_Scalar(vsqlstatement, connectionString) End If If LogErrorsOnly = False Then ClassLogger.Add(" >>SQL-ConnectionString: " & connectionString.Substring(0, connectionString.LastIndexOf("=")), False) End If If ergebnis Is Nothing Then 'showlblhinweis("Kein Ergebnis für automatisches SQL: " & vsqlstatement) Return "" Else Return ergebnis End If End If Catch ex As Exception ClassLogger.Add(" - Unexpected error in Get_AutomatischerIndex_SQL - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_AutomatischerIndex_SQL:") Return "" End Try End Function ' _ Private Sub AddVorschlag_ComboBox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Multiselect As Boolean, Optional Vorgabe As String = "", Optional AddNewValues As Boolean = False, Optional PreventDuplicateValues As Boolean = False) Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String Dim runinLZ As Boolean = False connectionString = ClassFormFunctions.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste sql = sql_Vorschlag If Not sql.Contains("@") Then If connectionString.Contains("Initial Catalog=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) ' Try oracleConn.Open() oracleCmd = New OracleCommand(sql_Vorschlag, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If Else runinLZ = True If LogErrorsOnly = False Then ClassLogger.Add(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) End If Dim newCMB As ComboBox If runinLZ = True Then 'Die Standardcombobox anlegen newCMB = addCombobox(indexname, y) newCMB.Size = New Size(300, 27) Else Dim table As DataTable = NewDataset.Tables(0) 'If table.Rows.Count > 0 Then ' Dim columnCount = 1 ' ' Alle bis auf die erste Spalte der Tabelle entfernen ' While (table.Columns.Count > columnCount) ' table.Columns.RemoveAt(columnCount) ' End While ' 'table.Columns.Item(0).ReadOnly = True ' If Multiselect Then ' ' Neue Spalte für Selektion einfügen ' Dim selectedColumn As New DataColumn() With { ' .ColumnName = "SELECTED", ' .DataType = GetType(Boolean), ' .DefaultValue = False ' } ' table.Columns.Add(selectedColumn) ' ' Spalte an erste Stelle verschieben ' selectedColumn.SetOrdinal(0) ' End If ' Const LOOKUP_NO_RECORDS As String = "Keine Datensätze ausgewählt" ' Const LOOKUP_N_RECORDS As String = "{0} Datensätze ausgewählt" ' Const LOOKUP_CONTROL_HEIGHT As Integer = 24 ' Dim lookupButton As New Button() ' lookupButton.Name = "btnLookup" & indexname ' lookupButton.Location = New Point(311, y - 1) ' lookupButton.Size = New Size(LOOKUP_CONTROL_HEIGHT, LOOKUP_CONTROL_HEIGHT) ' lookupButton.Image = My.Resources.gear_32xSM ' pnlIndex.Controls.Add(lookupButton) ' If Multiselect Then ' Dim listbox As New ListBox() ' Dim gridLookup As New DevExpress.XtraEditors.GridLookUpEdit() ' gridLookup.Name = "cmbMulti" & indexname ' gridLookup.Font = New Font(gridLookup.Font.FontFamily, 10) ' gridLookup.Location = New Point(11, y) ' gridLookup.Size = New Size(300, LOOKUP_CONTROL_HEIGHT) ' ' TODO: Hier noch die Vorbelegung für Vektor Indexe einfügen ' gridLookup.Properties.PopupFormSize = New Size(gridLookup.Properties.PopupFormSize.Width, 100) ' gridLookup.Properties.NullText = LOOKUP_NO_RECORDS ' If Vorgabe.Length > 0 Then ' gridLookup.Properties.DataSource = New List(Of String) From {Vorgabe} ' gridLookup.Properties.NullText = String.Format(LOOKUP_N_RECORDS, 1) ' Else ' gridLookup.Properties.DataSource = Nothing ' gridLookup.Properties.NullText = LOOKUP_NO_RECORDS ' End If ' ' Da das gridLookup ein Readonly Control sein soll, ' ' sich aber trotzdem öffnen lassen soll, müssen wir so das setzen eines neuen Werts verhindern ' AddHandler gridLookup.EditValueChanging, Sub(sender As Object, e As ChangingEventArgs) ' e.Cancel = True ' End Sub ' With gridLookup.Properties.View ' .OptionsBehavior.ReadOnly = True ' .OptionsBehavior.Editable = False ' .OptionsView.ShowColumnHeaders = False ' End With ' AddHandler lookupButton.Click, Sub() ' Dim frm As New frmLookupGrid() ' frm.MultiSelect = True ' frm.DataSource = table ' frm.AddNewValues = AddNewValues ' frm.PreventDuplicates = PreventDuplicateValues ' frm.StartPosition = FormStartPosition.Manual ' frm.SelectedValues = gridLookup.Properties.DataSource ' frm.Location = pnlIndex.PointToScreen(New Point(340, y)) ' Dim result = frm.ShowDialog() ' If result = DialogResult.OK Then ' Dim values As List(Of String) = frm.SelectedValues ' gridLookup.Properties.DataSource = values ' gridLookup.Properties.NullText = IIf(values.Count = 0, LOOKUP_NO_RECORDS, String.Format(LOOKUP_N_RECORDS, values.Count)) ' End If ' End Sub ' pnlIndex.Controls.Add(gridLookup) ' Else ' Dim textBox As New TextBox() ' textBox.Name = "cmbSingle" & indexname ' textBox.Font = New Font(textBox.Font.FontFamily, 9) ' textBox.Location = New Point(11, y) ' textBox.Size = New Size(300, LOOKUP_CONTROL_HEIGHT) ' textBox.ReadOnly = True ' textBox.Text = Vorgabe ' AddHandler lookupButton.Click, Sub() ' Dim frm As New frmLookupGrid() ' frm.FormBorderStyle = FormBorderStyle.SizableToolWindow ' frm.MultiSelect = False ' frm.DataSource = table ' frm.AddNewValues = AddNewValues ' frm.StartPosition = FormStartPosition.Manual ' frm.SelectedValues = New List(Of String) From {textBox.Text} ' frm.Location = pnlIndex.PointToScreen(New Point(340, y)) ' Dim result = frm.ShowDialog() ' If result = DialogResult.OK Then ' Dim value = frm.SelectedValues.FirstOrDefault() ' textBox.Text = value ' End If ' End Sub ' pnlIndex.Controls.Add(textBox) ' End If ' ' Für ergebnisse die kleiner/gleich MAX_COMBOBOX_ITEMS sind ' ' die normale ComboBox verwenden ' ' 'Die Standardcombobox anlegen ' ' newCMB = addCombobox(indexname, y) ' ' newCMB.DataSource = table ' ' newCMB.DisplayMember = table.Columns(0).ColumnName ' ' newCMB.AutoCompleteSource = AutoCompleteSource.ListItems ' ' newCMB.AutoCompleteMode = AutoCompleteMode.Suggest ' ' newCMB.DropDownHeight = (newCMB.ItemHeight + 0.2) * 25 ' ' If Vorgabe <> "" Then ' ' newCMB.SelectedIndex = newCMB.FindStringExact(Vorgabe) ' ' newCMB.Text = Vorgabe ' ' Get_NextComboBoxResults(newCMB) ' ' End If 'Else 'End If Dim oControl As New DigitalData.Controls.LookupGrid.LookupControl2 With { .DataSource = table, .MultiSelect = Multiselect, .AllowAddNewValues = AddNewValues, .PreventDuplicates = PreventDuplicateValues, .Location = New Point(11, y), .Size = New Size(300, 27), .Name = "cmbMulti" & indexname } pnlIndex.Controls.Add(oControl) If connectionString.Contains("Initial Catalog=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try End If End If End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:") End Try End Sub Private Sub AddAutoSuggest_Textbox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Optional Vorgabe As String = "") Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String Dim runinLZ As Boolean = False connectionString = ClassFormFunctions.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste sql = sql_Vorschlag If Not sql.Contains("@") Then If connectionString.Contains("Initial Catalog=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) ' Try oracleConn.Open() oracleCmd = New OracleCommand(sql_Vorschlag, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If Else runinLZ = True If LogErrorsOnly = False Then ClassLogger.Add(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) End If Dim newASTextbox As TextBox If runinLZ = True Then 'Die Standardcombobox anlegen newASTextbox = AddTextBox(indexname, y, "") newASTextbox.Size = New Size(300, 27) Else If NewDataset.Tables(0).Rows.Count > 0 Then 'Die Standardcombobox anlegen newASTextbox = AddTextBox(indexname, y, "") 'Die Standargrösse definieren Dim newWidth As Integer = 300 'LOOPING THE ROW OF DATA IN THE DATATABLE For Each r In NewDataset.Tables(0).Rows 'ADDING THE DATA IN THE AUTO COMPLETE SOURCE OF THE TEXTBOX newASTextbox.AutoCompleteCustomSource.Add(r.Item(0).ToString) Next With newASTextbox .AutoCompleteMode = AutoCompleteMode.Suggest .AutoCompleteSource = AutoCompleteSource.CustomSource End With Else End If If connectionString.Contains("Initial Catalog=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) End Try End If End If End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in AddAutoSuggest_Textbox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddAutoSuggest_Textbox:") End Try End Sub Private Sub Renew_ComboboxResults(INDEX_GUID As Integer, SearchString As String, Resultvalue As String) Try Dim connectionString As String Dim sqlCnn As SqlConnection Dim sqlCmd As SqlCommand Dim adapter As New SqlDataAdapter Dim oracleConn As OracleConnection Dim oracleCmd As OracleCommand Dim oracleadapter As New OracleDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim DT_INDEX As DataTable = ClassDatabase.Return_Datatable("select * FROM TBDD_INDEX_MAN WHERE GUID = " & INDEX_GUID, True) If IsNothing(DT_INDEX) Then Exit Sub End If Dim conid = DT_INDEX.Rows(0).Item("CONNECTION_ID") Dim sql_result = DT_INDEX.Rows(0).Item("SQL_RESULT") Dim NAME = DT_INDEX.Rows(0).Item("NAME") If Not IsNothing(conid) And Not IsNothing(sql_result) And Not IsNothing(NAME) Then For Each ctrl As Control In Me.pnlIndex.Controls If ctrl.Name = "cmb" & NAME.ToString Then Dim cmb As ComboBox = ctrl Dim sql As String = sql_result.ToString.ToUpper.Replace("@" & SearchString.ToUpper, Resultvalue) connectionString = ClassFormFunctions.GetConnectionString(conid) If connectionString Is Nothing = False Then 'SQL Befehl füllt die Auswahlliste If connectionString.Contains("Initial Catalog=") Then sqlCnn = New SqlConnection(connectionString) sqlCnn.Open() sqlCmd = New SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) ElseIf connectionString.StartsWith("Data Source=") And connectionString.Contains("SERVICE_NAME") Then oracleConn = New OracleConnection(connectionString) ' Try oracleConn.Open() oracleCmd = New OracleCommand(sql, oracleConn) oracleadapter.SelectCommand = oracleCmd oracleadapter.Fill(NewDataset) End If If NewDataset.Tables(0).Rows.Count > 0 Then cmb.Items.Clear() 'Die Standargrösse definieren Dim newWidth As Integer = 300 For i = 0 To NewDataset.Tables(0).Rows.Count - 1 'MsgBox(NewDataset.Tables(0).Rows(i).Item(0)) AddComboBoxValue(cmb, NewDataset.Tables(0).Rows(i).Item(0)) Try Dim text As String = NewDataset.Tables(0).Rows(i).Item(0) If text.Length > 15 Then Dim g As Graphics = cmb.CreateGraphics If g.MeasureString(text, cmb.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, cmb.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Anpassung Breite ComboBox:") End Try Next cmb.Size = New Size(newWidth, 27) cmb.AutoCompleteSource = AutoCompleteSource.ListItems cmb.AutoCompleteMode = AutoCompleteMode.Suggest End If If connectionString.Contains("Initial Catalog=") Then Try adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() Catch ex As Exception End Try Else Try oracleadapter.Dispose() oracleCmd.Dispose() oracleConn.Close() Catch ex As Exception End Try End If End If End If Next End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") End Try End Sub '#End Region '#Region "+++++ Funktionen bei OK - schliessen ++++++" Function CheckWrite_IndexeMan(dokartid As Integer) '#### Zuerst manuelle Werte indexieren #### Try If LogErrorsOnly = False Then ClassLogger.Add(" >> In CheckWrite_IndexeMan", False) Dim result As Boolean = False For Each ctrl As Control In Me.pnlIndex.Controls ' MsgBox(ctrl.Name) If ctrl.Name.StartsWith("txt") Then Dim box As TextBox = ctrl If box.Text = "" Then Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(box.Name, "txt", "") & "'", MyConnectionString, True) If optional_index = False Then MsgBox("Bitte geben Sie einen Indexwert ein!", MsgBoxStyle.Exclamation, "Fehlende Eingabe:") box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") result = True End If Else If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then ClassLogger.Add(" - Der eingegebene Wert wurde nicht in der Datenbank gefunden", False) MsgBox("Der eingegebene Wert wurde nicht in der Datenbank gefunden!", MsgBoxStyle.Exclamation, "Fehlerhafte Indexierung:") box.Focus() Return False Else Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) result = True End If End If End If If ctrl.Name.StartsWith("cmbMulti") Then Dim oLookup = DirectCast(ctrl, DigitalData.Controls.LookupGrid.LookupControl2) Dim values As List(Of String) = oLookup.SelectedValues If values.Count = 0 Then Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(oLookup.Name, "cmbMulti", "") & "'", MyConnectionString, True) If optional_index = False Then MsgBox("Bitte wählen Sie einen Wert aus der Combobox.", MsgBoxStyle.Exclamation) oLookup.Focus() Return False Else Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") result = True End If Else Dim vectorValue = String.Join(ClassConstants.VECTORSEPARATOR, values) Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) result = True End If ElseIf ctrl.Name.StartsWith("cmbSingle") Then Dim cmbSingle As TextBox = ctrl If cmbSingle.Text = "" Then Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmbSingle.Name, "cmbSingle", "") & "'", MyConnectionString, True) If optional_index = False Then MsgBox("Bitte wählen Sie einen Wert aus der Combobox.", MsgBoxStyle.Exclamation) cmbSingle.Focus() Return False Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") result = True End If Else Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) result = True End If ElseIf ctrl.Name.StartsWith("cmb") Then Dim cmb As ComboBox = ctrl If cmb.Text = "" Then Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & dokartid & " AND NAME = '" & Replace(cmb.Name, "cmb", "") & "'", MyConnectionString, True) If optional_index = False Then MsgBox("Bitte wählen Sie einen Wert aus der Combobox.", MsgBoxStyle.Exclamation) cmb.Focus() Return False Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") result = True End If Else Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) result = True End If End If If ctrl.Name.StartsWith("dtp") Then Dim dtp As DateTimePicker = ctrl Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) result = True End If If ctrl.Name.StartsWith("chk") Then Dim chk As CheckBox = ctrl Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked) result = True End If If TypeOf (ctrl) Is Button Then Continue For End If If ctrl.Name.StartsWith("lbl") = False And result = False Then ClassLogger.Add("Die Überprüfung der manuellen Indices ist fehlerhaft. Bitte informieren Sie den Systembetreuer", True) Return False End If Next Return True Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler in CheckWrite_IndexeMan - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unerwarteter Unexpected error in 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 = ClassDatabase.Return_Datatable("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 = ClassPostprocessing.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 = ClassDatabase.Return_Datatable("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 = ClassPostprocessing.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 ClassLogger.Add(" - Unvorhergesehener Unexpected error in Indexwert_Postprocessing - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_Postprocessing:") End Try End Sub ' 'Function Get_Nachbearbeitung_Wert(idxvalue As String, DTNB As DataTable) ' ' Dim result As String = idxvalue ' ' Try ' ' For Each row As DataRow In DTNB.Rows ' ' Select Case row.Item("TYP").ToString.ToUpper ' ' Case "VBSPLIT" ' ' ClassLogger.Add(" - Nachbearbeitung mit VBSPLIT", False) ' ' Dim strSplit() As String ' ' strSplit = result.Split(row.Item("TEXT1").ToString) ' ' For i As Integer = 0 To strSplit.Length - 1 ' ' If i = CInt(row.Item("TEXT2")) Then ' ' ClassLogger.Add(" - Split-Ergebnis für Index (" & i.ToString & "): " & strSplit(i), False) ' ' result = strSplit(i).ToString ' ' End If ' ' Next ' ' Case "VBREPLACE" ' ' result = result.Replace(row.Item("TEXT1"), row.Item("TEXT2")) ' ' End Select ' ' Next ' ' Return result ' ' Catch ex As Exception ' ' ClassLogger.Add(" - Unvorhergesehener Unexpected error in Get_Nachbearbeitung_Wert - result: " & result & " - Fehler: " & vbNewLine & ex.Message) ' ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_Nachbearbeitung_Wert:") ' ' Return result ' ' End Try ' 'End Function ' Dim sql_history_INSERT_INTO As String ' Dim sql_history_Index_Values As String ' Dim _NewFileString As String Function Name_Generieren() Try Dim sql As String = "select VERSION_DELIMITER, FILE_DELIMITER FROM TBDD_MODULES WHERE GUID = 1" Dim DT1 As DataTable = ClassDatabase.Return_Datatable(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 = ClassDatabase.Return_Datatable("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 = DT.Rows(0).Item("ZIEL_PFAD") '#### ' Regulären Ausdruck zum Auslesen der Indexe definieren Dim preg As String = "\[%{1}[a-zA-Z0-9ß\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" 'schonmal den gesamten Pfad laden Dim oNamenkonvention As String = 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 ClassLogger.Add(" >> No RegularExpression Fileds on Nameconvention!", False) 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" If LogErrorsOnly = False Then ClassLogger.Add(" >>Manueller Index wird geprüft...", False) Dim Indexname = oElement.Value.Substring(3, oElement.Value.Length - 4) Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & Indexname & "')", MyConnectionString, True) Dim value As String = GetManIndex_Value(Indexname, "FILE", optional_index) If value <> String.Empty Then Dim firstVectorValue = value.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 & ", '" & value.Replace("'", "''") & "'" Else If optional_index = True Then Dim result As MsgBoxResult 'If USER_LANGUAGE = "de-DE" Then ' result = MessageBox.Show("Achtung der optionale Index ist leer, wird aber für die Benennung der Datei benutzt." & vbNewLine & "Wollen Sie stattdessen den Originaldateinamen verwenden?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) 'Else ' result = MessageBox.Show("Attention: optional index is empty, but is being used in renaming the file." & vbNewLine & "Do you want to use the original filename instead?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) 'End If 'If result = MsgBoxResult.Yes Then ' oNamenkonvention = oNamenkonvention.Replace(oElement.Value, System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE)) ' NewFileString = oNamenkonvention ' sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString ' AnzahlIndexe += 1 ' sql_history_Index_Values = sql_history_Index_Values & ", '" & System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE).Replace("'", "''") & "'" 'Else oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value, value) 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 ClassLogger.Add(" >> Der Indexvalue für Index '" & Indexname & "' ist String.Empty", False) 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_SHORT_NAME) 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 = version + 1 _neuername = Stammname.Replace(extension, "") & VERSION_DELIMITER & version & extension NewFileString = _neuername Loop End If Catch ex As Exception ClassLogger.Add(" - Unexpected error in Umbenennnen der Datei - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Umbenennnen der Datei:") err = True End Try Case Else ClassLogger.Add(" - 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 = ClassFilehandle.CleanFilename(NewFileString, "") CURRENT_NEWFILENAME = oRAWZielordner & "\" & CURRENT_NEWFILENAME If CURRENT_NEWFILENAME.EndsWith("_") Then CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Substring(0, CURRENT_NEWFILENAME.Length - 1) End If If CURRENT_NEWFILENAME.StartsWith("_") Then CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Substring(1) End If If CURRENT_NEWFILENAME.Contains("__") Then CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Replace("__", "_") End If 'CURRENT_NEWFILENAME &= extension Dim sollfilename = System.IO.Path.GetFileName(CURRENT_NEWFILENAME) If sollfilename.StartsWith("_") Then sollfilename = sollfilename.Substring(1) Dim _path = System.IO.Path.GetDirectoryName(CURRENT_NEWFILENAME) CURRENT_NEWFILENAME = _path & "\" & sollfilename End If Dim path = System.IO.Path.GetDirectoryName(CURRENT_NEWFILENAME) If folder_Created = False Then ' Den Zielordner erstellen If Directory.Exists(path) = False Then Try 'Try to create the directory. Directory.CreateDirectory(path) Catch ex As Exception ClassLogger.Add("Unexpected Error in 'Name_Generieren' - Error: " & vbNewLine & ex.Message & vbNewLine & "Directory.CreateDirectory(" & path & ")", True) MsgBox("Unexpected Error in 'Name_Generieren' - Error: " & vbNewLine & ex.Message & vbNewLine & "Directory.CreateDirectory(" & path & ")", MsgBoxStyle.Critical) End Try End If folder_Created = True End If 'False oder True zurückgeben If err = False Then Return True Else Return False End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Unexpected error in Name_Generieren - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Unexpected error in Name_Generieren:") Return False End Try End Function Private Function Write_Indizes() Try 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 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> Manueller Indexvalue: " & idxvalue.ToString, False) Count += 1 ' den Typ des Zielindexes auslesen Dim indexType As Integer = ClassWindream.GetTypeOfIndexAsIntByName(indexname) If indexType < ClassWindream.WMObjectVariableValueTypeVector Then indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue) Else Dim indexArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR) indexierung_erfolgreich = ClassWindream.Indexiere(CURRENT_NEWFILENAME.Substring(2), indexname, indexArray) 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> No Indexing: indexname: " & indexname, False) ClassLogger.Add(" >> No Indexing: is optional? " & optional_Index.ToString, False) End If End If Else ClassLogger.Add(" >> Indexvalue is empty or field is not indexed - Indexname: " & indexname, False) 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> Auto Indexname: " & indexname.ToString, False) If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexvalue: " & Indexvalue.ToString, False) Count += 1 ' den Typ des Zielindexes auslesen Dim indexType As Integer = ClassWindream.GetTypeOfIndexAsIntByName(indexname) If indexType < ClassWindream.WMObjectVariableValueTypeVector Then indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, Indexvalue) Else Dim indexArray = Split(Indexvalue, ClassConstants.VECTORSEPARATOR) indexierung_erfolgreich = ClassWindream.Indexiere(CURRENT_NEWFILENAME.Substring(2), indexname, indexArray) End If indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, Indexvalue) 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.EndsWith(".msg") Then indexierung_erfolgreich = SetEmailIndices() 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 = SetAttachmentIndices() If indexierung_erfolgreich = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If End If Catch ex As Exception ClassLogger.Add("Unvorhergesehener Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message) MsgBox("Error in Write_Indizes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try Return True End Function Private Function WriteIndex2File(indexname As String, indexvalue As String) Try If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexvalue: " & indexvalue.ToString, False) Return ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, indexvalue) Catch ex As Exception MsgBox("Error in WriteIndex2File:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Private Function SetEmailIndices() Dim indexierung_erfolgreich As Boolean = False Dim _step As String = "1" Try Dim msg As Msg.Message = New Msg.Message(CURRENT_NEWFILENAME) Dim msgDisplayTo = msg.DisplayTo Dim msgInternetAccountName = msg.InternetAccountName If LogErrorsOnly = False Then ClassLogger.Add("", False) ClassLogger.Add(" >> msgInternetAccountName: " & msgInternetAccountName, False) ClassLogger.Add(" >> SenderName: " & msg.SenderName, False) ClassLogger.Add(" >> SenderEmailAddress: " & msg.SenderEmailAddress, False) ClassLogger.Add(" >> ReceivedByName: " & msg.ReceivedByName, False) ClassLogger.Add(" >> ReceivedByEmailAddress: " & msg.ReceivedByEmailAddress, False) ClassLogger.Add("", False) End If _step = "2" 'Console.WriteLine("Subject: " + msg.Subject) 'Console.WriteLine("MessageDeliveryTime:" & msg.MessageDeliveryTime) 'Console.WriteLine("SenderName: " + msg.SenderName) 'Console.WriteLine("SenderEmailAddress: " + msg.SenderEmailAddress) 'Console.WriteLine("ReceivedByName: " + msg.ReceivedByName) 'Console.WriteLine("ReceivedByEmailAddress: " + msg.ReceivedByEmailAddress) 'Console.WriteLine("DisplayTo: " + msg.DisplayTo) 'Console.WriteLine("DisplayCc: " + msg.DisplayCc) 'Console.WriteLine("Body: " + msg.Body) 'Console.WriteLine("-----------------------------------------------------------------------") 'Console.WriteLine("BodyHtmlText: " + msg.BodyHtmlText) Dim fromPattern As String = "" Dim toPattern As String = "" Dim messageIDPattern As String = "" Dim finalize_pattern As String = "" ' Email Header auslesen Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg) For Each rowregex As DataRow In CURRENT_DT_REGEX.Rows If rowregex.Item("FUNCTION_NAME") = "FROM_EMAIL_HEADER" Then fromPattern = rowregex.Item("REGEX") ElseIf rowregex.Item("FUNCTION_NAME") = "TO_EMAIL_HEADER" Then toPattern = rowregex.Item("REGEX") ElseIf rowregex.Item("FUNCTION_NAME") = "MESSAGE_ID" Then messageIDPattern = rowregex.Item("REGEX") ElseIf rowregex.Item("FUNCTION_NAME") = "FINALIZE" Then finalize_pattern = rowregex.Item("REGEX") End If Next Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "'") If IsNothing(DT) Then ClassLogger.Add(" >> SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "' 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 ClassLogger.Add("A messageID could not be read!", True) Else If Not IsNothing(headers) Then CURRENT_MESSAGEID = ClassEmailHeaderExtractor.extractFromHeader(headers, messageIDPattern) If IsNothing(CURRENT_MESSAGEID) Then CURRENT_MESSAGEID = "" End If Else ClassLogger.Add("A messageID could not be read - messageheader nothing/messagIDpattern value!", True) 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" ClassLogger.Add(" >> DisplayTo in email is nothing - default will be set", False) emailTo = "NO RECIPIENT" Else _step = "4.4" emailTo = msgDisplayTo.ToString.Replace("'", "") End If If IsNothing(msgInternetAccountName) Then _step = "4.5" ClassLogger.Add(" >> InternetAccountName in email is nothing - default will be set", False) emailFrom = "" Else _step = "4.6" emailFrom = msgInternetAccountName.ToString.Replace("'", "") End If Else _step = "5" If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo and From Extraction via messageheader.", False) 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" If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo couldn't be extracted from messageheader...", False) If (headers.Contains("exc") Or headers.Contains("exchange")) Then _step = "5.2" If LogErrorsOnly = False Then ClassLogger.Add(" >> ...try with LDAP-option", False) Dim _email = GetUserEmailfromLDAP(msgDisplayTo) _step = "5.3" If _email <> "" Then emailTo = _email Else ClassLogger.Add(">> email-adress couldn't be read from LDAP with name '" & msgDisplayTo & "'", False) 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" If LogErrorsOnly = False Then ClassLogger.Add(" >> no exchange patterns found in headers!", False) 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" ClassLogger.Add(" >> 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" ClassLogger.Add(" >> emailTo is Nothing?!") End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Headers-Content: ", True) If LogErrorsOnly = False Then ClassLogger.Add(headers.ToString, False) End If 'Handler für leere emailFrom-Adresse If IsNothing(emailFrom) Then _step = "7" ClassLogger.Add(" >> emailFrom couldn't be extracted from messageheader...", False) If Not IsNothing(msg.SenderEmailAddress) Then If msg.SenderEmailAddress <> String.Empty Then _step = "7.1" ClassLogger.Add(" >> emailFrom via msg.SenderEmailAddress will be used instead!", False) emailFrom = msg.SenderEmailAddress.ToString.Replace("'", "") End If End If End If If IsNothing(emailFrom) Or emailFrom = String.Empty Then _step = "7.2" CURR_MISSING_PATTERN_NAME = "Email From" CURR_MISSING_SEARCH_STRING = emailFrom CURR_MISSING_MANUAL_VALUE = String.Empty frmMissingInput.ShowDialog() If CURR_MISSING_MANUAL_VALUE <> String.Empty Then _step = "7.3" emailFrom = CURR_MISSING_MANUAL_VALUE Else MsgBox("Could't get 'emailfrom' from messageHeader." & vbNewLine & "Please check the dropped email and Configuration of Email-Indexing!", MsgBoxStyle.Exclamation) Return False End If End If If LogErrorsOnly = False Then ClassLogger.Add(" >> emailFrom: " & emailFrom, False) If LogErrorsOnly = False Then ClassLogger.Add(" >> emailTo: " & emailTo, False) '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 ClassLogger.Add(" >> 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 ClassLogger.Add(" >> 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 ClassLogger.Add(" >> msg subject is empty...DEFAULT will be set", False) 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> Now all email-items will be indexed!", False) If LogErrorsOnly = False Then ClassLogger.Add(" >> subj: " & subj, False) 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> MessageDeliveryTime: " & msg.MessageDeliveryTime, False) 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 MsgBox("Error in SetEmailIndices:" & vbNewLine & ex.Message & vbNewLine & "Please check the configuration Email-Indexing!", MsgBoxStyle.Critical) ClassLogger.Add("Error in SetEmailIndices (Step finisched: " & _step & "): " & ex.Message) ClassLogger.Add("Stack-Trace: " & ex.StackTrace, True) 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, False) End Try End Using Return userEmail End Function Private Function SetAttachmentIndices() Dim indexierung_erfolgreich As Boolean = True Try Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "'") 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 MsgBox("Error in SetAttachmentIndices:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Private Function SINGLEFILE_2_WINDREAM(_Objekttyp As String) Try ClassWindream._WDObjekttyp = _Objekttyp Dim streamresult = ClassWindream.Stream_File(CURRENT_WORKFILE, CURRENT_NEWFILENAME) Return streamresult Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in 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 = version + 1 neuername = Stammname.Replace(extension, "") & _versionTz & version & extension CURRENT_NEWFILENAME = neuername Loop End If 'Die Datei wird nun verschoben My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME) Dim Insert_String As String Try Dim tempCur_WF = CURRENT_WORKFILE.Replace("'", "''") Dim tempCur_New_FN = CURRENT_NEWFILENAME.Replace("'", "''") Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO,ADDED_WHERE) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "','" & Environment.MachineName & "')" If ClassDatabase.Execute_non_Query(Insert_String) = True Then If CURRENT_MESSAGEID <> "" Then Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" Dim GUID = ClassDatabase.Execute_Scalar(max, MyConnectionString, True) 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 ClassDatabase.Execute_Scalar(sql, MyConnectionString, True) Else sql = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID ClassDatabase.Execute_Scalar(sql, MyConnectionString, True) End If End If Catch ex As Exception End Try End If End If Return False Catch ex As Exception ClassLogger.Add(" - Unexpected error in Move_Rename - Fehler: " & vbNewLine & ex.Message) ClassLogger.Add(" - Unexpected error in Move_Rename - Insert_String: " & Insert_String) Return True End Try End Function '#End Region Public Sub New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Private Sub frmIndex_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Try ' This prevents the thread issue when the form containing the viewer is opened via ShowDialog. DocumentViewer1.Done() ClassWindowLocation.SaveFormLocationSize(Me) My.Settings.Save() Catch ex As Exception ClassLogger.Add(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") End Try End Sub Private Sub frmIndex_Load(sender As Object, e As System.EventArgs) Handles Me.Load ' Abbruchzähler zurücksetzen CancelAttempts = 0 Try CURRENT_ISATTACHMENT = False DropType = ClassDatabase.Execute_Scalar("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID, MyConnectionString, True) chkdelete_origin.Visible = False VIEWER_LICENSE = ClassDatabase.Execute_Scalar("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'", MyConnectionString) 'TODO: Load License from DB DocumentViewer1.Init(LOGCONFIG, VIEWER_LICENSE) CURRENT_DROPTYPE = DropType.Replace("|", "") If DropType = "|DROPFROMFSYSTEM|" Then chkdelete_origin.Visible = True chkdelete_origin.Checked = CURR_DELETE_ORIGIN If USER_LANGUAGE <> "de-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|" If LogErrorsOnly = False Then ClassLogger.Add(" >> .msg-file from folderwatch", False) If USER_LANGUAGE <> "de-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|" If LogErrorsOnly = False Then ClassLogger.Add(" >> .msg-file through dragdrop", False) If USER_LANGUAGE <> "de-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 = "de-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 = "de-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 = "de-DE" Then Me.Text = "Indexierung einer Folderwatch-Datei:" Else Me.Text = "Indexing of Folderwatch-File:" End If End If txtIndexfilepath.Text = CURRENT_WORKFILE ClassWindowLocation.LoadFormLocationSize(Me) If CONFIG.Config.FilePreview = True Then SplitContainer1.Panel2Collapsed = False PreviewFile() Me.tslblVorschau.Visible = True Else SplitContainer1.Panel2Collapsed = True Me.tslblVorschau.Visible = False End If Load_String() MULTIFILES = ClassDatabase.Execute_Scalar("SELECT COUNT(*) FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & CURRENT_WORKFILE_GUID & " AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')", MyConnectionString, True) MULTIINDEXING_ACTIVE = False If MULTIFILES > 0 Then If USER_LANGUAGE = "de-DE" Then chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" Else chkMultiIndexer.Text = "Multi-Indexing - All following files (" & MULTIFILES & ") will be indexed identically" End If chkMultiIndexer.Checked = False chkMultiIndexer.Visible = True Else chkMultiIndexer.Visible = False End If Catch ex As Exception ClassLogger.Add(" - Unexpected error in Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Öffnen des Formulares:") End Try End Sub Sub Load_String() Try Me.VWDDINDEX_MANTableAdapter.Connection.ConnectionString = MyConnectionString Me.VWINDEX_AUTOMTableAdapter.Connection.ConnectionString = MyConnectionString 'Me.VWIORDNER_DOKARTTableAdapter.Connection.ConnectionString = My.Settings.MyConnectionString 'Me.VWDMS_DOKUMENTARTZUORDNUNGTableAdapter.Connection.ConnectionString = My.Settings.MyConnectionString 'Me.TBCONNECTIONTableAdapter.Connection.ConnectionString = My.Settings.MyConnectionString 'Me.VWINDEX_AUTOMTableAdapter.Connection.ConnectionString = My.Settings.MyConnectionString 'Me.VWINDEX_MANTableAdapter.Connection.ConnectionString = My.Settings.MyConnectionString Catch ex As Exception ClassLogger.Add(" - Unexpected error in Speichern der Verbindung - Fehler: " & vbNewLine & ex.Message) MsgBox("Unexpected error in Speichern der Verbindung: " & vbNewLine & ex.Message, MsgBoxStyle.Exclamation) End Try End Sub Private Sub frmIndex_LocationChanged(sender As Object, e As EventArgs) Handles Me.LocationChanged End Sub Private Sub frmIndex_LostFocus(sender As Object, e As EventArgs) Handles Me.LostFocus End Sub Private Sub frmIndex_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown 'Me.TopMost = True Me.BringToFront() Me.Focus() Me.Cursor = Cursors.Default Refresh_Dokart() Me.pnlIndex.Controls.Clear() chkdelete_origin.Checked = CONFIG.Config.DeleteOriginalFile CURR_DELETE_ORIGIN = chkdelete_origin.Checked formloaded = True If My.Settings.DA_Vorauswahlaktiv = True Then If CURRENT_LASTDOKART <> "" Then cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(CURRENT_LASTDOKART) End If End If Try If DTTBGI_REGEX_DOCTYPE.Rows.Count > 0 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 ClassLogger.Add($"There is a match on REGEX_DOCTYPE: {oRoW.Item("DOCTYPE")}") cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(oRoW.Item("DOCTYPE")) Exit For End If Next End If Catch ex As Exception ClassLogger.Add(" - Unexpected error DTTBGI_REGEX_DOCTYPE - ErrorMessage: " & vbNewLine & ex.Message) End Try Me.TopMost = True Me.BringToFront() End Sub Sub Refresh_Dokart() Try Dim sql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", Environment.UserName) If LogErrorsOnly = False Then ClassLogger.Add(" >> SQL DoctypeList: " & sql, False) DT_DOKART = ClassDatabase.Return_Datatable(sql) cmbDokumentart.DataSource = DT_DOKART cmbDokumentart.ValueMember = DT_DOKART.Columns("DOCTYPE_ID").ColumnName cmbDokumentart.DisplayMember = DT_DOKART.Columns("DOCTYPE").ColumnName cmbDokumentart.AutoCompleteMode = AutoCompleteMode.Suggest cmbDokumentart.AutoCompleteSource = AutoCompleteSource.ListItems Me.cmbDokumentart.SelectedIndex = -1 Catch ex As Exception ClassLogger.Add(" - Unexpected error inm Laden der Dokumentarten - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Laden der Dokumentarten:") End Try End Sub Private Sub cmbDokumentart_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbDokumentart.SelectedIndexChanged If cmbDokumentart.SelectedIndex <> -1 And formloaded = True Then If cmbDokumentart.SelectedValue.GetType.ToString = "System.Int32" Then CURRENT_DOKART_ID = cmbDokumentart.SelectedValue lblhinweis.Visible = False lblerror.Visible = False Me.pnlIndex.Controls.Clear() Dim sql As String = "Select WINDREAM_DIRECT, DUPLICATE_HANDLING from TBDD_DOKUMENTART WHERE GUID = " & cmbDokumentart.SelectedValue Dim DT_DOKART As DataTable = ClassDatabase.Return_Datatable(sql) WDDirect = DT_DOKART.Rows(0).Item("WINDREAM_DIRECT") CURRENT_DOKART_DUPLICATE_HANDLING = DT_DOKART.Rows(0).Item("DUPLICATE_HANDLING") Refresh_IndexeMan(cmbDokumentart.SelectedValue) 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 = ClassDatabase.Return_Datatable(sql) pnlIndex.Visible = True LoadIndexe_Man() Catch ex As System.Exception ClassLogger.Add(" - Fehler Refresh_IndexeMan: DOKART-ID: " & dokartid & " - Fehler: " & vbNewLine & ex.Message & vbNewLine & sql) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Refresh_IndexeMan:") End Try End Sub ' _ Function Check_HistoryValues(Indexname As String, Dokart 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 MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Check_HistoryValues:") End Try End Function Private Sub LoadIndexe_Man() Try Dim anz As Integer = 1 Dim ylbl As Integer = 11 Dim y As Integer = 33 If DT_INDEXEMAN.Rows.Count = 0 Then ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert") ClassLogger.Add(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDokumentart.Text & " definiert") End If For Each DR As DataRow In DT_INDEXEMAN.Rows Dim type = DR.Item("DATATYPE") Dim MultiSelect As Boolean = DR.Item("MULTISELECT") Dim AddNewItems As Boolean = DR.Item("VKT_ADD_ITEM") Dim PreventDuplicates As Boolean = DR.Item("VKT_PREVENT_MULTIPLE_VALUES") If type <> "BOOLEAN" Then addLabel(DR.Item("NAME"), DR.Item("COMMENT").ToString, ylbl, anz) End If Dim DefaultValue = Check_HistoryValues(DR.Item("NAME"), DR.Item("DOKUMENTART")) If DefaultValue Is Nothing Then DefaultValue = DR.Item("DEFAULT_VALUE") End If Select Case type Case "BOOLEAN" 'nur eine Textbox Dim chk As CheckBox = ClassControls.AddCheckBox(DR.Item("NAME"), y, DefaultValue, DR.Item("COMMENT").ToString) If Not IsNothing(chk) Then pnlIndex.Controls.Add(chk) End If Case "INTEGER" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), MultiSelect, DefaultValue, AddNewItems, PreventDuplicates) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else 'nur eine Textbox AddTextBox(DR.Item("NAME"), y, DefaultValue) End If Case "VARCHAR" If DR.Item("SUGGESTION") = True And DR.Item("SQL_RESULT").ToString.Length > 0 Then AddVorschlag_ComboBox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), MultiSelect, DefaultValue, AddNewItems, PreventDuplicates) 'AddAutoSuggest_Textbox(DR.Item("NAME"), y, DR.Item("CONNECTION_ID"), DR.Item("SQL_RESULT"), DefaultValue) Else If DR.Item("NAME").ToString.ToLower = "dateiname" Then 'Übergibt den Dateinamen um diesen Vorzuschlagen AddTextBox(DR.Item("NAME"), y, System.IO.Path.GetFileNameWithoutExtension(CURRENT_WORKFILE)) Else Dim VORBELGUNG As String = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("NAME"), y, VORBELGUNG) End If End If Case "DATE" AddDateTimePicker(DR.Item("NAME"), y) Case Else If USER_LANGUAGE = "de-DE" Then MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") Else MsgBox("Please check Datatype of Indexvalue!", MsgBoxStyle.Critical, "Warning:") End If ClassLogger.Add(" - Datentyp nicht hinterlegt - LoadIndexe_Man") End Select anz += 1 ylbl += 50 y += 50 'make y as height in fom Next Dim pnlHeight = y - 30 If pnlIndex.Height < pnlHeight Then If (Me.Height - 315) < pnlHeight Then Me.Height = (Me.Height - 315) + pnlHeight End If pnlIndex.Height = pnlHeight End If SendKeys.Send("{TAB}") Catch ex As Exception ClassLogger.Add(" - Unexpected error in LoadIndexe_Man - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in LoadIndexe_Man:") End Try End Sub Sub AddComboBoxValue(cmbName As ComboBox, Value As String) cmbName.Items.Add(Value) End Sub Function GetPlaceholderValue(InputValue As String, FileName As String, UserShortName As String) Dim oResult = Nothing 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" oResult = Environment.UserName Case "$Usercode" oResult = UserShortName End Select Catch ex As Exception ClassLogger.Add("Error in ReplacePlaceholders: " & 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 oAutoIndexRow As DataRow In oDatatable If LogErrorsOnly = False Then ClassLogger.Add("Working on AutomaticIndex: " & oAutoIndexRow.Item("INDEXNAME") & "...", False) Dim oSqlResult As String = ClassHelper.NotNull(oAutoIndexRow.Item("SQL_RESULT"), "") Dim oSqlActive As Boolean = ClassHelper.NotNull(oAutoIndexRow.Item("SQL_ACTIVE"), False) Dim oSqlConnectionId As Integer = ClassHelper.NotNull(oAutoIndexRow.Item("CONNECTION_ID"), -1) Dim oSqlProvider As String = ClassHelper.NotNull(oAutoIndexRow.Item("SQL_PROVIDER"), "") Dim oEndResult As New List(Of String) ' Wenn kein SQL Befehl vorhanden oder aktiv ist, ' versuchen wir, die Spalte VALUE zu ersetzen If oSqlResult = String.Empty Or oSqlActive = 0 Then Dim oPlaceholderResult As String Dim oValue As String = ClassHelper.NotNull(oAutoIndexRow.Item("VALUE"), "") oPlaceholderResult = GetPlaceholderValue(oValue, CURRENT_WORKFILE, USER_SHORT_NAME) If Not IsNothing(oPlaceholderResult) Then oValue = oPlaceholderResult End If oAutoIndexRow.Item("Indexiert") = True oAutoIndexRow.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_SHORT_NAME) ' Einfachen Platzhalter ersetzen If Not IsNothing(oPlaceholderResult) Then oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult) End If oOptionalIndex = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')", MyConnectionString, True) 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 If oSqlResult <> String.Empty Then If LogErrorsOnly = False Then ClassLogger.Add(" oSqlResult afrer first Replace: " & oSqlResult, False) End If ' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl, ' der nur noch vektorfelder-platzhalter enthält ' 2. Schritt: Vektorfelder ersetzen Dim oVectorMatches As MatchCollection = oRegex.Matches(oSqlResult) If oVectorMatches.Count > 0 Then If LogErrorsOnly = False Then ClassLogger.Add(" There are " & oVectorMatches.Count & " matches for vectors!", False) 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 = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {CURRENT_DOKART_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')", MyConnectionString, True) oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) Dim oVectorIndexValues = oManualIndexResult.Split(ClassConstants.VECTORSEPARATOR).ToList() For Each oVectorIndexValue In oVectorIndexValues Dim oTempSql = oSqlResult.Replace(oVectorMatch.Value, oVectorIndexValue) Dim oResult = GetAutomaticIndexSQLValue(oTempSql, oSqlConnectionId, oSqlProvider) oEndResult.Add(oResult) Next ' Verhindert, dass die Schleife mehrmals durchlaufen wird If oIsFirstMatch Then Exit For End If oAutoIndexRow.Item("Indexiert") = True oAutoIndexRow.Item("Indexwert") = String.Join(ClassConstants.VECTORSEPARATOR, oEndResult.ToArray) Next Else Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider) If LogErrorsOnly = False Then ClassLogger.Add("Got a simple SQLResult: " & oResult.ToString, False) oAutoIndexRow.Item("Indexiert") = True oAutoIndexRow.Item("Indexwert") = oResult End If Next Return True Catch ex As Exception MsgBox(ex.Message) Return False End Try ' 3. Schritt: SQL ausführen ' 4. Schritt: Resultat in Datatable schreiben 'Try ' Me.VWINDEX_AUTOMTableAdapter.Fill(Me.MyDataset.VWDDINDEX_AUTOM, CURRENT_DOKART_ID) ' Dim DT_INDEXAUTOM As DataTable = MyDataset.VWDDINDEX_AUTOM ' If DT_INDEXAUTOM.Rows.Count > 0 Then ' ' MsgBox(DT.Rows.Count.ToString) ' For Each DR_AUTOINDEX As DataRow In DT_INDEXAUTOM.Rows ' Dim optionalIndex As Boolean ' Dim indexname As String = DR_AUTOINDEX.Item("INDEXNAME") ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Build Automatischer Index '" & indexname & "'", False) ' If DR_AUTOINDEX.Item("SQL_RESULT").ToString <> String.Empty And CBool(DR_AUTOINDEX.Item("SQL_ACTIVE")) = True Then ' ' Regulären Ausdruck zum Auslesen der windream-Indexe definieren ' Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' ' SQL-String für aktuellen INdex laden ' Dim SqlString As String = DR_AUTOINDEX.Item("SQL_RESULT") ' ' 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 elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(SqlString) ' ' alle Vorkommen der Indexe im SQL-String durchlaufen ' For Each element As System.Text.RegularExpressions.Match In elemente ' ' MsgBox(element.Value.ToUpper) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Element: '" & element.Value & "'", False) ' '' wenn es sich nicht um dedizeirte Werte handelt (es sollen ja nur die Indexe ausgelesen werden) ' 'If Not element.Value.ToUpper = "[%SPALTE]" And Not element.Value.ToUpper = "[%VIEW]" Then ' 'die Zeichen [% und ] entfernen (liefert den wirklichen windream-Index) ' Dim elementOhneSonderzeichen As String = element.Value.Substring(2, element.Value.Length - 3) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> elementOhneSonderzeichen: '" & elementOhneSonderzeichen & "'", False) ' optionalIndex = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & elementOhneSonderzeichen & "')", MyConnectionString, True) ' If elementOhneSonderzeichen.StartsWith("$") Then 'windowsParameter ' Dim result = "" ' Try ' Select Case elementOhneSonderzeichen.ToString.ToUpper ' Case "$filename_ext".ToUpper ' result = Path.GetFileName(CURRENT_WORKFILE) ' Case "$filename".ToUpper ' result = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) ' Case "$extension".ToUpper ' result = Path.GetExtension(CURRENT_WORKFILE) ' result = result.Replace(".", "") ' Case "$FileCreateDate".ToUpper ' Dim FI As New FileInfo(CURRENT_WORKFILE) ' Dim CreationDate As Date = FI.CreationTime ' result = CreationDate.ToShortDateString ' Case "$FileCreatedWho".ToUpper ' Dim fs As FileSecurity = File.GetAccessControl(CURRENT_WORKFILE) ' Dim sid As IdentityReference = fs.GetOwner(GetType(SecurityIdentifier)) ' Dim ntaccount As IdentityReference = sid.Translate(GetType(NTAccount)) ' Dim owner As String = ntaccount.ToString() ' result = owner ' Case "$DateDDMMYYY".ToUpper ' result = System.DateTime.Now.ToShortDateString ' Case "$Username" ' result = Environment.UserName ' Case "$Usercode" ' result = USER_SHORT_NAME ' End Select ' Catch ex As Exception ' result = "XXX" ' ClassLogger.Add(" - Unexpected error in FillIndexe_Autom - WindowsFilePatterns - Fehler: " & vbNewLine & ex.Message) ' MsgBox("Unexpected error in Replacement WindowsFilePatterns: " & vbNewLine & ex.Message & vbNewLine & vbNewLine & "Routine will continue - Please check logfile", MsgBoxStyle.Exclamation, ) ' End Try ' If result <> "" Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> file-related parameter found: '" & elementOhneSonderzeichen & "' - Result: '" & result & "'", False) ' SqlString = SqlString.Replace(element.Value, result) ' Else ' ClassLogger.Add(">> Attention: file-related parameter '" & elementOhneSonderzeichen & "' returned an empty string!", False) ' End If ' Else 'ganz normaler manueller Index ' 'den Platzhalter im SQL-String durch den Wert ersetzen ' Dim manIndexwert = GetManIndex_Value(elementOhneSonderzeichen, "IDX_AUTO", optionalIndex) ' If Not IsNothing(manIndexwert) Then ' SqlString = SqlString.Replace(element.Value, manIndexwert) ' Else ' ClassLogger.Add(">> Attention: manIndexwert is NOTHING - Funktion: FillIndexe_Autom", False) ' ' Return False ' End If ' End If ' Next ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Replaced and complete SQL-result: " & SqlString, False) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ausführen SQL....", False) ' Dim automatischerValue As String = "" ' automatischerValue = GetAutomaticIndexSQLValue(SqlString, DR_AUTOINDEX.Item("CONNECTION_ID"), DR_AUTOINDEX.Item("SQL_PROVIDER")) ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis SQL: '" & automatischerValue & "'", False) ' If automatischerValue <> String.Empty Then ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = automatischerValue ' Else ' If optionalIndex = True Then ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = "EMPTY_OI" ' ' Return True ' Else ' ClassLogger.Add(" - ACHTUNG: automatischerValue = String.Empty - Funktion: FillIndexe_Autom", False) ' ClassLogger.Add(" - SqlString: " & SqlString, False) ' ' Return False ' End If ' End If ' Else ' If Not IsDBNull(DR_AUTOINDEX.Item("VALUE")) Then ' If DR_AUTOINDEX.Item("VALUE") <> "" Then ' Dim DEFAULTVALUE As String = DR_AUTOINDEX.Item("VALUE") ' 'Indexierung mit WindowsVariable ' If DEFAULTVALUE.StartsWith("$") Then ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einer Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Select Case DEFAULTVALUE.ToUpper ' Case "$filename_ext".ToUpper ' DEFAULTVALUE = Path.GetFileName(CURRENT_WORKFILE) ' Case "$filename".ToUpper ' DEFAULTVALUE = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) ' Case "$extension".ToUpper ' DEFAULTVALUE = Path.GetExtension(CURRENT_WORKFILE) ' Case "$FileCreateDate".ToUpper ' Dim FI As New FileInfo(CURRENT_WORKFILE) ' Dim CreationDate As Date = FI.CreationTime ' DEFAULTVALUE = CreationDate.ToShortDateString ' Case "$FileCreatedWho".ToUpper ' Dim fs As FileSecurity = File.GetAccessControl(CURRENT_WORKFILE) ' Dim sid As IdentityReference = fs.GetOwner(GetType(SecurityIdentifier)) ' Dim ntaccount As IdentityReference = sid.Translate(GetType(NTAccount)) ' Dim owner As String = ntaccount.ToString() ' DEFAULTVALUE = owner ' Case "$DateDDMMYYY".ToUpper ' DEFAULTVALUE = System.DateTime.Now.ToShortDateString ' Case "$Username" ' DEFAULTVALUE = Environment.UserName ' Case "$Usercode" ' DEFAULTVALUE = USER_SHORT_NAME ' End Select ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis der Windowsvariable: '" & DEFAULTVALUE & "'", False) ' Else ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung mit einem Festen Wert: '" & DEFAULTVALUE & "'", False) ' End If ' 'Den Wert in der Zwischentabelle speichern ' DR_AUTOINDEX.Item("Indexiert") = True ' DR_AUTOINDEX.Item("Indexwert") = DEFAULTVALUE ' End If ' End If ' End If ' Next ' 'MsgBox("Noch kein automatischer Index-SQL-String hinterlegt, dennoch wird das Dokument abgelegt!") ' Return True ' Else ' Return True ' End If 'Catch ex As System.Exception ' ClassLogger.Add(" - Unexpected error in FillIndexe_Autom - Fehler: " & vbNewLine & ex.Message) ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in 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 MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in 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 Sub CheckBox1_CheckedChanged(sender As System.Object, e As System.EventArgs) CONFIG.Config.FilePreview = CheckBox1.Checked CONFIG.Save() 'SaveConfigValue("Preview", True) End Sub Private Function WORK_FILE() Try Me.VWDDINDEX_MANTableAdapter.Fill(Me.MyDataset.VWDDINDEX_MAN, CURRENT_DOKART_ID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Manuelle Indexe geladen", False) If MyDataset.VWDDINDEX_MAN.Rows.Count > 0 Then CURRENT_DOKART_ID = Me.cmbDokumentart.SelectedValue If CheckWrite_IndexeMan(Me.cmbDokumentart.SelectedValue) = True Then '##### Manuelle Indexe indexiert ##### If LogErrorsOnly = False Then ClassLogger.Add(" >> Datei " & CURRENT_WORKFILE & " wird nun indexiert...", False) If FillIndexe_Autom(Me.cmbDokumentart.SelectedValue) = True Then If LogErrorsOnly = False Then ClassLogger.Add(" ...FillIndexe_Autom durchlaufen", False) 'Den Zielnamen zusammenbauen If Name_Generieren() = True Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Name_Generieren durchlaufen", False) 'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren DocumentViewer1.Done() If LogErrorsOnly = False Then ClassLogger.Add(" ...Viewer geschlossen", False) 'Die Datei verschieben If Move_File2_Target() = True Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Move_File2_Target durchlaufen", False) 'Die Originaldatei löschen If DropType = "|DROPFROMFSYSTEM|" Then If CURR_DELETE_ORIGIN = True Then 'Die temporäre Datei löschen DeleteFile() End If ElseIf DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then 'Die temporäre Datei löschen If CURRENT_WORKFILE.EndsWith("pdf") Then DocumentViewer1.Done() End If DeleteFile() ElseIf (DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|") Then 'Die temporäre Datei löschen DeleteFile() ElseIf DropType = "|FW_SIMPLEINDEXER|" Then 'Die temporäre Datei löschen DeleteFile() End If CURRENT_LASTDOKART = cmbDokumentart.Text ClassLogger.Add(" >> Datei '" & CURRENT_NEWFILENAME & "' erfolgreich erzeugt.", False) Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID ClassDatabase.Execute_non_Query(oDEL, True) Return True End If Else If USER_LANGUAGE = "de-DE" Then MsgBox("Unerwarteter Fehler in Name_Generieren - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) Else MsgBox("Unexpected error in Name_Generieren - Please check the Logfile", MsgBoxStyle.Critical) End If Return False End If Else If USER_LANGUAGE = "de-DE" Then MsgBox("Unerwarteter Fehler in FillIndexe_Autom - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) Else MsgBox("Unexpected error in FillIndexe_Autom - Please check the Logfile", MsgBoxStyle.Critical) End If Return False End If '#### Automatische Werte indexieren #### End If Else If USER_LANGUAGE = "de-DE" Then MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation) Else MsgBox("Please check the configuration for this document-type." & vbNewLine & "There are NO manual indicies that are either configured or set to active!", MsgBoxStyle.Exclamation) End If Return False End If Catch ex As Exception MsgBox("Unexpected Error in WORK_FILE:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Sub DeleteFile() Try If CURR_DELETE_ORIGIN = False Then If CURRENT_DROPTYPE <> "FW_SIMPLEINDEXER" Then If LogErrorsOnly = False Then ClassLogger.Add(">> DeleteFile - CURR_DELETE_ORIGIN = False", False) Exit Sub End If End If File.Delete(CURRENT_WORKFILE) Catch ex As Exception MsgBox("Unexpeted Error in Delete Current Workfile:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub OK_Button_Click(sender As Object, e As EventArgs) Handles btnOK.Click 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 chkMultiIndexer.Visible = True And chkMultiIndexer.Checked = True Then 'Die erste Datei indexieren If WORK_FILE() = True Then 'Und nun die folgenden Dim DTFiles2Work As DataTable = ClassDatabase.Return_Datatable("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 = filerow.Item("FILENAME2WORK") DropType = filerow.Item("HANDLE_TYPE") 'Dim HandleType As String = filerow.Item("HANDLE_TYPE") 'If HandleType = "|DROPFROMFSYSTEM|" Then ' DropType = "dragdrop file" 'ElseIf HandleType = "|OUTLOOK_ATTMNT|" Then ' DropType = "dragdrop attachment" 'ElseIf HandleType = "|OUTLOOKMESSAGE|" Then ' DropType = "dragdrop message" 'End If If WORK_FILE() = False Then err = True Exit For End If Next Me.Cursor = Cursors.Default If err = False Then If USER_LANGUAGE = "de-DE" Then MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:") Else MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success") End If DTACTUAL_FILES.Clear() Me.Close() End If End If End If Else If WORK_FILE() = True Then Me.Cursor = Cursors.Default If My.Settings.Show_IndexResult = True Then If USER_LANGUAGE = "de-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 err As Boolean = False Try Dim sql As String = "SELECT FOLDER_FOR_INDEX FROM TBDD_DOKUMENTART WHERE GUID = " & CURRENT_DOKART_ID Dim Folder_for_index = ClassDatabase.Execute_Scalar(sql, MyConnectionString, True) If Not IsDBNull(Folder_for_index) Then If Folder_for_index <> String.Empty Then CreateFolderForIndex(Folder_for_index) End If End If If CBool(CURR_DOKART_WD_DIRECT) = False Then 'Datei verschieben err = Move_Rename_Only(CURRENT_WORKFILE, CURRENT_NEWFILENAME, CURR_WORKFILE_EXTENSION, VERSION_DELIMITER) Else If CURRENT_NEWFILENAME.Contains("//") Then CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Replace("//", "/") End If If CURRENT_NEWFILENAME.Contains("\\") Then CURRENT_NEWFILENAME = CURRENT_NEWFILENAME.Replace("\\", "\") End If Dim exp2WD As Boolean = False 'Variable Folder If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then exp2WD = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE) ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Then exp2WD = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE) End If If exp2WD = True Then 'Prüfen ob Session da ist - wenn nicht nochmal neu initiieren If ClassWindream.oSession Is Nothing Then ClassWindream.Init() End If 'Kein Fehler in Export2windream err = 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("'", "''") Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')" ClassDatabase.Execute_Scalar(Insert_String, MyConnectionString, True) 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 = ClassDatabase.Execute_Scalar(max, MyConnectionString, True) 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 ClassDatabase.Execute_non_Query(sqlUpdate, True) Else sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & CURRENT_MESSAGEID & "' WHERE GUID = " & GUID ClassDatabase.Execute_non_Query(sqlUpdate, True) End If End If Catch ex As Exception End Try End If End If Catch ex As Exception MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(" - Unexpected error in Insert-History - Fehler: " & vbNewLine & ex.Message) ClassLogger.Add(" - Unexpected error in Insert-History - SQL: " & Insert_String) err = True End Try Else err = True End If Else err = True If USER_LANGUAGE = "de-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 err = False Then Return True Else 'Fehler aufgetreten Return False End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected Error in Move File2Target:") err = True End Try End Function Private Function CreateFolderForIndex(myDynamicFolder As String) Try Dim ORootFolder As String = Path.GetDirectoryName(CURRENT_NEWFILENAME) '###### Dim p_reg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim regularExpression As Regex = New Regex(p_reg) ' die Vorkommen im Folder-String auslesen Dim elemente As MatchCollection = regularExpression.Matches(myDynamicFolder) '#### ' alle Vorkommen innerhalb des Ordnerstrings durchlaufen For Each element As Match In elemente If LogErrorsOnly = False Then ClassLogger.Add(" >> Elementname in FolderString: '" & element.ToString & "'", False) Select Case element.Value.Substring(2, 1).ToUpper 'Manueller Indexwert Case "M" Dim ManIndexname = element.Value.Substring(3, element.Value.Length - 4) Dim optional_index As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & CURRENT_DOKART_ID & " AND UPPER(NAME) = UPPER('" & ManIndexname & "')", MyConnectionString, True) If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch den Indexwert aus '" & ManIndexname & "' auszulesen.", False) Dim ManIndex_Value As String = GetManIndex_Value(ManIndexname, "FILE", optional_index) If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis/Wert für neuen Ordner: '" & ManIndexname & "'", False) If Not ManIndex_Value = String.Empty Then If IsDate(ManIndex_Value) Then ManIndex_Value = CDate(ManIndex_Value).ToString("yyyyMMdd") End If ManIndex_Value = ClassFilehandle.CleanFilename(ManIndex_Value, "") myDynamicFolder = myDynamicFolder.Replace(element.ToString, ManIndex_Value) If LogErrorsOnly = False Then ClassLogger.Add(" >> FolderPattern: '" & myDynamicFolder & "'", False) Else If optional_index = True Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Optionaler Indexwert ist NICHT gefüllt", False) Else ClassLogger.Add(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!", True) Return True End If End If Case "A" Dim AutoIndexname = element.Value.Substring(3, element.Value.Length - 4) If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch den Auto-Indexwert aus '" & AutoIndexname & "' auszulesen.", False) Dim AutoIndex_Value As String = GetAutoIndex_Value(AutoIndexname) If LogErrorsOnly = False Then ClassLogger.Add(" >> Ergebnis/Wert für neuen Ordner: '" & AutoIndexname & "'", False) If Not AutoIndex_Value = String.Empty Then AutoIndex_Value = ClassFilehandle.CleanFilename(AutoIndex_Value, "") If AutoIndex_Value = "EMPTY_OI" Then myDynamicFolder = myDynamicFolder.Replace(element.ToString, "") Else myDynamicFolder = myDynamicFolder.Replace(element.ToString, AutoIndex_Value) If LogErrorsOnly = False Then ClassLogger.Add(" >> FolderPattern: '" & myDynamicFolder & "'", False) End If Else ClassLogger.Add(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!", True) 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 = element.Value.Substring(3, element.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 myDynamicFolder = myDynamicFolder.Replace(element.ToString, oElementTemp) If LogErrorsOnly = False Then ClassLogger.Add(" >> FolderPatter nach V-Element: '" & myDynamicFolder & "'", False) Case Else ClassLogger.Add(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & element.Value.ToUpper) If USER_LANGUAGE = "de-DE" Then MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & element.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") Else MsgBox("Attention - One element in Namingconvention could not be matched!" & vbNewLine & "Elementname: " & element.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") End If End Select Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Den Root-Folder zusammenfügen>> ", False) Dim oNewFullpath As String = ORootFolder & "\" & myDynamicFolder & "\" oNewFullpath = oNewFullpath.Replace("\\", "\") oNewFullpath = Path.Combine(ORootFolder, myDynamicFolder) If LogErrorsOnly = False Then ClassLogger.Add(" >> Fullpath (mit evtl. Sonderzeichen (SZ)) '" & oNewFullpath & "'", False) 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> Fullpath (ohne SZ) '" & oNewFullpath & "'", False) If Directory.Exists(oNewFullpath) = False Then Try Directory.CreateDirectory(oNewFullpath) If LogErrorsOnly = False Then ClassLogger.Add(" >> Folder '" & oNewFullpath & "' wurde angelegt", False) Catch ex As Exception ClassLogger.Add(" >> Error in CreateFolderforIndex-Method - Root Folder '" & oNewFullpath & "' could not be created. " & ex.Message, True) 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 MsgBox("Unexpected Error in CreateFolderforIndex-Method:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(" >> Fehler in CrFolderForIndex: " & ex.Message, True) Return False End Try End Function Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click If ToolStripButton1.Text = "Top Most = False" Then ToolStripButton1.Text = "Top Most = True" Me.TopMost = False ToolStripButton1.Checked = True Else ToolStripButton1.Text = "Top Most = False" Me.TopMost = True ToolStripButton1.Checked = False End If End Sub Private Sub chkdelete_origin_CheckedChanged(sender As Object, e As EventArgs) Handles chkdelete_origin.CheckedChanged If formloaded = True Then CURR_DELETE_ORIGIN = chkdelete_origin.Checked CONFIG.Config.DeleteOriginalFile = chkdelete_origin.Checked CONFIG.Save() End If 'SaveConfigValue("Delete_OriginFile", CURR_DELETE_ORIGIN) End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If File.Exists(CURRENT_FILENAME) Then Select Case CancelAttempts Case 0 If USER_LANGUAGE = "de-DE" Then MsgBox("Bitte indexieren Sie die Datei vollständig!" & vbNewLine & "(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information) Else MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information) End If CancelAttempts = CancelAttempts + 1 Case 1 Dim result As MsgBoxResult If USER_LANGUAGE = "de-DE" Then result = MessageBox.Show("Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!" & vbNewLine & "Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) Else result = MessageBox.Show("You abort the indexdialog for the 2nd time!" & vbNewLine & "Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) End If If result = MsgBoxResult.Yes Then Dim containsfw_file As Boolean = False Try 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 = ClassDatabase.Return_Datatable(sql, True) 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 ClassDatabase.Execute_non_Query("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')", True) = True Then If containsfw_file = True Then If USER_LANGUAGE = "de-DE" Then MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:") Else MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:") End If End If End If Catch ex As Exception MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try Close() End If End Select End If End Sub Private Sub chkMultiIndexer_CheckedChanged(sender As Object, e As EventArgs) Handles chkMultiIndexer.CheckedChanged If USER_LANGUAGE = "de-DE" Then If chkMultiIndexer.Checked Then Me.btnOK.Text = "Dateien indexieren" MULTIINDEXING_ACTIVE = True Else Me.btnOK.Text = "Datei indexieren" MULTIINDEXING_ACTIVE = False End If Else If chkMultiIndexer.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 CheckBox1_CheckedChanged_1(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged If USER_LANGUAGE = "de-DE" Then If My.Settings.DA_Vorauswahlaktiv = True Then CheckBox1.Text = "Vorauswahl Dokumentart aktivieren" Else CheckBox1.Text = "Vorauswahl Dokumentart deaktivieren" End If Else If My.Settings.DA_Vorauswahlaktiv = True Then CheckBox1.Text = "Activate Preselection of Document-Type" Else CheckBox1.Text = "Deactivate Preselection of Document-Type" End If End If End Sub End Class