FileFlow/Global_Indexer/frmIndex.vb
2020-01-29 16:41:27 +01:00

3107 lines
166 KiB
VB.net

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
' <STAThread()> _
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
' <STAThread()> _
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
' <STAThread()> _
Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.Lime
End Sub
' <STAThread()> _
Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs)
Dim cmb As ComboBox = sender
cmb.BackColor = Color.White
End Sub
' <STAThread()> _
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) ++++++"
' <STAThread()> _
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
' <STAThread()> _
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" '<change this value to your actual domain region. For example: "com" as in "yahoo.com"
Dim path As String = String.Format("LDAP://CN=User,DC={0}", domainName)
Dim userEmail As String = String.Empty
Using search As DirectorySearcher = New DirectorySearcher(path)
Dim result As SearchResult
Try
search.Filter = "(SAMAccountName=" & userName & ")"
search.PropertiesToLoad.Add("mail")
result = search.FindOne()
Catch ex As Exception
search.Filter = ""
search.Filter = "(GivenName=" & userName & ")"
search.PropertiesToLoad.Add("mail")
End Try
Try
result = search.FindOne()
If result IsNot Nothing Then userEmail = result.Properties("mail").ToString
Catch ex As Exception
ClassLogger.Add(">> 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
' <STAThread()> _
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
' <STAThread()> _
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