Imports System.Windows.Forms Imports System.Data.SqlClient Imports System.IO Imports System.Text.RegularExpressions Imports Independentsoft Imports Oracle.ManagedDataAccess.Client Imports System.Text 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 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 Sub 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 End Sub 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 Return cmb End Function ' _ 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 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 ComboBox - Get Patterns:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try SendKeys.Send("{TAB}") End If 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, "Fehler bei Indexwert_checkValue:") ClassLogger.Add(" - Unvorhergesehener Fehler bei 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 Fehler bei Execute_Scalar_SQLServer" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler bei Ausführen sql:") ' ClassLogger.Add(" - Unvorhergesehener Fehler bei 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 Fehler bei Execute_Scalar_Oracle" & vbNewLine & "Automatischer Index (j/n): " & check.ToString & vbNewLine & "Fehler:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler bei Ausführen sql:") ' ClassLogger.Add(" - Unvorhergesehener Fehler bei 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) 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 DR.Item("Indexwert").ToString <> String.Empty Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Manueller Index: " & indexname, False) 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 optional_index = 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!") End If Return "" End If Else showlblhinweis("Der Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") Return "" End If Exit For End If Next Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei GetManIndex_Value - Fehler: " & vbNewLine & ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler bei GetManIndex_Value:") Return "" End Try End Function Function GetAutoIndex_Value(indexname As String) Try Dim DT As DataTable Dim DR As DataRow DT = MyDataset.VWDDINDEX_AUTOM For Each DR In DT.Rows If DR.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then If DR.Item("Indexiert") = True Then If DR.Item("Indexwert").ToString <> String.Empty Then Return DR.Item("Indexwert") Else showlblhinweis("Der Automatische Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Else showlblhinweis("Der Automatische Index: " & DR.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") Return "" End If Exit For End If Next Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei GetAutoIndex_Value - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler bei GetAutoIndex_Value:") Return "" End Try End Function Function Get_AutomatischerIndex_SQL(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 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(" - Fehler bei Get_AutomatischerIndex_SQL - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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, 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 newCMB As ComboBox If runinLZ = True Then 'Die Standardcombobox anlegen newCMB = addCombobox(indexname, y) newCMB.Size = New Size(300, 27) Else If NewDataset.Tables(0).Rows.Count > 0 Then 'Die Standardcombobox anlegen newCMB = addCombobox(indexname, y) '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(newCMB, 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 = newCMB.CreateGraphics If g.MeasureString(text, newCMB.Font).Width + 30 > newWidth Then newWidth = g.MeasureString(text, newCMB.Font).Width + 30 End If g.Dispose() End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Anpassung Breite ComboBox:") End Try Next newCMB.Size = New Size(newWidth, 27) newCMB.AutoCompleteSource = AutoCompleteSource.ListItems newCMB.AutoCompleteMode = AutoCompleteMode.SuggestAppend newCMB.DropDownHeight = (newCMB.ItemHeight + 0.2) * 25 If Vorgabe <> "" Then newCMB.SelectedIndex = newCMB.FindStringExact(Vorgabe) newCMB.Text = Vorgabe End If 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 Fehler bei AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Fehler bei AddVorschlag_ComboBox:") 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, "Fehler bei Anpassung Breite ComboBox:") End Try Next cmb.Size = New Size(newWidth, 27) cmb.AutoCompleteSource = AutoCompleteSource.ListItems cmb.AutoCompleteMode = AutoCompleteMode.SuggestAppend 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 Fehler bei Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Fehler bei 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("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("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 Fehler bei CheckWrite_IndexeMan:") Return False End Try End Function Sub Indexwert_Postprocessing(indexname As String, wert As String) Try Dim DT As DataTable Dim DR As DataRow DT = MyDataset.VWDDINDEX_MAN For Each DR In DT.Rows If DR.Item("INDEXNAME") = indexname Then Dim idxid As Integer = DR.Item("GUID") If idxid > 0 Then 'Die Nachbearbeitungsschritte laden Dim DTNB As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " ORDER BY SEQUENCE") If DTNB Is Nothing = False Then If DTNB.Rows.Count > 0 Then wert = ClassPostprocessing.Get_Nachbearbeitung_Wert(wert, DTNB) End If End If End If DR.Item("Indexwert") = wert DR.Item("Indexiert") = True End If Next Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei Indexwert_Postprocessing - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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 Fehler bei Get_Nachbearbeitung_Wert - result: " & result & " - Fehler: " & vbNewLine & ex.Message) ' ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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 Zielordner As String Dim extension As String = 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 If folder_Created = False Then ' Den Zielordner erstellen Zielordner = DT.Rows(0).Item("ZIEL_PFAD") If Directory.Exists(Zielordner) = False Then 'Try to create the directory. Directory.CreateDirectory(Zielordner) End If folder_Created = True End If '#### ' Regulären Ausdruck zum Auslesen der Indexe definieren Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" 'schonmal den gesamten Pfad laden Dim DATEINAME As String = Zielordner & "\" & DT.Rows(0).Item("NAMENKONVENTION") ' 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(DATEINAME) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente Console.WriteLine(element.Value) Console.WriteLine(element.Value.Substring(2, 1).ToUpper) Select Case element.Value.Substring(2, 1).ToUpper 'Manueller Indexwert Case "M" If LogErrorsOnly = False Then ClassLogger.Add(" ...Manueller Index wird geprüft...", False) Dim Indexname = element.Value.Substring(3, element.Value.Length - 4) Dim value As String = GetManIndex_Value(element.Value.Substring(3, element.Value.Length - 4)) If value <> String.Empty Then DATEINAME = DATEINAME.Replace(element.Value, value) NewFileString = DATEINAME sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & value & "'" 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 optional_index = True Then Dim result As MsgBoxResult 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) If result = MsgBoxResult.Yes Then DATEINAME = DATEINAME.Replace(element.Value, Path.GetFileNameWithoutExtension(CURRENT_WORKFILE)) NewFileString = DATEINAME sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) & "'" Else DATEINAME = DATEINAME.Replace(element.Value, value) NewFileString = DATEINAME sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & value & "'" End If Else ClassLogger.Add(" >> Der Indexvalue ist String.Empty", False) err = True End If End If Case "A" Dim value As String = GetAutoIndex_Value(element.Value.Substring(3, element.Value.Length - 4)) If value <> String.Empty Then DATEINAME = DATEINAME.Replace(element.Value, value) NewFileString = DATEINAME sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString AnzahlIndexe += 1 sql_history_Index_Values = sql_history_Index_Values & ", '" & value & "'" 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 = element.Value '.ToUpper.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 "OFilename" DATEINAME = DATEINAME.Replace(element.Value, Path.GetFileNameWithoutExtension(CURRENT_WORKFILE)) End Select If datetemp <> "" Then DATEINAME = DATEINAME.Replace(element.Value, datetemp) End If NewFileString = DATEINAME Case "[%Version]".ToUpper Try Dim version As Integer = 1 Dim Stammname As String = DATEINAME.Replace(element.Value, "") Dim _neuername As String = DATEINAME.Replace(element.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 & extension) = False Then NewFileString = _neuername Else Do While File.Exists(_neuername & extension) version = version + 1 _neuername = Stammname & VERSION_DELIMITER & version NewFileString = _neuername Loop End If Catch ex As Exception ClassLogger.Add(" - Fehler bei Umbenennnen der Datei - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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: " & element.Value.ToUpper) MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & element.Value.ToUpper, MsgBoxStyle.Exclamation, "Fehler bei Name generieren:") End Select Next CURRENT_NEWFILENAME = NewFileString & extension 'False oder True zurückgeben If err = False Then Return True Else Return False End If Catch ex As Exception ClassLogger.Add(" - Unvorhergesehener Fehler bei Name_Generieren - Fehler: " & vbNewLine & ex.Message) File.Delete(CURRENT_WORKFILE) MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Fehler bei 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 If CBool(row.Item("Indexiert")) = True And row.Item("Indexwert").ToString <> "" 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 Dim indexname = row.Item("WD_INDEX").ToString Dim idxvalue = row.Item("Indexwert") If LogErrorsOnly = False Then ClassLogger.Add(" ...Manueller Indexvalue: " & idxvalue.ToString, False) Count += 1 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 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 Console.WriteLine(row.Item("Indexwert")) Console.WriteLine(row.Item("Indexiert").ToString) If CBool(row.Item("Indexiert")) = True And row.Item("Indexwert").ToString <> "" Then Dim indexname = row.Item("INDEXNAME").ToString Dim idxvalue = row.Item("Indexwert") If LogErrorsOnly = False Then ClassLogger.Add(" ...Auto Indexvalue: " & idxvalue.ToString, False) If LogErrorsOnly = False Then ClassLogger.Add(" ...Indexvalue: " & idxvalue.ToString, False) Count += 1 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 End If Next End If If DropType = "@OUTLOOK_MESSAGE@" Or DropType = "@FW_OUTLOOK_MESSAGE@" Then indexierung_erfolgreich = SetEmailIndices() If indexierung_erfolgreich = False Then MsgBox("Error in SetEmailIndices - See log", MsgBoxStyle.Critical) Return False End If ElseIf DropType = "@ATTMNTEXTRACTED@" 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 Fehler bei 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 Try Dim msg As New Msg.Message(CURRENT_NEWFILENAME) '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 DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "'") If DT.Rows.Count = 1 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 ' Regular Expressions vorbereiten Dim fromPattern As String = ClassDatabase.Execute_Scalar("SELECT REGEX FROM TBGI_FUNCTION_REGEX WHERE FUNCTION_NAME = 'FROM_EMAIL_HEADER'", MyConnectionString) Dim toPattern As String = ClassDatabase.Execute_Scalar("SELECT REGEX FROM TBGI_FUNCTION_REGEX WHERE FUNCTION_NAME = 'TO_EMAIL_HEADER'", MyConnectionString) If fromPattern <> "" And toPattern <> "" Then 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) ' Email Header auslesen Dim headers As String = ClassEmailHeaderExtractor.getMessageHeaders(msg) ' Email Absender und Empfänger Dim emailFrom As String = ClassEmailHeaderExtractor.extractFromAddress(headers, FromRegexList) Dim emailTo As String = ClassEmailHeaderExtractor.extractToAddress(headers, ToRegexList) 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-From - See log", MsgBoxStyle.Critical) Return False End If 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-To - See log", MsgBoxStyle.Critical) Return False End If End If Dim subj As String = ClassFormFunctions.CleanInput(msg.Subject) If LogErrorsOnly = False Then ClassLogger.Add(" ...subj: " & subj, False) indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, 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, MsgBoxStyle.Critical) Return False End Try End Function Private Function SetAttachmentIndices() Dim indexierung_erfolgreich As Boolean = True Try Dim DT As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBGI_OBJECTTYPE_EMAIL_INDEX WHERE OBJECTTYPE = '" & ClassWindream._WDObjekttyp & "'") If DT.Rows.Count = 1 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 - See log", MsgBoxStyle.Critical) Return False End If End If 'indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_FROM").ToString, msg.SenderEmailAddress) 'If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices - See log", MsgBoxStyle.Critical) ' Return False 'End If 'indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_TO").ToString, msg.ReceivedByEmailAddress) 'If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices - See log", MsgBoxStyle.Critical) ' Return False 'End If 'indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_EMAIL_SUBJECT").ToString, msg.Subject) 'If indexierung_erfolgreich = False Then ' MsgBox("Error in SetAttachmentIndices - See log", MsgBoxStyle.Critical) ' Return False 'End If 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 - See log", MsgBoxStyle.Critical) Return False End If End If indexierung_erfolgreich = WriteIndex2File(DT.Rows(0).Item("IDX_CHECK_ATTACHMENT").ToString, True) If indexierung_erfolgreich = False Then MsgBox("Error in SetAttachmentIndices - 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 & extension) = False Then CURRENT_NEWFILENAME = _NewFilename & extension Else 'Versionieren Dim version As Integer = 1 Dim Stammname As String = _NewFilename Dim neuername As String = _NewFilename Do While File.Exists(neuername & extension) version = version + 1 neuername = Stammname & _versionTz & version CURRENT_NEWFILENAME = neuername & extension Loop End If 'Die Datei wird nun verschoben My.Computer.FileSystem.MoveFile(CURRENT_WORKFILE, CURRENT_NEWFILENAME) Dim Insert_String As String Try Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO,ADDED_WHERE) VALUES ('" & CURRENT_WORKFILE & "','" & CURRENT_NEWFILENAME & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "','" & Environment.MachineName & "')" ClassDatabase.Execute_Scalar(Insert_String, MyConnectionString) Return False Catch ex As Exception ClassLogger.Add(" - Fehler bei Move_Rename - Fehler: " & vbNewLine & ex.Message) ClassLogger.Add(" - Fehler bei 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 ClassWindowLocation.SaveFormLocationSize(Me) CloseUniversalViewer() Catch ex As Exception ClassLogger.Add(" - Fehler bei Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Schliessen des Formulares:") End Try End Sub Sub CloseUniversalViewer() If Not CURRENT_WORKFILE.EndsWith("msg") Then CURRENT_HTML_DOC = "" If CURRENT_WORKFILE.EndsWith("pdf") Then Me.PdfViewer1.DocumentFilePath = "" My.Settings.SplitterDistance_Viewer = SplitContainer1.SplitterDistance Else Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName("Viewer") For Each p As Process In pProcess p.Kill() Next End If Else My.Settings.SplitterDistance_Viewer = SplitContainer1.SplitterDistance End If My.Settings.Save() 'If Not IsNothing(DocView) And viewer_string <> "" Then ' DocView.CloseView(viewer_string, 0) 'Else 'End If End Sub Private Sub frmIndex_Load(sender As Object, e As System.EventArgs) Handles Me.Load Try DropType = ClassDatabase.Execute_Scalar("SELECT HANDLE_TYPE FROM TBGI_FILES_USER WHERE GUID = " & CURRENT_WORKFILE_GUID, MyConnectionString, True) chkdelete_origin.Visible = False If DropType = "@DROPFROMFSYSTEM@" Then chkdelete_origin.Visible = True chkdelete_origin.Checked = Delete_OriginFile Me.Text = "Indexierung der gedroppten Datei:" ElseIf DropType = "@OUTLOOK_MESSAGE@" Or DropType = "@FW_OUTLOOK_MESSAGE@" Then Select Case DropType Case "@FW_OUTLOOK_MESSAGE@""" If LogErrorsOnly = False Then ClassLogger.Add(" ....msg-file from folderwatch", False) Me.Text = "Indexierung der msg-Datei (ohne Anhang) - aus Folderwatch:" Case "@OUTLOOK_MESSAGE@" If LogErrorsOnly = False Then ClassLogger.Add(" ....msg-file through dragdrop", False) Me.Text = "Indexierung der msg-Datei (ohne Anhang):" End Select Dim tempfile As String = Path.Combine(Path.GetTempPath, Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) & "_excl_att.msg") Dim savestring = tempfile 'Path.GetDirectoryName(CURRENT_WORKFILE) & "\" & Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) & "_excl_att.msg" If File.Exists(savestring) Then File.Delete(savestring) End If Dim _msg As New Msg.Message(CURRENT_WORKFILE) _msg.Attachments.Clear() _msg.Save(savestring) CURRENT_WORKFILE = savestring ElseIf DropType = "@ATTMNTEXTRACTED@" Then Me.Text = "Indexierung eines Email-Attachments:" ElseIf DropType = "@FW_SIMPLEINDEXER@" Then Me.Text = "Indexierung einer Folderwatch-Datei:" End If txtIndexfilepath.Text = CURRENT_WORKFILE ClassWindowLocation.LoadFormLocationSize(Me) If Preview = True Then PreviewFile() Me.tslblVorschau.Visible = True Else 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) If MULTIFILES > 0 Then chkMultiIndexer.Text = "Multi-Indexing - Alle nachfolgenden Dateien (" & MULTIFILES & ") identisch indexieren" chkMultiIndexer.Visible = True Else chkMultiIndexer.Visible = False End If Catch ex As Exception ClassLogger.Add(" - Fehler bei Öffnen des Formulares - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei Ö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(" - Fehler beim Speichern der Verbindung - Fehler: " & vbNewLine & ex.Message) MsgBox("Fehler beim 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() formloaded = True End Sub Sub Refresh_Dokart() Try DT_DOKART = ClassDatabase.Return_Datatable("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('" & Environment.UserName & "') ORDER BY SEQUENCE") cmbDokumentart.DataSource = DT_DOKART cmbDokumentart.ValueMember = DT_DOKART.Columns("DOCTYPE_ID").ColumnName cmbDokumentart.DisplayMember = DT_DOKART.Columns("DOCTYPE").ColumnName cmbDokumentart.AutoCompleteMode = AutoCompleteMode.SuggestAppend cmbDokumentart.AutoCompleteSource = AutoCompleteSource.ListItems Me.cmbDokumentart.SelectedIndex = -1 'If CURRENT_LASTDOKART <> "" Then ' cmbDokumentart.SelectedIndex = cmbDokumentart.FindStringExact(CURRENT_LASTDOKART) 'End If Catch ex As Exception ClassLogger.Add(" - Fehler beim Laden der Dokumentarten - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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 from TBDD_DOKUMENTART WHERE GUID = " & cmbDokumentart.SelectedValue WDDirect = ClassDatabase.Execute_Scalar(sql, MyConnectionString) Refresh_IndexeMan(cmbDokumentart.SelectedValue) End If End If End Sub ' _ Private Sub Refresh_IndexeMan(dokartid As Integer) Try DT_INDEXEMAN = ClassDatabase.Return_Datatable("select T1.BEZEICHNUNG AS DOKUMENTART,T.* from TBDD_INDEX_MAN T, TBDD_DOKUMENTART T1 where T.DOK_ID = T1.GUID AND T.DOK_ID = " & dokartid) pnlIndex.Visible = True LoadIndexe_Man() Catch ex As System.Exception ClassLogger.Add(" - Fehler Refresh_IndexeMan: DOKART-ID: " & dokartid & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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, "Fehler bei 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 In DT_INDEXEMAN.Rows addLabel(DR.Item("NAME"), DR.Item("COMMENT").ToString, ylbl, anz) Dim DefaultValue = Check_HistoryValues(DR.Item("NAME"), DR.Item("DOKUMENTART")) If DefaultValue Is Nothing Then DefaultValue = DR.Item("DEFAULT_VALUE") End If Select Case DR.Item("DATATYPE") 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"), DefaultValue) Else Dim VORBELGUNG As Integer = DefaultValue 'nur eine Textbox AddTextBox(DR.Item("NAME"), y, VORBELGUNG) 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"), 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 MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") ClassLogger.Add(" - Datentyp nicht hinterlegt - LoadIndexe_Man") End Select anz += 1 ylbl += 60 y += 60 Next SendKeys.Send("{TAB}") Catch ex As Exception ClassLogger.Add(" - Fehler bei LoadIndexe_Man - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei LoadIndexe_Man:") End Try End Sub Sub AddComboBoxValue(cmbName As ComboBox, Value As String) cmbName.Items.Add(Value) End Sub ' ' Private Sub lblhinweis_Click(sender As System.Object, e As System.EventArgs) Handles lblhinweis.Click ' End Sub Function FillIndexe_Autom(dokart_id As Integer) 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 If LogErrorsOnly = False Then ClassLogger.Add(" ...Build Automatischer Index '" & DR_AUTOINDEX.Item("INDEXNAME") & "'", False) If DR_AUTOINDEX.Item("SQL_RESULT").ToString <> String.Empty 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) 'den Platzhalter im SQL-String durch den Wert ersetzen Dim manIndexwert As String = GetManIndex_Value(elementOhneSonderzeichen) If manIndexwert <> "" Then SqlString = SqlString.Replace(element.Value, manIndexwert) If LogErrorsOnly = False Then ClassLogger.Add(" ...zusammengesetzter SQL-String: " & SqlString, False) Else ClassLogger.Add(" - ACHTUNG: manIndexwert = String.Empty - Funktion: FillIndexe_Autom", False) Return False End If Next If LogErrorsOnly = False Then ClassLogger.Add(" ...Ausführen SQL....", False) Dim automatischerValue As String = "" automatischerValue = Get_AutomatischerIndex_SQL(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 ClassLogger.Add(" - ACHTUNG: automatischerValue = String.Empty - Funktion: FillIndexe_Autom", False) ClassLogger.Add(" - SqlString: " & SqlString, False) Return False End If Else If Not IsDBNull(DR_AUTOINDEX.Item("VALUE")) Then If DR_AUTOINDEX.Item("VALUE") <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" ...Manueller Indexwert wird gespeichert: " & DR_AUTOINDEX.Item("VALUE"), False) Console.WriteLine(DR_AUTOINDEX.Item("VALUE")) DR_AUTOINDEX.Item("Indexiert") = True DR_AUTOINDEX.Item("Indexwert") = DR_AUTOINDEX.Item("VALUE") 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(" - Fehler bei FillIndexe_Autom - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei 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 Dim Proc As New System.Diagnostics.Process Me.pnlWebbrowser.Visible = False Me.pnlPDF.Visible = False CURRENT_HTML_DOC = "" If Not CURRENT_WORKFILE.EndsWith("msg") Then CURRENT_HTML_DOC = "" If CURRENT_WORKFILE.EndsWith("pdf") Then Me.SplitContainer1.Panel2Collapsed = False PdfViewer1.LoadDocument(CURRENT_WORKFILE) pnlPDF.Dock = DockStyle.Fill SplitContainer1.SplitterDistance = My.Settings.SplitterDistance_Viewer Me.pnlPDF.Visible = True Else Me.SplitContainer1.Panel2Collapsed = True Select Case Path.GetExtension(CURRENT_WORKFILE) Case ".docx" Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName("winword") Dim filename As String = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) For Each p As Process In pProcess If p.MainWindowTitle.Contains(filename) Then p.CloseMainWindow() End If Next Case ".xlsx" Console.WriteLine("xlsx file") Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName("excel") Dim filename As String = Path.GetFileNameWithoutExtension(CURRENT_WORKFILE) For Each p As Process In pProcess If p.MainWindowTitle.Contains(filename) Then p.CloseMainWindow() End If Next Case Else Console.WriteLine(Path.GetExtension(CURRENT_WORKFILE)) Dim psi As New ProcessStartInfo(UniversalViewer, """" & CURRENT_WORKFILE & """") Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() End Select End If Else Me.pnlWebbrowser.Dock = DockStyle.Fill Dim msg_email As New Msg.Message(CURRENT_WORKFILE) 'Eine tempfile generieren Dim tempFilename = My.Computer.FileSystem.GetTempFileName() Dim name = Path.GetFileNameWithoutExtension(tempFilename) tempFilename = Path.Combine(Path.GetDirectoryName(tempFilename), name & ".html") 'tempfile löschen If My.Computer.FileSystem.FileExists(tempFilename) Then My.Computer.FileSystem.DeleteFile(tempFilename) End If 'Try Dim wFile As System.IO.FileStream Dim byteData() As Byte byteData = msg_email.BodyHtml ' MsgBox(msg_email.InternetCodePage) ' wFile = New FileStream(tempFilename, FileMode.Append) ' wFile.Write(byteData, 0, byteData.Length) ' wFile.Close() 'Catch ex As IOException ' MsgBox(ex.ToString) 'End Try Dim vIn() As Byte = msg_email.BodyHtml Dim vOut As String = System.Text.Encoding.UTF8.GetString(vIn) File.WriteAllText(tempFilename, vOut, System.Text.Encoding.UTF8) CURRENT_HTML_DOC = tempFilename Me.tslblWebbrowser.Text = CURRENT_HTML_DOC WebBrowser.Navigate("file:///" & CURRENT_HTML_DOC) Me.pnlWebbrowser.Visible = True Me.SplitContainer1.Panel2Collapsed = False SplitContainer1.SplitterDistance = My.Settings.SplitterDistance_Viewer End If ' Dim psi1 As New ProcessStartInfo("""" & CURRENT_WORKFILE & """") ' Proc.EnableRaisingEvents = True ' Proc.StartInfo = psi1 ' Proc.Start() ' Me.tslblVorschau.Visible = True 'Else ' End If 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) 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 'Den Zielnamen zusammenbauen If Name_Generieren() = True Then 'Die Datei verschieben If Move_File2_Target() = True Then CloseUniversalViewer() 'Die Originaldatei löschen If DropType = "@DROPFROMFSYSTEM@" Then If chkdelete_origin.Checked = True Then 'Die temporäre Datei löschen File.Delete(CURRENT_WORKFILE) End If ElseIf DropType = "@ATTMNTEXTRACTED@" Then 'Die temporäre Datei löschen File.Delete(CURRENT_WORKFILE) ElseIf (DropType = "@OUTLOOK_MESSAGE@" Or DropType = "@FW_OUTLOOK_MESSAGE@") Then 'Die temporäre Datei löschen File.Delete(CURRENT_WORKFILE) ElseIf DropType = "@FW_SIMPLEINDEXER@" Then 'Die temporäre Datei löschen File.Delete(CURRENT_WORKFILE) End If CURRENT_LASTDOKART = cmbDokumentart.Text ClassLogger.Add(" >> Datei '" & CURRENT_NEWFILENAME & "' erfolgreich erzeugt.", False) Dim upd As String = "UPDATE TBGI_FILES_USER SET WORKED = 1 WHERE GUID = " & CURRENT_WORKFILE_GUID ClassDatabase.Execute_non_Query(upd, True) Return True End If Else MsgBox("Unerwarteter Fehler bei Name_Generieren - Bitte überprüfen sie die LogFile", MsgBoxStyle.Critical) Return False End If Else MsgBox("Unvorhergesesehene Ausnahme in FillIndexe_Autom - Bitte überprüfen Sie die LogFile", MsgBoxStyle.Critical) Return False End If '#### Automatische Werte indexieren #### End If Else MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation) Return False End If Catch ex As Exception MsgBox("Unerwarteter Fehler in WORK_FILE:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Private Sub OK_Button_Click(sender As Object, e As EventArgs) Handles OK_Button.Click lblhinweis.Visible = False lblerror.Visible = False Me.Cursor = Cursors.WaitCursor 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") '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 MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:") Me.Close() End If End If End If Else If WORK_FILE() = True Then Me.Cursor = Cursors.Default MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung") Me.Close() End If End If End Sub Private Function Move_File2_Target() Dim err As Boolean = False Try If CBool(CURR_DOKART_WD_DIRECT) = False Then 'Datei verschieben err = Move_Rename_Only(CURRENT_WORKFILE, NewFileString, CURR_WORKFILE_EXTENSION, VERSION_DELIMITER) Else Dim exp2WD As Boolean = False 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_OUTLOOK_MESSAGE@" Then exp2WD = SINGLEFILE_2_WINDREAM(CURR_DOKART_OBJECTTYPE) End If If exp2WD = True Then 'Prüfen ob Sessiond a 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 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 CrFolderForIndex(CURRENT_NEWFILENAME, Folder_for_index) End If End If 'Kein Fehler in Setzen der windream-Indizes Dim Insert_String As String Try Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & CURRENT_WORKFILE & "','" & CURRENT_NEWFILENAME & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')" ClassDatabase.Execute_Scalar(Insert_String, MyConnectionString) Catch ex As Exception MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add(" - Fehler bei Insert-History - Fehler: " & vbNewLine & ex.Message) ClassLogger.Add(" - Fehler bei Insert-History - SQL: " & Insert_String) err = True End Try Else err = True End If Else MsgBox("Der Export nach windream war nicht erfolgreich - Check LogFile", MsgBoxStyle.Exclamation) err = True 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, "Allgemeiner Fehler in Move File2Target:") err = True End Try End Function Private Sub PdfViewer1_ZoomChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfZoomChangedEventArgs) If Not PdfViewer1.ZoomMode = DevExpress.XtraPdfViewer.PdfZoomMode.Custom Then Console.WriteLine(PdfViewer1.ZoomMode) 'SaveMySettingsValue("PDFViewer_ZoomMode", PdfViewer1.ZoomMode) 'PDFViewer_ZoomMode = PdfViewer1.ZoomMode End If End Sub Private Sub PdfViewer1_DocumentChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfDocumentChangedEventArgs) Handles PdfViewer1.DocumentChanged PDF_Pagenumber() End Sub Private Sub PdfViewer1_CurrentPageChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfCurrentPageChangedEventArgs) Handles PdfViewer1.CurrentPageChanged PDF_Pagenumber() End Sub Sub PDF_Pagenumber() Try pdfstatuslblPageNumber.Text = "Seite " & PdfViewer1.CurrentPageNumber & "/" & PdfViewer1.PageCount Catch ex As Exception End Try End Sub Private Function CrFolderForIndex(ByVal fullfilename As String, folderindex As String) Try Dim RootFolder As String = Path.GetDirectoryName(fullfilename) '###### Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' die Vorkommen im Folder-String auslesen Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(folderindex) '#### ' alle Vorkommen innerhalb des Ordnerstrings durchlaufen For Each element As System.Text.RegularExpressions.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) If LogErrorsOnly = False Then ClassLogger.Add(" ...Versuch den Indexwert aus '" & ManIndexname & "' auszulesen.", False) Dim ManIndex_Value As String = GetManIndex_Value(ManIndexname) 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 folderindex = folderindex.Replace(element.ToString, ManIndex_Value) If LogErrorsOnly = False Then ClassLogger.Add(" ...FolderPattern: '" & folderindex & "'", False) 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('" & ManIndexname & "')", MyConnectionString, True) 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 folderindex = folderindex.Replace(element.ToString, AutoIndex_Value) If LogErrorsOnly = False Then ClassLogger.Add(" ...FolderPattern: '" & folderindex & "'", False) Else ClassLogger.Add(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!", True) End If Case "V" Dim folder_temp 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) Select Case type Case "YYYY/MM/DD" folder_temp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day Case "YYYY/MM" folder_temp = My.Computer.Clock.LocalTime.Year & "\" & _Month Case "YYYY" folder_temp = My.Computer.Clock.LocalTime.Year Case "YYYY-MM" folder_temp = My.Computer.Clock.LocalTime.Year & "-" & _Month End Select folderindex = folderindex.Replace(element.ToString, folder_temp) If LogErrorsOnly = False Then ClassLogger.Add(" ...FolderPatter nach V-Element: '" & folderindex & "'", False) Case Else ClassLogger.Add(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & element.Value.ToUpper) MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & element.Value.ToUpper, MsgBoxStyle.Exclamation, "Fehler bei Name generieren:") End Select Next 'Dim _folderArray As String() '_folderArray = folderindex.Split("\") ''Für jeden Folder die maskierung entfernen 'For Each _Uordner As String In _folderArray ' Dim folder_temp ' If _Uordner.StartsWith("[%") Then ' Dim Indexwert As String ' folder_temp = _Uordner.Replace("[%", "") ' folder_temp = folder_temp.Replace("]", "") ' If LogErrorsOnly = False Then ClassLogger.Add(" ...CrFolder Ordner: '" & folder_temp & "'", False) ' 'Den Indexwert auslesen ' Try ' If LogErrorsOnly = False Then ClassLogger.Add(" ...Versuch den Indexwert aus '" & CStr(folder_temp) & "' auszulesen.", False) ' Indexwert = GetManIndex_Value(folder_temp) ' If LogErrorsOnly = False Then ClassLogger.Add(" ...Ergebnis/Wert für neuen Ordner: '" & CStr(Indexwert) & "'", False) ' Catch ex As Exception ' ClassLogger.Add("Der Index '" & folder_temp & "' ist nicht gefüllt oder es trat ein Fehler beim Auslesen der Indexwerte auf", True) ' Return True ' End Try ' If Not Indexwert = String.Empty Then ' If IsDate(Indexwert) Then ' Indexwert = CDate(Indexwert).ToString("yyyyMMdd") ' End If ' newFolder = newFolder & Indexwert & "\" ' If LogErrorsOnly = False Then ClassLogger.Add(" ...newFolder: '" & newFolder & "'", False) ' 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('" & CStr(folder_temp) & "')", MyConnectionString, True) ' 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 ' End If ' 'Überprüfen ob es ein Variable Ordneranlage sein soll (DATUM) ' If _Uordner.StartsWith("[V%") Then ' 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 = _Uordner.Replace("[V%", "") ' type = type.Replace("]", "") ' Select Case type ' Case "YYYY/MM/DD" ' folder_temp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day ' newFolder = newFolder & folder_temp & "\" ' Case "YYYY/MM" ' folder_temp = My.Computer.Clock.LocalTime.Year & "\" & _Month ' newFolder = newFolder & folder_temp & "\" ' Case "YYYY" ' folder_temp = My.Computer.Clock.LocalTime.Year ' newFolder = newFolder & folder_temp & "\" ' Case "YYYY-MM" ' folder_temp = My.Computer.Clock.LocalTime.Year & "-" & _Month ' newFolder = newFolder & folder_temp & "\" ' End Select ' End If ' 'Überprüfen ob es ein manueller Ordner ist ' If _Uordner.StartsWith("[MF%") Then ' folder_temp = _Uordner.Replace("[MF%", "") ' folder_temp = folder_temp.Replace("]", "") ' newFolder = newFolder & folder_temp & "\" ' End If 'Next If LogErrorsOnly = False Then ClassLogger.Add(" ...Den Root-Folder zusammenfügen...", False) Dim fullpath As String = RootFolder & "\" & folderindex & "\" fullpath.Replace("\\", "\") If LogErrorsOnly = False Then ClassLogger.Add(" ...Fullpath (mit evtl. Sonderzeichen (SZ)) '" & fullpath & "'", 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 fullpath.Contains(sonderChar) Then fullpath = fullpath.Replace(sonderChar, "") End If End If Next sonderChar If LogErrorsOnly = False Then ClassLogger.Add(" ...Fullpath (ohne SZ) '" & fullpath & "'", False) If Directory.Exists(fullpath) = False Then Directory.CreateDirectory(fullpath) If LogErrorsOnly = False Then ClassLogger.Add(" ...Folder '" & fullpath & "' wurde angelegt", False) End If 'Die aktuelle Datei soll gleichzeitig verschoben werden Dim extension As String = Path.GetExtension(fullfilename) Dim Dateiname As String = Path.GetFileName(fullfilename) Dim _Pfad, _WDLaufwerk, _Ziel As String _Ziel = fullpath & Dateiname If LogErrorsOnly = False Then ClassLogger.Add(" ...Ziel: " & _Ziel, False) 'Nur verschieben und überprüfen wenn Pfad ungleich If Path.GetDirectoryName(fullfilename) <> Path.GetDirectoryName(_Ziel) Then Dim Stammname As String = _Ziel.Substring(0, _Ziel.LastIndexOf(".")) Dim version As Integer = 2 Do While File.Exists(_Ziel) = True If LogErrorsOnly = False Then ClassLogger.Add(" ...Achtung: Datei ' " & Path.GetFileName(_Ziel) & "' existiert bereits!", False) Dim neuername As String = Stammname & "~" & version & extension _Ziel = neuername version = version + 1 Loop My.Computer.FileSystem.MoveFile(fullfilename, _Ziel) ClassLogger.Add(" >> Datei wurde nach CrFolderIndex-Methode erfolgreich verschoben", False) CURRENT_NEWFILENAME = _Ziel Else ClassLogger.Add(" >> (CrFolderForIndex) Quell- und Zielordner identisch", False) If Path.GetFileName(fullfilename) <> Path.GetFileName(_Ziel) And File.Exists(_Ziel) Then ClassLogger.Add(" >> (CrFolderForIndex) Quell- und Zielname nicht identisch", False) FileSystem.Rename(_Ziel, Path.GetDirectoryName(_Ziel) & Path.GetFileName(fullfilename)) ClassLogger.Add(" >> Datei wurde nach CrFolderIndex-Methode umbenannt", False) CURRENT_NEWFILENAME = _Ziel End If End If Return True 'Else 'ClassLogger.Add(" >> Es konnte kein dynamischer Pfad generiert werden", True) 'Return False 'End If Catch ex As Exception 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 Delete_OriginFile = chkdelete_origin.Checked SaveConfigValue("Delete_OriginFile", Delete_OriginFile) End Sub End Class