From 4064c5cd60613ebca5710c2d847e74d26bb5f86e Mon Sep 17 00:00:00 2001 From: Digital Data - Marlon Schreiber Date: Tue, 24 Nov 2020 15:08:05 +0100 Subject: [PATCH] MS Globix3 --- GUIs.ZooFlow/Globix/GlobixControls.vb | 491 ++++++ GUIs.ZooFlow/Globix/GlobixPatterns.vb | 516 ++++++ GUIs.ZooFlow/Globix/GlobixPostprocessing.vb | 95 ++ GUIs.ZooFlow/Globix/State.vb | 20 + GUIs.ZooFlow/ModuleHelpers.vb | 60 + GUIs.ZooFlow/MyApplication.vb | 6 + GUIs.ZooFlow/ZooFlow.vbproj | 12 + GUIs.ZooFlow/clsIDBData.vb | 231 +++ GUIs.ZooFlow/frmFlowForm.vb | 20 +- GUIs.ZooFlow/frmGlobix_Index.Designer.vb | 193 ++- GUIs.ZooFlow/frmGlobix_Index.resx | 10 +- GUIs.ZooFlow/frmGlobix_Index.vb | 1660 ++++++++++++++++++- Modules.Database/MSSQLServer.vb | 38 + 13 files changed, 3234 insertions(+), 118 deletions(-) create mode 100644 GUIs.ZooFlow/Globix/GlobixControls.vb create mode 100644 GUIs.ZooFlow/Globix/GlobixPatterns.vb create mode 100644 GUIs.ZooFlow/Globix/GlobixPostprocessing.vb create mode 100644 GUIs.ZooFlow/ModuleHelpers.vb create mode 100644 GUIs.ZooFlow/clsIDBData.vb diff --git a/GUIs.ZooFlow/Globix/GlobixControls.vb b/GUIs.ZooFlow/Globix/GlobixControls.vb new file mode 100644 index 00000000..6743eeb0 --- /dev/null +++ b/GUIs.ZooFlow/Globix/GlobixControls.vb @@ -0,0 +1,491 @@ +Imports System.Data.SqlClient +Imports DigitalData.Modules.Logging +Imports Oracle.ManagedDataAccess.Client +Imports DigitalData.Controls.LookupGrid + +Public Class GlobixControls + Private Property Form As frmGlobix_Index + Private Property Panel As Panel + Private Patterns As GlobixPatterns + + Public Class ControlMeta + Public Property IndexName As String + Public Property IndexType As String + Public Property MultipleValues As Boolean = False + End Class + Private _Logger As Logger + Public Sub New(LogConfig As LogConfig, Panel As Panel, Form As frmGlobix_Index) + _Logger = LogConfig.GetLogger + Me.Form = Form + Me.Panel = Panel + Patterns = New GlobixPatterns(LogConfig) + End Sub + + Public Function AddCheckBox(indexname As String, y As Integer, vorbelegung As String, caption As String) + Try + Dim value As Boolean = False + Dim chk As New CheckBox + chk.Name = "chk" & indexname + chk.Size = New Size(100, 27) + chk.Location = New Point(11, y) + chk.Tag = New ControlMeta() With { + .IndexName = indexname, + .IndexType = "BOOLEAN" + } + + If caption <> "" Then + chk.Text = caption + chk.Size = New Size(CInt(caption.Length * 15), 27) + End If + + If Boolean.TryParse(vorbelegung, value) = False Then + If vorbelegung = "1" Or vorbelegung = "0" Then + chk.Checked = CBool(vorbelegung) + Else + chk.Checked = False + End If + Else + chk.Checked = value + End If + + AddHandler chk.CheckedChanged, AddressOf Checkbox_CheckedChanged + + Return chk + Catch ex As Exception + _Logger.Info("Unhandled Exception in AddCheckBox: " & ex.Message) + _Logger.Error(ex.Message) + Return Nothing + End Try + End Function + + Public Sub Checkbox_CheckedChanged(sender As CheckBox, e As EventArgs) + PrepareDependingControl(sender) + End Sub + + Public Function AddVorschlag_ComboBox(indexname As String, y As Integer, conid As Integer, sql_Vorschlag As String, Multiselect As Boolean, DataType As String, Optional Vorgabe As String = "", Optional AddNewValues As Boolean = False, Optional PreventDuplicateValues As Boolean = False, Optional SQLSuggestion As Boolean = False) As Control + Try + Dim oSql As String = sql_Vorschlag + Dim oConnectionString As String + Dim oControl As New DigitalData.Controls.LookupGrid.LookupControl2 With { + .Multiselect = Multiselect, + .AllowAddNewValues = AddNewValues, + .PreventDuplicates = PreventDuplicateValues, + .Location = New Point(11, y), + .Size = New Size(300, 27), + .Name = "cmbMulti" & indexname, + .Tag = New ControlMeta() With { + .IndexName = indexname, + .IndexType = DataType + } + } + oControl.Properties.AppearanceFocused.BackColor = Color.Lime + + If Not String.IsNullOrEmpty(Vorgabe) Then + Dim oDefaultValues As New List(Of String) + + If Vorgabe.Contains(",") Then + oDefaultValues = Vorgabe. + Split(",").ToList(). + Select(Function(item) item.Trim()). + ToList() + Else + oDefaultValues = Vorgabe. + Split("~").ToList(). + Select(Function(item) item.Trim()). + ToList() + End If + oControl.SelectedValues = oDefaultValues + End If + + AddHandler oControl.SelectedValuesChanged, AddressOf Lookup_SelectedValuesChanged + + oConnectionString = My.Database.Get_ConnectionStringforID(conid) + + If oConnectionString IsNot Nothing And oSql.Length > 0 And SQLSuggestion = True Then + _Logger.Debug("Connection String (redacted): [{0}]", oConnectionString.Substring(0, 30)) + + If Patterns.HasComplexPatterns(oSql) Then + _Logger.Debug(" >>sql enthält Platzhalter und wird erst während der Laufzeit gefüllt!", False) + Else + Dim oDatatable = My.Database.GetDatatableWithConnection(oSql, oConnectionString) + oControl.DataSource = oDatatable + End If + Else + _Logger.Warn("Connection String for control [{0}] is empty!", oControl.Name) + End If + + Return oControl + Catch ex As Exception + _Logger.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in AddVorschlag_ComboBox:") + Return Nothing + End Try + End Function + + Private Sub Lookup_SelectedValuesChanged(sender As LookupControl2, SelectedValues As List(Of String)) + PrepareDependingControl(sender) + End Sub + + Function AddCombobox(indexname As String, y As Integer) + Dim cmb As New ComboBox + cmb.Name = "cmb" & indexname + cmb.AutoSize = True + cmb.Size = New Size(300, 27) + cmb.Location = New Point(11, y) + + cmb.Tag = New ControlMeta() With { + .IndexName = indexname + } + + + AddHandler cmb.SelectedIndexChanged, AddressOf OncmbSIndexChanged + AddHandler cmb.GotFocus, AddressOf OncmbGotFocus + AddHandler cmb.LostFocus, AddressOf OncmbLostFocus + AddHandler cmb.KeyDown, AddressOf OncmbKeyDown + Return cmb + End Function + + Public Sub OncmbKeyDown(sender As System.Object, e As System.EventArgs) + Dim cmb As ComboBox = sender + + ' Verhindert, dass Auswahlliste und Autocompleteliste übereinander liegen + If cmb.DroppedDown = True Then + cmb.DroppedDown = False + End If + End Sub + + Public Sub OncmbGotFocus(sender As System.Object, e As System.EventArgs) + Dim cmb As ComboBox = sender + cmb.BackColor = Color.Lime + End Sub + + Public Sub OncmbLostFocus(sender As System.Object, e As System.EventArgs) + Dim cmb As ComboBox = sender + cmb.BackColor = Color.White + End Sub + + Public Sub OncmbSIndexChanged(sender As System.Object, e As System.EventArgs) + If Form.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 + + Private 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 = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " ORDER BY SEQUENCE" + Dim DT As DataTable = My.Database.GetDatatable(sql) + 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 + + 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 = My.Database.GetDatatable("select * FROM TBDD_INDEX_MAN WHERE GUID = " & INDEX_GUID) + 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.Panel.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 = My.Database.Get_ConnectionStringforID(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)) + cmb.Items.Add(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 + _Logger.Info(" - Unvorhergesehener Unexpected error in Renew_ComboboxResults - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Renew_ComboboxResults:") + End Try + End Sub + + Public Function AddTextBox(indexname As String, y As Integer, text As String, DataType As String) As DevExpress.XtraEditors.TextEdit + Dim oEdit As New DevExpress.XtraEditors.TextEdit With { + .Name = "txt" & indexname, + .Size = New Size(260, 27), + .Location = New Point(11, y), + .Tag = New ControlMeta() With { + .IndexName = indexname, + .IndexType = DataType + } + } + + Select Case DataType + Case "INTEGER" + oEdit.Properties.Mask.MaskType = DevExpress.XtraEditors.Mask.MaskType.Numeric + oEdit.Properties.Mask.EditMask = "d" + Console.WriteLine() + End Select + + If text IsNot Nothing Then + oEdit.Text = text + oEdit.SelectAll() + End If + + AddHandler oEdit.GotFocus, AddressOf OnTextBoxFocus + AddHandler oEdit.LostFocus, AddressOf OnTextBoxLostFocus + AddHandler oEdit.KeyUp, AddressOf OnTextBoxKeyUp + AddHandler oEdit.TextChanged, AddressOf OnTextBoxTextChanged + + Return oEdit + End Function + + Public Sub OnTextBoxFocus(sender As System.Object, e As System.EventArgs) + Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender + oTextbox.BackColor = Color.Lime + oTextbox.SelectAll() + End Sub + + Public Sub OnTextBoxTextChanged(sender As System.Object, e As System.EventArgs) + Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender + Using oGraphics As Graphics = oTextbox.CreateGraphics() + oTextbox.Width = oGraphics.MeasureString(oTextbox.Text, oTextbox.Font).Width + 15 + End Using + End Sub + + Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) + Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender + oTextbox.BackColor = Color.White + End Sub + + Public Sub OnTextBoxKeyUp(sender As System.Object, e As System.Windows.Forms.KeyEventArgs) + Dim oTextbox As DevExpress.XtraEditors.TextEdit = sender + + If oTextbox.Text = String.Empty Then + Exit Sub + End If + + If e.KeyCode = Keys.Return Or e.KeyCode = Keys.Enter Or e.KeyCode = Keys.Tab Then + PrepareDependingControl(oTextbox) + End If + + If (e.KeyCode = Keys.Return) Then + SendKeys.Send("{TAB}") + End If + End Sub + + + Public Function AddDateTimePicker(indexname As String, y As Integer, DataType As String, Vorgabe As String) As DevExpress.XtraEditors.DateEdit + Dim oPicker As New DevExpress.XtraEditors.DateEdit With { + .Name = "dtp" & indexname, + .Size = New Size(260, 27), + .Location = New Point(11, y), + .Tag = New ControlMeta() With { + .IndexName = indexname, + .IndexType = DataType + } + } + + If Vorgabe.ToUpper = "$NULL" Then + oPicker.EditValue = Nothing + ElseIf Vorgabe IsNot Nothing Then + oPicker.EditValue = Vorgabe + End If + + oPicker.Properties.AppearanceFocused.BackColor = Color.Lime + + Return oPicker + End Function + Sub OndtpChanged() + 'offen was hier zu tun ist + End Sub + + Private Sub PrepareDependingControl(Control As Control) + If TypeOf Control Is Label Then + Exit Sub + End If + + Try + Dim oMeta = DirectCast(Control.Tag, ControlMeta) + Dim oIndexName As String = oMeta.IndexName + Dim oSQL = $"SELECT * FROM TBDD_INDEX_MAN WHERE SQL_RESULT LIKE '%{oIndexName}%'" + Dim oDatatable As DataTable = My.Database.GetDatatable(oSQL) + + If Not IsNothing(oDatatable) Then + _Logger.Debug("Found [{0}] depending controls for [{1}]", oDatatable.Rows.Count, Control.Name) + + For Each oRow As DataRow In oDatatable.Rows + Dim oControlName As String = NotNull(oRow.Item("NAME"), "") + Dim oConnectionId As Integer = NotNull(oRow.Item("CONNECTION_ID"), -1) + Dim oControlSql As String = NotNull(oRow.Item("SQL_RESULT"), "") + + If oConnectionId = -1 Or oControlSql = String.Empty Then + _Logger.Warn("Missing SQL Query or ConnectionId for Control [{0}]! Continuing.", oControlName) + Continue For + End If + + oControlSql = Patterns.ReplaceUserValues(oControlSql, My.Application.User.GivenName, My.Application.User.Surname, My.Application.User.ShortName, My.Application.User.Language, My.Application.User.Email, My.Application.User.UserId, My.Application.Globix.CURRENT_DOCTYPE_ID) + oControlSql = Patterns.ReplaceInternalValues(oControlSql) + oControlSql = Patterns.ReplaceControlValues(oControlSql, Panel) + + + _Logger.Debug("SQL After Preparing: [{0}]", oControlSql) + _Logger.Debug("Setting new value for [{0}]", oControlName) + SetDependingControlResult(oControlName, oControlSql, oConnectionId) + Next + End If + Catch ex As Exception + _Logger.Error(ex) + End Try + End Sub + + Private Sub SetDependingControlResult(IndexName As String, SqlCommand As String, SqlConnectionId As Integer) + Try + If SqlCommand Is Nothing OrElse SqlCommand = String.Empty Then + _Logger.Warn("New Value for Index [{0}] could not be set. Supplied SQL is empty.") + Exit Sub + End If + + Dim oConnectionString = My.Database.Get_ConnectionStringforID(SqlConnectionId) + Dim oDatatable As DataTable = My.Database.GetDatatableWithConnection(SqlCommand, oConnectionString) + Dim oFoundControl As Control = Nothing + + For Each oControl As Control In Panel.Controls + If TypeOf oControl Is Label Then + Continue For + End If + + Dim oMeta = DirectCast(oControl.Tag, ControlMeta) + Dim oIndex As String = oMeta.IndexName + + If oIndex = IndexName Then + oFoundControl = oControl + Exit For + End If + Next + + If oFoundControl Is Nothing Then + _Logger.Warn("Depending Control for Index [{0}] not found!", IndexName) + End If + + If oDatatable Is Nothing Then + _Logger.Warn("Error in SQL Command: {0}", SqlCommand) + End If + + Select Case oFoundControl.GetType.Name + Case GetType(DevExpress.XtraEditors.TextEdit).Name + If oDatatable.Rows.Count > 0 Then + Dim oFirstRow As DataRow = oDatatable.Rows.Item(0) + + If oFirstRow.ItemArray.Length > 0 Then + Dim oValue = oFirstRow.Item(0).ToString() + + _Logger.Debug("Setting Value for TextEdit [{0}]: [{1}]", oFoundControl.Name, oValue) + DirectCast(oFoundControl, DevExpress.XtraEditors.TextEdit).Text = oValue + End If + End If + Case GetType(LookupControl2).Name + _Logger.Debug("Setting Value for LookupControl [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") + DirectCast(oFoundControl, LookupControl2).DataSource = oDatatable + Case GetType(ComboBox).Name + _Logger.Debug("Setting Value for Combobox [{0}]: [{1}]", oFoundControl.Name, "DATATABLE") + DirectCast(oFoundControl, ComboBox).DataSource = oDatatable + Case Else + _Logger.Debug("Could not set depending control result for [{0}]", oFoundControl.GetType.Name) + End Select + Catch ex As Exception + _Logger.Error(ex) + End Try + End Sub +End Class diff --git a/GUIs.ZooFlow/Globix/GlobixPatterns.vb b/GUIs.ZooFlow/Globix/GlobixPatterns.vb new file mode 100644 index 00000000..26cda783 --- /dev/null +++ b/GUIs.ZooFlow/Globix/GlobixPatterns.vb @@ -0,0 +1,516 @@ +Imports System.Text.RegularExpressions +Imports DevExpress.XtraEditors +Imports DigitalData.Controls.LookupGrid +Imports DigitalData.Modules.Logging + +Public Class GlobixPatterns + Private _Logger As Logger + Private _idbdata As clsIDBData + Public Sub New(LogConfig As LogConfig) + _Logger = LogConfig.GetLogger + _idbdata = New clsIDBData(LogConfig) + End Sub + ' Complex patterns that rely on a datasource like a Database or Windream + Public Const PATTERN_WMI = "WMI" + Public Const PATTERN_IDBA = "IDBA" + Public Const PATTERN_CTRL = "CTRL" + ' Simple patterns that only rely on .NET functions + Public Const PATTERN_INT = "INT" + ' Simple patterns that rely on Data from the TBDD_USER table + Public Const PATTERN_USER = "USER" + + Public Const USER_VALUE_PRENAME = "PRENAME" + Public Const USER_VALUE_SURNAME = "SURNAME" + Public Const USER_VALUE_EMAIL = "EMAIL" + Public Const USER_VALUE_SHORTNAME = "SHORTNAME" + Public Const USER_VALUE_LANGUAGE = "LANGUAGE" + Public Const USER_VALUE_USER_ID = "USER_ID" + Public Const USER_VALUE_PROFILE_ID = "PROFILE_ID" + + Public Const INT_VALUE_USERNAME = "USERNAME" + Public Const INT_VALUE_MACHINE = "MACHINE" + Public Const INT_VALUE_DOMAIN = "DOMAIN" + Public Const INT_VALUE_DATE = "DATE" + + Public Const MAX_TRY_COUNT = 500 + + Private myregex As Regex = New Regex("{#(\w+)#([\.\w\d\s_-]+)}+") + Private allPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA, PATTERN_USER, PATTERN_INT} + Private complexPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA} + Private simplePatterns As New List(Of String) From {PATTERN_USER, PATTERN_INT} + + ''' + ''' Wraps a pattern-type and -value in the common format: {#type#value} + ''' + Public Function WrapPatternValue(type As String, value As String) As String + Return New Pattern(type, value).ToString + End Function + + + Public Function ReplaceAllValues(input As String, panel As Panel, prename As Object, surname As Object, shortname As Object, language As Object, email As Object, userId As Object, profileId As Object, pissql As Boolean) As String + Try + Dim result = input + _Logger.Debug($"inputString BEFORE replacing: [{result}]") + result = ReplaceInternalValues(result) + result = ReplaceControlValues(result, panel) + result = ReplaceIDBAttributes(My.Application.Globix.CURRENT_DOC_ID, result, pissql) + result = ReplaceUserValues(result, prename, surname, shortname, language, email, userId, profileId) + _Logger.Debug($"inputString AFTER replacing: [{result}]") + Return result + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info("Error in ReplaceAllValues:" & ex.Message) + End Try + End Function + + Public Function ReplaceInternalValues(input As String) As String + Try + Dim result = input + + ' Replace Username(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_USERNAME) + result = ReplacePattern(result, PATTERN_INT, Environment.UserName) + End While + + ' Replace Machinename(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_MACHINE) + result = ReplacePattern(result, PATTERN_INT, Environment.MachineName) + End While + + ' Replace Domainname(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DOMAIN) + result = ReplacePattern(result, PATTERN_INT, Environment.UserDomainName) + End While + + ' Replace CurrentDate(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DATE) + result = ReplacePattern(result, PATTERN_INT, Now.ToShortDateString) + End While + _Logger.Debug("sql after ReplaceInternalValues: " & input) + Return result + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info("Error in ReplaceInternalValues:" & ex.Message) + End Try + End Function + + Public Function ReplaceUserValues(input As String, prename As Object, surname As Object, shortname As Object, language As String, email As Object, userId As Object, profileId As Object) As String + Try + Dim result = input + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME) + result = ReplacePattern(result, PATTERN_USER, prename) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID) + result = ReplacePattern(result, PATTERN_USER, userId) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME) + result = ReplacePattern(result, PATTERN_USER, surname) + End While + If IsDBNull(shortname) Then + shortname = "" + End If + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME) + result = ReplacePattern(result, PATTERN_USER, shortname) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE) + result = ReplacePattern(result, PATTERN_USER, language) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL) + result = ReplacePattern(result, PATTERN_USER, email) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PROFILE_ID) + result = ReplacePattern(result, PATTERN_USER, profileId) + End While + _Logger.Debug("sql after ReplaceUserValues: " & input) + Return result + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info("Error in ReplaceUserValues:" & ex.Message) + End Try + End Function + + Public Function ReplaceControlValues(input As String, panel As Panel) As String + Try + Dim result = input + Dim oTryCounter = 0 + + _Logger.Debug("Input String: [{0}]", input) + + While ContainsPattern(result, PATTERN_CTRL) + _Logger.Debug("ReplaceControlValues Try no. [{0}]", oTryCounter) + + If oTryCounter > MAX_TRY_COUNT Then + Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{result}].") + End If + + _Logger.Debug("Getting next pattern..") + + Dim oNextPattern = GetNextPattern(result, PATTERN_CTRL) + + If oNextPattern Is Nothing Then + _Logger.Debug("No Next Pattern found. Exiting!") + Exit While + End If + + _Logger.Debug("Next Pattern Value: [{0}]", oNextPattern.Value) + _Logger.Debug("Next Pattern Type: [{0}]", oNextPattern.Type) + + Dim controlName As String = oNextPattern.Value + Dim oFoundControl As Control = Nothing + Dim oFoundType As String = Nothing + + For Each oControl As Control In panel.Controls + If TypeOf oControl Is Label Then + Continue For + End If + + _Logger.Debug("Getting control metadata from Control: [{0}]", oControl.Name) + + If oControl.Tag Is Nothing Then + _Logger.Warn("No Metadata object found for control [{0}]. Skipping.", oControl.Name) + Continue For + End If + + Dim oMeta = TryCast(oControl.Tag, GlobixControls.ControlMeta) + + _Logger.Debug("Metadata IndexName: [{0}]", oMeta.IndexName) + _Logger.Debug("Metadata IndexType: [{0}]", oMeta.IndexType) + _Logger.Debug("Checking Control Name matches..") + + If oMeta Is Nothing Then + _Logger.Warn("No Metadata found for control [{0}]. Skipping.", oControl.Name) + Continue For + End If + + If oMeta.IndexName = controlName Then + _Logger.Debug("Control Name matches! Matching Control: [{0}]", controlName) + + oFoundControl = oControl + oFoundType = oMeta.IndexType + Exit For + End If + Next + + If oFoundControl IsNot Nothing Then + Dim oValue As String = String.Empty + + _Logger.Debug("Found Control [{0}], continuing with setting value..", oFoundControl.Name) + + If TypeOf oFoundControl Is TextEdit Then + Try + oValue = DirectCast(oFoundControl, TextEdit).Text + Catch ex As Exception + _Logger.Error(ex) + _Logger.Warn("Control Value for TextBox [{0}] could not be retrieved!", oFoundControl.Name) + End Try + ElseIf TypeOf oFoundControl Is CheckBox Then + Try + oValue = IIf(DirectCast(oFoundControl, CheckBox).Checked, 1, 0) + Catch ex As Exception + _Logger.Error(ex) + _Logger.Warn("Control Value for CheckBox [{0}] could not be retrieved!", oFoundControl.Name) + End Try + ElseIf TypeOf oFoundControl Is LookupControl2 Then + Try + Dim oLookupControl = DirectCast(oFoundControl, LookupControl2) + + If oLookupControl.MultiSelect Then + Select Case oFoundType + Case "INTEGER" + oValue = String.Join(",", oLookupControl.SelectedValues) + Case "VARCHAR" + Dim oWrapped = oLookupControl.SelectedValues + oValue = String.Join(",", oWrapped) + Case Else + _Logger.Warn("Lookup Control with [{0}] is not supported!", oFoundType) + End Select + Else + oValue = NotNull(oLookupControl.SelectedValues.Item(0), "") + End If + Catch ex As Exception + _Logger.Error(ex) + _Logger.Warn("Control Value for LookupControl2 [{0}] could not be retrieved!", oFoundControl.Name) + End Try + Else + _Logger.Debug("Unknown Control type for type [{0}], setting value to empty string.", oFoundControl.Name) + oValue = "" + End If + + _Logger.Debug("Retrieved Value from Control [{0}] is: [{1}]", controlName, oValue) + + result = ReplacePattern(result, PATTERN_CTRL, oValue) + Else + _Logger.Warn("Control [{0}] not found!", controlName) + End If + + oTryCounter += 1 + End While + _Logger.Debug("input after ReplaceControlValues [{input}]") + Return result + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info("Error in ReplaceControlValues:" & ex.Message) + Return input + End Try + End Function + Public Function ReplaceIDBAttributes(IDB_OBJ_ID As Long, pInput As String, IS_SQL As Boolean) As String + Try + Dim result = pInput + Dim oTryCounter As Integer = 0 + While ContainsPattern(result, PATTERN_IDBA) + + Dim indexName As String = GetNextPattern(result, PATTERN_IDBA).Value + Dim oIDBValue + If indexName = "ObjectID" Then + oIDBValue = IDB_OBJ_ID + ElseIf indexName = "OBJID" Then + oIDBValue = IDB_OBJ_ID + ElseIf indexName = "DocID" Then + oIDBValue = IDB_OBJ_ID + Else + oIDBValue = _idbdata.GetVariableValue(indexName) + End If + + If IsNothing(oIDBValue) And oTryCounter = MAX_TRY_COUNT Then + _Logger.Warn($"Max tries for [{indexName}] in ReplaceIDBAttributes exceeded - Replacing with [0]!") + Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}" + result = result.Replace(oReplaceValue, 0) + Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.") + + End If + If oIDBValue IsNot Nothing Or Not IsDBNull(oIDBValue) Then + Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}" + If IS_SQL = True Then + _Logger.Debug($"IS_SQL = True - oReplaceValue = [{oReplaceValue}]") + If indexName <> "ObjectID" And indexName <> "OBJID" And indexName <> "DocID" Then + Try + oIDBValue = oIDBValue.Replace("'", "''") + Catch ex As Exception + _Logger.Warn($"Invalid IDBValue for [{indexName}] in ReplaceIDBAttributes [{ex.Message}] - Replacing with [0]!") + oIDBValue = 0 + End Try + + End If + _Logger.Debug($"oIDBValue = {oIDBValue}") + End If + result = result.Replace(oReplaceValue, oIDBValue) + Else + _Logger.Warn($"IDBValue for [{indexName}] in ReplaceIDBAttributes is nothing or dbnull - Replacing with [0]!") + Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}" + result = result.Replace(oReplaceValue, 0) + End If + oTryCounter += 100 + End While + _Logger.Debug("sql after ReplaceIDBAttributes: " & pInput) + Return result + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info("Error in ReplaceIDBAttributes:" & ex.Message) + End Try + End Function + + 'Public Function ReplaceWindreamIndicies(input As String, document As WMObject) As String + ' Try + ' Dim result = input + ' Dim oTryCounter As Integer = 0 + ' While ContainsPattern(result, PATTERN_WMI) + + ' Dim indexName As String = GetNextPattern(result, PATTERN_WMI).Value + ' Dim oWMValue = document.GetVariableValue(indexName) + ' If IsNothing(oWMValue) And oTryCounter = MAX_TRY_COUNT Then + ' _Logger.Warn("Exit from ReplaceWindreamIndicies as oWMValue is still nothing and oTryCounter is 500!") + ' Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.") + + ' End If + ' If oWMValue IsNot Nothing Then + ' result = ReplacePattern(result, PATTERN_WMI, oWMValue) + ' End If + ' oTryCounter += 100 + ' End While + ' _Logger.Debug("sql after ReplaceWindreamIndicies: " & input) + ' Return result + ' Catch ex As Exception + ' _Logger.Error(ex) + ' _Logger.Info("Error in ReplaceWindreamIndicies:" & ex.Message) + ' End Try + 'End Function + 'Public Function ReplaceIDBAttributes(input As String) As String + ' Try + ' Dim result = input + ' Dim oTryCounter As Integer = 0 + ' While ContainsPattern(result, PATTERN_IDBA) + + ' Dim indexName As String = GetNextPattern(result, PATTERN_IDBA).Value + ' Dim oIDBValue + ' If indexName = "ObjectID" Then + ' oIDBValue = CURRENT_DOC_ID + ' ElseIf indexName = "OBJID" Then + ' oIDBValue = CURRENT_DOC_ID + ' ElseIf indexName = "DocID" Then + ' oIDBValue = CURRENT_DOC_ID + ' Else + + ' oIDBValue = IDBData.GetVariableValue(indexName) + ' End If + + ' If IsNothing(oIDBValue) And oTryCounter = MAX_TRY_COUNT Then + ' _Logger.Warn("Exit from ReplaceIDBIndicies as Value is still nothing and oTryCounter is 500!") + ' Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.") + + ' End If + ' If oIDBValue IsNot Nothing Then + ' Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}" + ' result = result.Replace(oReplaceValue, oIDBValue) + ' 'result = ReplacePattern(result, oReplaceValue, oIDBValue) + ' End If + ' oTryCounter += 100 + ' End While + ' _Logger.Debug("sql after ReplaceIDBAttributes: " & input) + ' Return result + ' Catch ex As Exception + ' _Logger.Error(ex) + ' _Logger.Info("Error in ReplaceIDBAttributes:" & ex.Message) + ' End Try + 'End Function + + Private Function ContainsPattern(input As String, type As String) As String + Dim elements As MatchCollection = myregex.Matches(input) + + For Each element As Match In elements + Dim t As String = element.Groups(1).Value + + If t = type Then + Return True + End If + Next + + Return False + End Function + + Public Function GetNextPattern(input As String, type As String) As Pattern + Dim elements As MatchCollection = myregex.Matches(input) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + If t = type Then + Return New Pattern(t, v) + End If + Next + + Return Nothing + End Function + + Public Function GetAllPatterns(input As String) As List(Of Pattern) + Dim elements As MatchCollection = myregex.Matches(input) + Dim results As New List(Of Pattern) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + results.Add(New Pattern(t, v)) + Next + + Return results + End Function + + Public Function ReplacePattern(input As String, type As String, replacement As String) As String + Dim elements As MatchCollection = myregex.Matches(input) + + If IsNothing(replacement) Then + Return input + End If + + For Each element As Match In elements + ' if group 1 contains the 'pattern' the replace whole group with 'replacement' + ' and return it + If element.Groups(1).Value = type Then + Return Regex.Replace(input, element.Groups(0).Value, replacement) + End If + Next + + ' no replacement made + Return input + End Function + + Private Function ContainsPatternAndValue(input As String, type As String, value As String) As Boolean + Dim elements As MatchCollection = myregex.Matches(input) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + If t = type And v = value Then + Return True + End If + Next + + Return False + End Function + + Public Function HasAnyPatterns(input) As Boolean + Return allPatterns.Any(Function(p) + Return HasPattern(input, p) + End Function) + End Function + + Public Function HasOnlySimplePatterns(input As String) As Boolean + Return Not HasComplexPatterns(input) + End Function + + Public Function HasComplexPatterns(input As String) As Boolean + Return complexPatterns.Any(Function(p) + Return HasPattern(input, p) + End Function) + End Function + + Public Function HasPattern(input As String, type As String) As Boolean + Dim matches = myregex.Matches(input) + + For Each match As Match In matches + For Each group As Group In match.Groups + If group.Value = type Then + Return True + End If + Next + Next + + Return False + End Function + + Public Class Pattern + Public ReadOnly Property Type As String + Public ReadOnly Property Value As String + + Public Sub New(type As String, value As String) + Me.Type = type + Me.Value = value + End Sub + + 'Public Sub New(stringRepresentation As String) + ' Dim elements As MatchCollection = myregex.Matches(stringRepresentation) + ' Dim first As Match = elements.Item(0) + + ' Dim t As String = first.Groups(1).Value + ' Dim v As String = first.Groups(2).Value + + ' Type = t + ' Value = v + 'End Sub + + Public Overrides Function ToString() As String + Return $"{{#{Type}#{Value}}}" + End Function + End Class +End Class diff --git a/GUIs.ZooFlow/Globix/GlobixPostprocessing.vb b/GUIs.ZooFlow/Globix/GlobixPostprocessing.vb new file mode 100644 index 00000000..6d93709c --- /dev/null +++ b/GUIs.ZooFlow/Globix/GlobixPostprocessing.vb @@ -0,0 +1,95 @@ +Imports System.Text.RegularExpressions +Imports DigitalData.Modules.Logging + +Public Class GlobixPostprocessing + Private _Logger As Logger + + Public Sub New(LogConfig As LogConfig) + _Logger = LogConfig.GetLogger + End Sub + Private Const VBSPLIT = "VBSPLIT" + Private Const VBREPLACE = "VBREPLACE" + Private Const REGEXPRESSION = "REG. EXPRESSION" + + Public Function Get_Nachbearbeitung_Wert(idxvalue As String, Datatable As DataTable) As String + Dim oIndexValues As List(Of String) = idxvalue.Split("~").ToList() + + Try + For Each oDataRow As DataRow In Datatable.Rows + Dim oResult As New List(Of String) + Dim oType As String = oDataRow.Item("TYPE").ToString.ToUpper + + Select Case oType + Case VBSPLIT + _Logger.Info(" ...Nachbearbeitung mit VBSPLIT") + + Dim oSeparator As String = oDataRow.Item("TEXT1") + Dim oSplitIndex As Integer = 0 + Integer.TryParse(oDataRow.Item("TEXT2"), oSplitIndex) + + For Each oIndexValue In oIndexValues + Dim oSplitted As List(Of String) = oIndexValue.Split(oSeparator).ToList() + oResult.Add(oSplitted.Item(oSplitIndex)) + Next + + Case VBREPLACE + Dim oFindString = oDataRow.Item("TEXT1") + Dim oReplaceString = oDataRow.Item("TEXT2") + + _Logger.Info(" ...Nachbearbeitung mit VBREPLACE") + _Logger.Info(" ...Ersetze '" & oFindString & "' mit '" & oReplaceString & "'") + + For Each oIndexValue In oIndexValues + Dim oReplaceResult = oIndexValue.Replace(oFindString, oReplaceString) + oResult.Add(oReplaceResult) + Next + Case REGEXPRESSION + _Logger.Info(" ...Nachbearbeitung mit RegEx") + + Dim oRegexList As New List(Of Regex) + Dim oRegex As New Regex(oDataRow.Item("TEXT1"), RegexOptions.IgnoreCase) + + oRegexList.Add(oRegex) + + For Each oIndexValue In oIndexValues + Dim oProcessedString = extractFromStringviaRE(oIndexValue, oRegexList) + oResult.Add(oProcessedString) + + _Logger.Info(" ...Ergebnis des RegEx: " & oProcessedString) + Next + End Select + + oIndexValues = oResult + Next + Catch ex As Exception + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_Nachbearbeitung_Wert:") + _Logger.Info(" - Unvorhergesehener Unexpected error in Get_Nachbearbeitung_Wert - result: " & idxvalue & " - Fehler: " & vbNewLine & ex.Message) + End Try + + Return String.Join("~", oIndexValues.ToArray) + End Function + + ''' + ''' Extrahiert aus dem String anhand einer Liste von Regular Expressions ein Ergebnis. + ''' + ''' Der zu untersuchende String erzeugt wurden. + ''' Eine Liste von Regular Expressions + ''' Die Ergebnisgruppe, die die Adresse enthält + ''' Eine Emailadresse oder Nothing, wenn keine der Regular Expressions ein Ergebnis lieferte. + Public Function extractFromStringviaRE(SearchString As String, RegexList As List(Of Regex), Optional RegexGroup As Integer = 1) + If IsNothing(SearchString) Then + Return Nothing + End If + + For Each rx In RegexList + Dim match As Match = rx.Match(SearchString) + Dim result As String = match.Groups(RegexGroup).Value + If Not String.IsNullOrWhiteSpace(result) Then + 'Nur den ersten Wert zurückgeben + Return result + End If + Next + + Return Nothing + End Function +End Class diff --git a/GUIs.ZooFlow/Globix/State.vb b/GUIs.ZooFlow/Globix/State.vb index 4ac3d407..88c4dcec 100644 --- a/GUIs.ZooFlow/Globix/State.vb +++ b/GUIs.ZooFlow/Globix/State.vb @@ -9,12 +9,32 @@ Public Property CURRENT_FILENAME As String Public Property CURRENT_WORKFILE_GUID As Long Public Property CURRENT_WORKFILE As String + Public Property CURRENT_WORKFILE_EXTENSION As String + Public Property CURRENT_NEWFILENAME As String + Public Property CURRENT_DOC_ID As Long Public Property ABORT_INDEXING As Boolean = False Public Property INDEXING_ACTIVE As Boolean = False Public Property CURRENT_ISATTACHMENT As Boolean = False Public Property CURR_DELETE_ORIGIN As Boolean = False Public Property CURRENT_DROPTYPE As String + Public Property CURRENT_LASTDOCTYPE As String + Public Property CURRENT_DOCTYPE_ID As Int16 + Public Property CURRENT_DOCTYPE_DuplicateHandling As String Public Property MULTIINDEXING_ACTIVE As Boolean = False + Public Property ECMDirect As Boolean = True + Public Property CURRENT_PROFILE_LOG_INDEX As String + Public Property ShowIndexResult As Boolean = True + Public Property CURR_MAN_INDEXE As DataTable + Public Property CURR_AUTO_INDEXE As DataTable + Public Property CURR_INDEX_MAN_POSTPROCESSING As DataTable + Public Property FILE_DELIMITER As String + Public Property VERSION_DELIMITER As String + Public Property CURRENT_MESSAGEID As String + Public Property CURRENT_BusinessEntity As String + + + + Public Function FileExistsinDropTable(Filename As String) As Boolean Dim oSQL As String Try diff --git a/GUIs.ZooFlow/ModuleHelpers.vb b/GUIs.ZooFlow/ModuleHelpers.vb new file mode 100644 index 00000000..fb3e6f45 --- /dev/null +++ b/GUIs.ZooFlow/ModuleHelpers.vb @@ -0,0 +1,60 @@ +Imports System.Text +Imports System.Text.RegularExpressions + +Module ModuleHelpers + ''' + ''' Überprüft einen Wert auf verschiedene Arten von "Null" und gibt einen Standard-Wert zurück, wenn der Wert "Null" ist. + ''' + ''' Der zu überprüfende Wert + ''' Der Standard Wert + ''' value oder wenn dieser "Null" ist, defaultValue + Public Function NotNull(Of T)(ByVal value As T, ByVal defaultValue As T) As T + If IsNothing(value) OrElse String.IsNullOrEmpty(value.ToString) OrElse IsDBNull(value) Then + Return defaultValue + Else + Return value + End If + End Function + Public Function encode_utf8(ByVal str As String) As String + Try + '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) + Catch ex As Exception + MsgBox("Unexpected error in encode_utf8: " & ex.Message, MsgBoxStyle.Critical) + Return Nothing + End Try + + End Function + Public Function StringAsUtf8Bytes(ByVal strData As String) As Byte() + Try + Dim bytes() As Byte + ' get unicode string as bytes + bytes = Encoding.UTF8.GetBytes(strData) + ' return byte data + Return bytes + Catch ex As Exception + MsgBox("Unexpected error in StringAsUtf8Bytes: " & ex.Message, MsgBoxStyle.Critical) + Return Nothing + End Try + + End Function + Public Function CheckSpecialSigns(ByVal str As String) + Try + Dim pattern As String = "[!""#$%&'()*+,\-./:;<=>?@[\\\]^_`{|}~\s]" + Dim matches As MatchCollection = Regex.Matches(str, pattern) + Return matches.Count + Catch ex As Exception + MsgBox("Unexpected error in CheckSpecialSigns: " & ex.Message, MsgBoxStyle.Critical) + Return 0 + End Try + End Function + Public Sub Refresh_RegexTable() + My.Application.BASE_DATA_DT_REGEX = My.Database.GetDatatable("SELECT * FROM TBGI_FUNCTION_REGEX") + End Sub + +End Module diff --git a/GUIs.ZooFlow/MyApplication.vb b/GUIs.ZooFlow/MyApplication.vb index 8067b867..5a51ebef 100644 --- a/GUIs.ZooFlow/MyApplication.vb +++ b/GUIs.ZooFlow/MyApplication.vb @@ -26,6 +26,7 @@ Namespace My End Property Property DTAttributes As DataTable + Property IDB_DT_DOC_DATA As DataTable Property LogConfig As LogConfig Property MainForm As frmAdministrationZooFlow Property SearchForm As frmSearchStart @@ -52,6 +53,11 @@ Namespace My Public CommandLineFunction As String Public CommandLineArguments As New Dictionary(Of String, String) + + + Public Property IDB_DT_DOC_DATA As DataTable + + Public Property BASE_DATA_DT_REGEX As DataTable End Class End Namespace diff --git a/GUIs.ZooFlow/ZooFlow.vbproj b/GUIs.ZooFlow/ZooFlow.vbproj index 8f3a79bd..e6f96887 100644 --- a/GUIs.ZooFlow/ZooFlow.vbproj +++ b/GUIs.ZooFlow/ZooFlow.vbproj @@ -58,6 +58,9 @@ ..\Controls.DocumentViewer\bin\Debug\DigitalData.Controls.DocumentViewer.dll + + ..\Controls.LookupGrid\bin\Debug\DigitalData.Controls.LookupGrid.dll + ..\GUIs.Common\bin\Debug\DigitalData.GUIs.Common.dll @@ -72,6 +75,10 @@ ..\packages\NLog.4.7.0\lib\net45\NLog.dll + + False + P:\Visual Studio Projekte\Bibliotheken\Oracle.ManagedDataAccess.dll + @@ -114,6 +121,7 @@ + True True @@ -157,7 +165,11 @@ Form + + + + True True diff --git a/GUIs.ZooFlow/clsIDBData.vb b/GUIs.ZooFlow/clsIDBData.vb new file mode 100644 index 00000000..c6110976 --- /dev/null +++ b/GUIs.ZooFlow/clsIDBData.vb @@ -0,0 +1,231 @@ +Imports DigitalData.Modules.Logging + +Public Class clsIDBData + Public DTVWIDB_BE_ATTRIBUTE As DataTable + ''' + ''' Gets all indices by BusinessEntity. + ''' + ''' Title of Business Entity + ''' Array with all Indices + ''' + ''' + + Private _Logger As Logger + Public Sub New(LogConfig As LogConfig) + _Logger = LogConfig.GetLogger + Dim oSQL = $"SELECT * FROM VWIDB_BE_ATTRIBUTE" + DTVWIDB_BE_ATTRIBUTE = My.DatabaseIDB.GetDatatable(oSQL) + End Sub + Public IDBSystemIndices As List(Of String) + Public Function GetIndicesByBE(ByVal BusinessEntity As String) As String() + Try + Dim aNames(4) As String + aNames(0) = "ObjectID" + aNames(1) = "IDBCreatedWhen" + aNames(2) = "IDBCreatedWho" + aNames(3) = "IDBChangedWhen" + aNames(4) = "IDBChangedWho" + IDBSystemIndices = aNames.ToList + ' Array für Indizes vorbereiten + Dim aIndexNames(DTVWIDB_BE_ATTRIBUTE.Rows.Count + 4) As String + Dim oCount As Integer = 0 + aIndexNames(oCount) = "ObjectID" + oCount += 1 + aIndexNames(oCount) = "IDBCreatedWhen" + oCount += 1 + aIndexNames(oCount) = "IDBCreatedWho" + oCount += 1 + aIndexNames(oCount) = "IDBChangedWhen" + oCount += 1 + aIndexNames(oCount) = "IDBChangedWho" + For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows + oCount += 1 + aIndexNames(oCount) = oRow.Item("ATTR_TITLE") + + Next + + + ' Indexarray sortiert zurückgeben + Array.Sort(aIndexNames) + ' Indexarray zurückgeben + Return aIndexNames + + Catch ex As Exception + _Logger.Error(ex) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Error getting the IDB Indicies") + Return Nothing + End Try + End Function + Public Function GetTypeOfIndex(ByVal indexname As String) As Integer + Try + For Each oRow As DataRow In DTVWIDB_BE_ATTRIBUTE.Rows + If oRow.Item("ATTR_TITLE") = indexname Then + Dim oType = oRow.Item("TYP_ID") + Return oType + End If + Next + + Catch ex As Exception + _Logger.Error(ex) + Return Nothing + End Try + + End Function + Public Function GetVariableValue(oAttributeName As String, Optional oIDBTyp As Integer = 0, Optional FromIDB As Boolean = False) As Object + Try + Dim oSingleAttribute As Boolean = True + Select Case oIDBTyp + Case 8 + oSingleAttribute = False + Case 9 + oSingleAttribute = False + End Select + Dim oAttributeValue + + If Not IsNothing(My.Application.IDB_DT_DOC_DATA) Then + If oSingleAttribute = True And My.Application.IDB_DT_DOC_DATA.Rows.Count = 1 And FromIDB = False Then + Try + If oAttributeName = "IDBCreatedWhen" Then + oAttributeName = "ADDED_WHEN" + ElseIf oAttributeName = "IDBCreatedWho" Then + oAttributeName = "ADDED_WHO" + ElseIf oAttributeName = "IDBChangedWhen" Then + oAttributeName = "CHANGED_WHEN" + ElseIf oAttributeName = "IDBChangedWho" Then + oAttributeName = "CHANGED_WHO" + End If + + oAttributeValue = My.Application.IDB_DT_DOC_DATA.Rows(0).Item(oAttributeName) + Catch ex As Exception + _Logger.Debug($"Error getting Attribute from IDB_DT_DOC_DATA: {ex.Message}") + End Try + + End If + End If + + If Not IsNothing(oAttributeValue) Then + Return oAttributeValue + Else + _Logger.Debug($"oAttributeValue for Attribute [{oAttributeName}] is so far nothing..Now trying FNIDB_PM_GET_VARIABLE_VALUE ") + End If + Dim oFNSQL = $"SELECT * FROM [dbo].[FNIDB_PM_GET_VARIABLE_VALUE] ({My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.Language}',CONVERT(BIT,'0'))" + oAttributeValue = My.DatabaseIDB.GetDatatable(oFNSQL) + Dim odt As DataTable = oAttributeValue + If odt.Rows.Count = 1 Then + oAttributeValue = odt.Rows(0).Item(0) + End If + Return oAttributeValue + Catch ex As Exception + _Logger.Error(ex) + Return Nothing + End Try + + End Function + Public Function Delete_Term_Object_From_Metadata(oAttributeName As String, oTerm2Delete As String) As Object + Try + Dim oAttributeValue + Dim oID_IS_FOREIGN As Integer + oID_IS_FOREIGN = 1 + Dim oDELSQL = $"EXEC PRIDB_DELETE_TERM_OBJECT_METADATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{oTerm2Delete}','{My.Application.User.UserName}','{My.Application.User.Language}',{oID_IS_FOREIGN}" + My.DatabaseIDB.ExecuteNonQuery(oDELSQL) + + Catch ex As Exception + _Logger.Error(ex) + Return Nothing + End Try + + End Function + Public Function Delete_AttributeData(pIDB_OBJID As Int64, pAttributeName As String) As Object + Try + Dim oDELSQL = $"EXEC PRIDB_DELETE_ATTRIBUTE_DATA {pIDB_OBJID},'{pAttributeName}','{My.Application.User.UserName}'" + My.DatabaseIDB.ExecuteNonQuery(oDELSQL) + + Catch ex As Exception + _Logger.Error(ex) + Return Nothing + End Try + + End Function + + Public Function SetVariableValue(oAttributeName As String, oNewValue As Object, Optional CheckDeleted As Boolean = False, Optional oIDBTyp As Integer = 0) + Try + Dim omytype = oNewValue.GetType.ToString + If omytype = "System.Data.DataTable" Then + Dim oDTMyNewValues As DataTable = oNewValue + Dim oOldAttributeResult + Dim oTypeOldResult + + If CheckDeleted = True Then + oOldAttributeResult = GetVariableValue(oAttributeName, oIDBTyp) + oTypeOldResult = oOldAttributeResult.GetType.ToString + If oTypeOldResult = "System.Data.DataTable" Then + Dim myOldValues As DataTable = oOldAttributeResult + If myOldValues.Rows.Count > 1 Then + + 'now Checking whether the old row still remains in Vector? If not it will be deleted as it cannot be replaced in multivalues + For Each oOldValueRow As DataRow In myOldValues.Rows + Dim oExists As Boolean = False + For Each oNewValueRow As DataRow In oDTMyNewValues.Rows + Dim oInfo1 = $"Checking oldValue[{oOldValueRow.Item(0)}] vs NewValue [{oNewValueRow.Item(1)}]" + If oNewValueRow.Item(1).ToString.ToUpper = oOldValueRow.Item(0).ToString.ToUpper Then + oExists = True + Exit For + End If + Next + + If oExists = False Then + Dim oInfo = $"Value [{oOldValueRow.Item(0)}] no longer existing in Vector-Attribute [{oAttributeName}] - will be deleted!" + _Logger.Info(oInfo) + SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo) + Delete_Term_Object_From_Metadata(oAttributeName, oOldValueRow.Item(0)) + End If + + Next + End If + Else + If oDTMyNewValues.Rows.Count > 1 Then + Dim oExists As Boolean = False + For Each oNewValueRow As DataRow In oDTMyNewValues.Rows + Dim oInfo1 = $"Checking oldValue[{oOldAttributeResult}] vs NewValue [{oNewValueRow.Item(1)}]" + If oNewValueRow.Item(1).ToString.ToUpper = oOldAttributeResult.ToString.ToUpper Then + oExists = True + Exit For + End If + Next + If oExists = False Then + Dim oInfo2 = $"Value [{oOldAttributeResult}] no longer existing in Vector-Attribute [{oAttributeName}] - will be deleted!" + _Logger.Info(oInfo2) + SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo2) + Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult) + End If + Else + Dim oInfo = $"Value [{oOldAttributeResult}] of Attribute [{oAttributeName}] obviously was updated during runtime - will be deleted!" + _Logger.Info(oInfo) + SetVariableValue(My.Application.Globix.CURRENT_PROFILE_LOG_INDEX, oInfo) + Delete_Term_Object_From_Metadata(oAttributeName, oOldAttributeResult) + End If + + End If + + End If + + For Each oNewValueRow As DataRow In oDTMyNewValues.Rows + Dim oSuccess As Boolean = False + Dim oFNSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.UserName}','{oNewValueRow.Item(1).ToString}','{My.Application.User.Language}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT" + oSuccess = My.DatabaseIDB.ExecuteNonQuery(oFNSQL) + If oSuccess = False Then + Return False + End If + Next + Return True + Else + Dim oFNSQL = $"DECLARE @NEW_OBJ_MD_ID BIGINT " & vbNewLine & $"EXEC PRIDB_NEW_OBJ_DATA {My.Application.Globix.CURRENT_DOC_ID},'{oAttributeName}','{My.Application.User.UserName}','{oNewValue}','{My.Application.User.Language}',0,@OMD_ID = @NEW_OBJ_MD_ID OUTPUT" + Return My.DatabaseIDB.ExecuteNonQuery(oFNSQL) + End If + + Catch ex As Exception + _Logger.Error(ex) + Return False + End Try + End Function +End Class diff --git a/GUIs.ZooFlow/frmFlowForm.vb b/GUIs.ZooFlow/frmFlowForm.vb index d7b66850..66c381b4 100644 --- a/GUIs.ZooFlow/frmFlowForm.vb +++ b/GUIs.ZooFlow/frmFlowForm.vb @@ -49,14 +49,13 @@ Public Class frmFlowForm ' === Initialization === Init = New ClassInit(My.LogConfig, Me) - FileDrop = New ClassFileDrop(My.LogConfig) - FileHandle = New ClassFilehandle(My.LogConfig) AddHandler Init.Completed, AddressOf Init_Completed Init.InitializeApplication() End Sub Private Sub Init_Completed(sender As Object, e As EventArgs) + Me.Cursor = Cursors.WaitCursor ' === Initialization Complete === ApplicationLoading = False SplashScreenManager.CloseForm(False) @@ -94,8 +93,13 @@ Public Class frmFlowForm DTIDB_SEARCHES = oDatatable PictureBoxSearch.Visible = True End If - + If My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then + FileDrop = New ClassFileDrop(My.LogConfig) + FileHandle = New ClassFilehandle(My.LogConfig) + Refresh_RegexTable() + End If My.DTAttributes = My.DatabaseIDB.GetDatatable("SELECT * FROM TBIDB_ATTRIBUTE") + Me.Cursor = Cursors.Default End Sub @@ -281,6 +285,9 @@ Public Class frmFlowForm End If End Sub Sub DragDropForm(e As DragEventArgs) + If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then + Exit Sub + End If If TheFormIsAlreadyLoaded("frmIndexFileList") Then Cursor = Cursors.Default MsgBox("Please index the active file first!", MsgBoxStyle.Exclamation, "Drag 'n Drop not allowed!") @@ -302,6 +309,10 @@ Public Class frmFlowForm End Sub Private Sub TimerCheckDroppedFiles_Tick(sender As Object, e As EventArgs) Handles TimerCheckDroppedFiles.Tick + If Not My.Application.ModulesActive.Contains(ClassConstants.MODULE_GLOBAL_INDEXER) Then + Exit Sub + End If + TimerCheckDroppedFiles.Stop() Check_Dropped_Files() End Sub @@ -309,7 +320,8 @@ Public Class frmFlowForm Try My.Database.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE WORKED = 1 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") Dim i As Integer - For Each Str As Object In ClassFileDrop.files_dropped + + For Each Str As Object In FileDrop.files_dropped If Not Str Is Nothing Then Logger.Info(">> Check Drop-File: " & Str.ToString) Dim handleType As String = Str.Substring(0, Str.LastIndexOf("|") + 1) diff --git a/GUIs.ZooFlow/frmGlobix_Index.Designer.vb b/GUIs.ZooFlow/frmGlobix_Index.Designer.vb index 6a01bbc6..301159b2 100644 --- a/GUIs.ZooFlow/frmGlobix_Index.Designer.vb +++ b/GUIs.ZooFlow/frmGlobix_Index.Designer.vb @@ -28,26 +28,27 @@ Partial Class frmGlobix_Index Me.BarButtonItem3 = New DevExpress.XtraBars.BarButtonItem() Me.SkipItem = New DevExpress.XtraBars.BarButtonItem() Me.BarButtonItem5 = New DevExpress.XtraBars.BarButtonItem() - Me.BarCheckItem1 = New DevExpress.XtraBars.BarCheckItem() + Me.checkItemTopMost = New DevExpress.XtraBars.BarCheckItem() Me.SourceDeleteItem = New DevExpress.XtraBars.BarCheckItem() - Me.SaveProfileItem = New DevExpress.XtraBars.BarCheckItem() + Me.checkItemPreselection = New DevExpress.XtraBars.BarCheckItem() Me.PreviewItem = New DevExpress.XtraBars.BarCheckItem() + Me.labelFilePath = New DevExpress.XtraBars.BarStaticItem() + Me.labelError = New DevExpress.XtraBars.BarStaticItem() + Me.labelNotice = New DevExpress.XtraBars.BarStaticItem() + Me.chkMultiindexing = New DevExpress.XtraBars.BarCheckItem() + Me.BarButtonItem1 = New DevExpress.XtraBars.BarButtonItem() Me.RibbonPage1 = New DevExpress.XtraBars.Ribbon.RibbonPage() + Me.RibbonPageGroup3 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() Me.RibbonPageGroup1 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() Me.RibbonPageGroup2 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() + Me.RibbonPageGroupMultiIndex = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() Me.RibbonStatusBar1 = New DevExpress.XtraBars.Ribbon.RibbonStatusBar() Me.RibbonPage2 = New DevExpress.XtraBars.Ribbon.RibbonPage() Me.BarCheckItem2 = New DevExpress.XtraBars.BarCheckItem() - Me.labelFilePath = New DevExpress.XtraBars.BarStaticItem() - Me.labelError = New DevExpress.XtraBars.BarStaticItem() - Me.labelNotice = New DevExpress.XtraBars.BarStaticItem() - Me.RibbonPageGroupMultiIndex = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() - Me.chkMultiindexing = New DevExpress.XtraBars.BarCheckItem() - Me.RibbonPageGroup3 = New DevExpress.XtraBars.Ribbon.RibbonPageGroup() - Me.BarButtonItem1 = New DevExpress.XtraBars.BarButtonItem() Me.SplitContainerControl1 = New DevExpress.XtraEditors.SplitContainerControl() + Me.pnlIndex = New System.Windows.Forms.Panel() Me.Panel1 = New System.Windows.Forms.Panel() - Me.ComboBox1 = New System.Windows.Forms.ComboBox() + Me.cmbDoctype = New System.Windows.Forms.ComboBox() Me.DocumentViewer1 = New DigitalData.Controls.DocumentViewer.DocumentViewer() CType(Me.RibbonControl1, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.SplitContainerControl1, System.ComponentModel.ISupportInitialize).BeginInit() @@ -58,7 +59,7 @@ Partial Class frmGlobix_Index 'RibbonControl1 ' Me.RibbonControl1.ExpandCollapseItem.Id = 0 - Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.BarButtonItem2, Me.BarButtonItem3, Me.SkipItem, Me.BarButtonItem5, Me.BarCheckItem1, Me.SourceDeleteItem, Me.SaveProfileItem, Me.PreviewItem, Me.labelFilePath, Me.labelError, Me.labelNotice, Me.chkMultiindexing, Me.BarButtonItem1}) + Me.RibbonControl1.Items.AddRange(New DevExpress.XtraBars.BarItem() {Me.RibbonControl1.ExpandCollapseItem, Me.RibbonControl1.SearchEditItem, Me.BarButtonItem2, Me.BarButtonItem3, Me.SkipItem, Me.BarButtonItem5, Me.checkItemTopMost, Me.SourceDeleteItem, Me.checkItemPreselection, Me.PreviewItem, Me.labelFilePath, Me.labelError, Me.labelNotice, Me.chkMultiindexing, Me.BarButtonItem1}) Me.RibbonControl1.Location = New System.Drawing.Point(0, 0) Me.RibbonControl1.MaxItemId = 15 Me.RibbonControl1.Name = "RibbonControl1" @@ -95,14 +96,14 @@ Partial Class frmGlobix_Index Me.BarButtonItem5.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem5.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) Me.BarButtonItem5.Name = "BarButtonItem5" ' - 'BarCheckItem1 + 'checkItemTopMost ' - Me.BarCheckItem1.BindableChecked = True - Me.BarCheckItem1.Caption = "Andere Fenster überdecken" - Me.BarCheckItem1.Checked = True - Me.BarCheckItem1.Id = 6 - Me.BarCheckItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.BarCheckItem1.Name = "BarCheckItem1" + Me.checkItemTopMost.BindableChecked = True + Me.checkItemTopMost.Caption = "Andere Fenster überdecken" + Me.checkItemTopMost.Checked = True + Me.checkItemTopMost.Id = 6 + Me.checkItemTopMost.ImageOptions.SvgImage = CType(resources.GetObject("checkItemTopMost.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.checkItemTopMost.Name = "checkItemTopMost" ' 'SourceDeleteItem ' @@ -111,12 +112,12 @@ Partial Class frmGlobix_Index Me.SourceDeleteItem.ImageOptions.SvgImage = CType(resources.GetObject("SourceDeleteItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) Me.SourceDeleteItem.Name = "SourceDeleteItem" ' - 'SaveProfileItem + 'checkItemPreselection ' - Me.SaveProfileItem.Caption = "Profilauswahl merken" - Me.SaveProfileItem.Id = 8 - Me.SaveProfileItem.ImageOptions.SvgImage = CType(resources.GetObject("SaveProfileItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.SaveProfileItem.Name = "SaveProfileItem" + Me.checkItemPreselection.Caption = "Profilauswahl merken" + Me.checkItemPreselection.Id = 8 + Me.checkItemPreselection.ImageOptions.SvgImage = CType(resources.GetObject("checkItemPreselection.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.checkItemPreselection.Name = "checkItemPreselection" ' 'PreviewItem ' @@ -125,16 +126,63 @@ Partial Class frmGlobix_Index Me.PreviewItem.ImageOptions.SvgImage = CType(resources.GetObject("PreviewItem.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) Me.PreviewItem.Name = "PreviewItem" ' + 'labelFilePath + ' + Me.labelFilePath.Caption = "labelFilePath" + Me.labelFilePath.Id = 10 + Me.labelFilePath.ImageOptions.SvgImage = CType(resources.GetObject("labelFilePath.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.labelFilePath.Name = "labelFilePath" + Me.labelFilePath.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph + ' + 'labelError + ' + Me.labelError.Caption = "labelError" + Me.labelError.Id = 11 + Me.labelError.ImageOptions.SvgImage = CType(resources.GetObject("labelError.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.labelError.Name = "labelError" + Me.labelError.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph + ' + 'labelNotice + ' + Me.labelNotice.Caption = "labelNotice" + Me.labelNotice.Id = 12 + Me.labelNotice.ImageOptions.SvgImage = CType(resources.GetObject("labelNotice.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.labelNotice.Name = "labelNotice" + Me.labelNotice.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph + ' + 'chkMultiindexing + ' + Me.chkMultiindexing.Caption = "Inaktiv" + Me.chkMultiindexing.Id = 13 + Me.chkMultiindexing.ImageOptions.SvgImage = CType(resources.GetObject("chkMultiindexing.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.chkMultiindexing.ItemInMenuAppearance.Pressed.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(128, Byte), Integer), CType(CType(0, Byte), Integer)) + Me.chkMultiindexing.ItemInMenuAppearance.Pressed.Options.UseBackColor = True + Me.chkMultiindexing.Name = "chkMultiindexing" + ' + 'BarButtonItem1 + ' + Me.BarButtonItem1.Caption = "Starten" + Me.BarButtonItem1.Id = 14 + Me.BarButtonItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) + Me.BarButtonItem1.Name = "BarButtonItem1" + ' 'RibbonPage1 ' Me.RibbonPage1.Groups.AddRange(New DevExpress.XtraBars.Ribbon.RibbonPageGroup() {Me.RibbonPageGroup3, Me.RibbonPageGroup1, Me.RibbonPageGroup2, Me.RibbonPageGroupMultiIndex}) Me.RibbonPage1.Name = "RibbonPage1" Me.RibbonPage1.Text = "Start" ' + 'RibbonPageGroup3 + ' + Me.RibbonPageGroup3.AllowTextClipping = False + Me.RibbonPageGroup3.ItemLinks.Add(Me.BarButtonItem1) + Me.RibbonPageGroup3.Name = "RibbonPageGroup3" + Me.RibbonPageGroup3.Text = "Datei verarbeiten" + ' 'RibbonPageGroup1 ' Me.RibbonPageGroup1.ItemLinks.Add(Me.SourceDeleteItem) - Me.RibbonPageGroup1.ItemLinks.Add(Me.SaveProfileItem) + Me.RibbonPageGroup1.ItemLinks.Add(Me.checkItemPreselection) Me.RibbonPageGroup1.ItemLinks.Add(Me.SkipItem) Me.RibbonPageGroup1.ItemLinks.Add(Me.PreviewItem) Me.RibbonPageGroup1.Name = "RibbonPageGroup1" @@ -143,10 +191,17 @@ Partial Class frmGlobix_Index 'RibbonPageGroup2 ' Me.RibbonPageGroup2.Alignment = DevExpress.XtraBars.Ribbon.RibbonPageGroupAlignment.Far - Me.RibbonPageGroup2.ItemLinks.Add(Me.BarCheckItem1) + Me.RibbonPageGroup2.ItemLinks.Add(Me.checkItemTopMost) Me.RibbonPageGroup2.Name = "RibbonPageGroup2" Me.RibbonPageGroup2.Text = "Fenster" ' + 'RibbonPageGroupMultiIndex + ' + Me.RibbonPageGroupMultiIndex.AllowTextClipping = False + Me.RibbonPageGroupMultiIndex.ItemLinks.Add(Me.chkMultiindexing) + Me.RibbonPageGroupMultiIndex.Name = "RibbonPageGroupMultiIndex" + Me.RibbonPageGroupMultiIndex.Text = "Multi-Indexing" + ' 'RibbonStatusBar1 ' Me.RibbonStatusBar1.ItemLinks.Add(Me.labelFilePath) @@ -169,66 +224,13 @@ Partial Class frmGlobix_Index Me.BarCheckItem2.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem2.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) Me.BarCheckItem2.Name = "BarCheckItem2" ' - 'labelFilePath - ' - Me.labelFilePath.Caption = "labelFilePath" - Me.labelFilePath.Id = 10 - Me.labelFilePath.ImageOptions.SvgImage = CType(resources.GetObject("labelFilePath.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.labelFilePath.Name = "labelFilePath" - Me.labelFilePath.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph - ' - 'labelError - ' - Me.labelError.Caption = "labelError" - Me.labelError.Id = 11 - Me.labelError.ImageOptions.SvgImage = CType(resources.GetObject("BarStaticItem2.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.labelError.Name = "labelError" - Me.labelError.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph - ' - 'labelNotice - ' - Me.labelNotice.Caption = "labelNotice" - Me.labelNotice.Id = 12 - Me.labelNotice.ImageOptions.SvgImage = CType(resources.GetObject("BarStaticItem3.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.labelNotice.Name = "labelNotice" - Me.labelNotice.PaintStyle = DevExpress.XtraBars.BarItemPaintStyle.CaptionGlyph - ' - 'RibbonPageGroupMultiIndex - ' - Me.RibbonPageGroupMultiIndex.AllowTextClipping = False - Me.RibbonPageGroupMultiIndex.ItemLinks.Add(Me.chkMultiindexing) - Me.RibbonPageGroupMultiIndex.Name = "RibbonPageGroupMultiIndex" - Me.RibbonPageGroupMultiIndex.Text = "Multi-Indexing" - ' - 'chkMultiindexing - ' - Me.chkMultiindexing.Caption = "Inaktiv" - Me.chkMultiindexing.Id = 13 - Me.chkMultiindexing.ImageOptions.SvgImage = CType(resources.GetObject("BarCheckItem3.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.chkMultiindexing.ItemInMenuAppearance.Pressed.BackColor = System.Drawing.Color.FromArgb(CType(CType(255, Byte), Integer), CType(CType(128, Byte), Integer), CType(CType(0, Byte), Integer)) - Me.chkMultiindexing.ItemInMenuAppearance.Pressed.Options.UseBackColor = True - Me.chkMultiindexing.Name = "chkMultiindexing" - ' - 'RibbonPageGroup3 - ' - Me.RibbonPageGroup3.AllowTextClipping = False - Me.RibbonPageGroup3.ItemLinks.Add(Me.BarButtonItem1) - Me.RibbonPageGroup3.Name = "RibbonPageGroup3" - Me.RibbonPageGroup3.Text = "Datei verarbeiten" - ' - 'BarButtonItem1 - ' - Me.BarButtonItem1.Caption = "Starten" - Me.BarButtonItem1.Id = 14 - Me.BarButtonItem1.ImageOptions.SvgImage = CType(resources.GetObject("BarButtonItem1.ImageOptions.SvgImage"), DevExpress.Utils.Svg.SvgImage) - Me.BarButtonItem1.Name = "BarButtonItem1" - ' 'SplitContainerControl1 ' Me.SplitContainerControl1.CollapsePanel = DevExpress.XtraEditors.SplitCollapsePanel.Panel2 Me.SplitContainerControl1.Dock = System.Windows.Forms.DockStyle.Fill Me.SplitContainerControl1.Location = New System.Drawing.Point(0, 159) Me.SplitContainerControl1.Name = "SplitContainerControl1" + Me.SplitContainerControl1.Panel1.Controls.Add(Me.pnlIndex) Me.SplitContainerControl1.Panel1.Controls.Add(Me.Panel1) Me.SplitContainerControl1.Panel1.Text = "Panel1" Me.SplitContainerControl1.Panel2.Controls.Add(Me.DocumentViewer1) @@ -237,25 +239,33 @@ Partial Class frmGlobix_Index Me.SplitContainerControl1.SplitterPosition = 591 Me.SplitContainerControl1.TabIndex = 2 ' + 'pnlIndex + ' + Me.pnlIndex.Dock = System.Windows.Forms.DockStyle.Fill + Me.pnlIndex.Location = New System.Drawing.Point(0, 56) + Me.pnlIndex.Name = "pnlIndex" + Me.pnlIndex.Size = New System.Drawing.Size(591, 359) + Me.pnlIndex.TabIndex = 1 + ' 'Panel1 ' - Me.Panel1.Controls.Add(Me.ComboBox1) + Me.Panel1.Controls.Add(Me.cmbDoctype) Me.Panel1.Dock = System.Windows.Forms.DockStyle.Top Me.Panel1.Location = New System.Drawing.Point(0, 0) Me.Panel1.Name = "Panel1" Me.Panel1.Size = New System.Drawing.Size(591, 56) Me.Panel1.TabIndex = 0 ' - 'ComboBox1 + 'cmbDoctype ' - Me.ComboBox1.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ + Me.cmbDoctype.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _ Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles) - Me.ComboBox1.Font = New System.Drawing.Font("Segoe UI", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) - Me.ComboBox1.FormattingEnabled = True - Me.ComboBox1.Location = New System.Drawing.Point(12, 17) - Me.ComboBox1.Name = "ComboBox1" - Me.ComboBox1.Size = New System.Drawing.Size(555, 25) - Me.ComboBox1.TabIndex = 0 + Me.cmbDoctype.Font = New System.Drawing.Font("Segoe UI", 9.75!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) + Me.cmbDoctype.FormattingEnabled = True + Me.cmbDoctype.Location = New System.Drawing.Point(12, 17) + Me.cmbDoctype.Name = "cmbDoctype" + Me.cmbDoctype.Size = New System.Drawing.Size(555, 25) + Me.cmbDoctype.TabIndex = 0 ' 'DocumentViewer1 ' @@ -296,9 +306,9 @@ Partial Class frmGlobix_Index Friend WithEvents BarButtonItem3 As DevExpress.XtraBars.BarButtonItem Friend WithEvents SkipItem As DevExpress.XtraBars.BarButtonItem Friend WithEvents BarButtonItem5 As DevExpress.XtraBars.BarButtonItem - Friend WithEvents BarCheckItem1 As DevExpress.XtraBars.BarCheckItem + Friend WithEvents checkItemTopMost As DevExpress.XtraBars.BarCheckItem Friend WithEvents SourceDeleteItem As DevExpress.XtraBars.BarCheckItem - Friend WithEvents SaveProfileItem As DevExpress.XtraBars.BarCheckItem + Friend WithEvents checkItemPreselection As DevExpress.XtraBars.BarCheckItem Friend WithEvents PreviewItem As DevExpress.XtraBars.BarCheckItem Friend WithEvents BarCheckItem2 As DevExpress.XtraBars.BarCheckItem Friend WithEvents labelFilePath As DevExpress.XtraBars.BarStaticItem @@ -310,6 +320,7 @@ Partial Class frmGlobix_Index Friend WithEvents RibbonPageGroup3 As DevExpress.XtraBars.Ribbon.RibbonPageGroup Friend WithEvents SplitContainerControl1 As DevExpress.XtraEditors.SplitContainerControl Friend WithEvents Panel1 As Panel - Friend WithEvents ComboBox1 As ComboBox + Friend WithEvents cmbDoctype As ComboBox Friend WithEvents DocumentViewer1 As Controls.DocumentViewer.DocumentViewer + Friend WithEvents pnlIndex As Panel End Class diff --git a/GUIs.ZooFlow/frmGlobix_Index.resx b/GUIs.ZooFlow/frmGlobix_Index.resx index 3e6057e2..aadbd9b6 100644 --- a/GUIs.ZooFlow/frmGlobix_Index.resx +++ b/GUIs.ZooFlow/frmGlobix_Index.resx @@ -220,7 +220,7 @@ DQo8L3N2Zz4L - + AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl @@ -266,7 +266,7 @@ Y2xhc3M9IlJlZCIgLz4NCiAgPC9nPg0KPC9zdmc+Cw== - + AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl @@ -328,7 +328,7 @@ DQogIDwvZz4NCjwvc3ZnPgs= - + AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl @@ -349,7 +349,7 @@ dmc+Cw== - + AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl @@ -370,7 +370,7 @@ PC9nPg0KPC9zdmc+Cw== - + AAEAAAD/////AQAAAAAAAAAMAgAAAFlEZXZFeHByZXNzLkRhdGEudjE5LjIsIFZlcnNpb249MTkuMi4z LjAsIEN1bHR1cmU9bmV1dHJhbCwgUHVibGljS2V5VG9rZW49Yjg4ZDE3NTRkNzAwZTQ5YQUBAAAAHURl diff --git a/GUIs.ZooFlow/frmGlobix_Index.vb b/GUIs.ZooFlow/frmGlobix_Index.vb index efc1be3f..968e9022 100644 --- a/GUIs.ZooFlow/frmGlobix_Index.vb +++ b/GUIs.ZooFlow/frmGlobix_Index.vb @@ -1,15 +1,18 @@ -Imports DigitalData.Modules.Logging - +Imports System.IO +Imports System.Security.AccessControl +Imports System.Security.Principal +Imports DigitalData.Modules.Logging +Imports System.Text.RegularExpressions Public Class frmGlobix_Index #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 DT_INDEXEMAN As DataTable + Private DT_INDEXEAUTO As DataTable + Private DT_DOCTYPE As DataTable Public FormLoaded As Boolean = False Dim DropType As String - Private Shared WDDirect As Boolean = False Dim sql_history_INSERT_INTO As String Dim sql_history_Index_Values As String @@ -23,8 +26,10 @@ Public Class frmGlobix_Index Private Const TEXT_MISSING_INPUT = "Bitte vervollständigen Sie die Eingaben!" Private _LogConfig As LogConfig Private _Logger As Logger - + Private clsPatterns As GlobixPatterns Private clswindowLocation As ClassWindowLocation + Private clsPostProcessing As GlobixPostprocessing + Public Const VECTORSEPARATOR = "╚" #End Region @@ -37,8 +42,242 @@ Public Class frmGlobix_Index _Logger = LogConfig.GetLogger() _LogConfig = LogConfig clswindowLocation = New ClassWindowLocation(_LogConfig) + clsPostProcessing = New GlobixPostprocessing(_LogConfig) + clsPatterns = New GlobixPatterns(_LogConfig) + End Sub + Public Sub DisposeViewer() + DocumentViewer1.Dispose() + End Sub + Sub Refresh_Dokart() + Try + Dim oSql = String.Format("select * from VWGI_DOCTYPE where UPPER(USERNAME) = UPPER('{0}') ORDER BY SEQUENCE", Environment.UserName) + _Logger.Info("SQL DoctypeList: " & oSql) + DT_DOCTYPE = My.Database.GetDatatable(oSql) + cmbDoctype.DataSource = DT_DOCTYPE + cmbDoctype.ValueMember = DT_DOCTYPE.Columns("DOCTYPE_ID").ColumnName + cmbDoctype.DisplayMember = DT_DOCTYPE.Columns("DOCTYPE").ColumnName + cmbDoctype.AutoCompleteMode = AutoCompleteMode.Suggest + cmbDoctype.AutoCompleteSource = AutoCompleteSource.ListItems + cmbDoctype.SelectedIndex = -1 + Catch ex As Exception + _Logger.Warn(" - Unexpected error inm Laden der Dokumentarten - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Laden der Dokumentarten:") + End Try + End Sub + '#Region "+++++ Allgemeine Funktionen ++++++" + Sub ShowError(text As String) + 'lblerror.Visible = True + 'lblerror.Text = text + 'lblerror.ForeColor = Color.Red + labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Always + labelError.Caption = text + End Sub + + Sub ClearError() + labelError.Visibility = DevExpress.XtraBars.BarItemVisibility.Never + labelError.Caption = String.Empty + End Sub + + Sub ShowNotice(text As String) + 'lblhinweis.Visible = True + 'lblhinweis.Text = text + labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Always + labelNotice.Caption = text End Sub + Sub ClearNotice() + labelNotice.Visibility = DevExpress.XtraBars.BarItemVisibility.Never + labelNotice.Caption = String.Empty + End Sub + Sub addLabel(indexname As String, hinweis As String, ylbl As Integer, anz As String) + Dim lbl As New Label With { + .Name = "lbl" & indexname, + .AutoSize = True, + .Text = hinweis, + .Location = New Point(11, ylbl) + } + + pnlIndex.Controls.Add(lbl) + End Sub + Function Indexwert_checkValueDB(indexname As String, wert As String) + Try + Dim DR As DataRow + 'DT = DD_DMSLiteDataSet.VWINDEX_MAN + For Each DR In DT_INDEXEMAN.Rows + If DR.Item("NAME") = indexname Then + If DR.Item("SQL_CHECK").ToString <> String.Empty Then + Dim connectionString As String + Dim sql As String + connectionString = My.Database.Get_ConnectionStringforID(DR.Item("CONNECTION_ID")).ToString + 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 = ''--My.Database.o.OracleExecute_Scalar(sql, connectionString) + 'Else + 'MSQL + ergebnis = My.Database.GetScalarValueConStr(sql, connectionString, "Indexwert_checkValueDB") + ' End If + + Select Case ergebnis + Case 1 + Return True + Case 2 + ShowNotice("Indexwert nicht eindeutig: " & sql) + Return False + Case 99 + Return False + End Select + + End If + Else + Return True + End If + + End If + Next + Catch ex As Exception + MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_checkValue:") + _Logger.Info(" - Unvorhergesehener Unexpected error in Indexwert_checkValue - Fehler: " & vbNewLine & ex.Message) + Return False + End Try + End Function + + Function GetManIndex_Value(indexname As String, RequestFor As String, opt As Boolean) + Try + + For Each oDataRow As DataRow In DT_INDEXEMAN.Rows + If oDataRow.Item("INDEXNAME").ToString.ToLower = indexname.ToLower Then + If oDataRow.Item("Indexiert") = True Then + _Logger.Info("## Manueller Index: " & indexname) + Select Case RequestFor + Case "FILE" + If oDataRow.Item("Indexwert_File").ToString <> String.Empty Then + _Logger.Info(" >>Es liegt ein separater nachbearbeiteter Wert für die Dateibenennung vor: " & oDataRow.Item("Indexwert_File").ToString) + _Logger.Info(" >>Zurückgegebener NachbearbeitungsWert: " & oDataRow.Item("Indexwert_File")) + Return oDataRow.Item("Indexwert_File") + Else + If oDataRow.Item("Indexwert").ToString <> String.Empty Then + _Logger.Info("Zurückgegebener manueller Indexwert: " & oDataRow.Item("Indexwert")) + Return oDataRow.Item("Indexwert") + Else + If opt = False Then + _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") + ShowNotice("Indexiert = True - Der Index: " & oDataRow.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 oDataRow.Item("Indexwert").ToString <> String.Empty Then + _Logger.Info(" >>Zurückgegebener manueller Indexwert: " & oDataRow.Item("Indexwert")) + Return oDataRow.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 + _Logger.Info("Achtung, der Indexwert des manuellen Indexes '" & indexname & "' ist String.empty!") + ShowNotice("Indexiert = True - Der Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") + Return Nothing + Else + Return "" + End If + End If + End Select + Else + ShowNotice("Der Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert! - Automatischer Index konnte nicht gesetzt werden!") + Return Nothing + End If + Exit For + End If + Next + Catch ex As Exception + _Logger.Warn(" - Unvorhergesehener Unexpected error in GetManIndex_Value - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetManIndex_Value:") + Return Nothing + End Try + End Function + Function GetAutoIndex_Value(indexname As String) + Try + For Each oDataRow As DataRow In DT_INDEXEAUTO.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(VECTORSEPARATOR) Then + Return oIndexWert.ToString.Split(VECTORSEPARATOR).FirstOrDefault() + Else + ' Else just return the normal value + Return oIndexWert + End If + Else + ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") + Return "" + End If + Else + ShowNotice("Der Automatische Index: " & oDataRow.Item("INDEXNAME") & " wurde nicht ordnungsgemäss indexiert!") + Return "" + End If + Exit For + End If + Next + Catch ex As Exception + _Logger.Warn(" - Unvorhergesehener Unexpected error in GetAutoIndex_Value - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox("Indexname: " & indexname & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Unexpected error in GetAutoIndex_Value:") + Return "" + End Try + End Function + + Function GetAutomaticIndexSQLValue(SQLCommand As String, vconnectionID As Integer, vProvider As String) As String + Try + Dim oConnectionString As String + oConnectionString = My.Database.Get_ConnectionStringforID(vconnectionID) + + If oConnectionString <> "" Then + 'NEU + Dim oErgebnis + 'Welcher Provider? + 'If vProvider.ToLower = "oracle" Then + 'oErgebnis = ClassDatabase.OracleExecute_Scalar(SQLCommand, oConnectionString) + 'Else 'im Moment nur SQL-Server + oErgebnis = My.Database.GetScalarValueConStr(SQLCommand, oConnectionString, "GetAutomaticIndexSQLValue") + 'End If + + _Logger.Debug(" >>SQL-ConnectionString: " & oConnectionString.Substring(0, oConnectionString.LastIndexOf("="))) + + If oErgebnis Is Nothing Then + 'showlblhinweis("Kein Ergebnis für automatisches SQL: " & vsqlstatement) + Return "" + Else + Return oErgebnis + End If + End If + + Catch ex As Exception + _Logger.Warn(" - Unexpected error in Get_AutomatischerIndex_SQL - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Get_AutomatischerIndex_SQL:") + Return "" + End Try + End Function Private Sub frmGlobix_Index_Load(sender As Object, e As EventArgs) Handles MyBase.Load ' Abbruchzähler zurücksetzen CancelAttempts = 0 @@ -53,7 +292,7 @@ Public Class frmGlobix_Index SourceDeleteItem.Enabled = True SourceDeleteItem.Checked = My.UIConfig.Globix.DeleteOriginalFile - My.Application.GDPictureLicense = My.Database.GetScalarValue("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'") + My.Application.GDPictureLicense = My.Database.GetScalarValue("SELECT LICENSE FROM TBDD_3RD_PARTY_MODULES WHERE NAME = 'GDPICTURE'").ToString DocumentViewer1.Init(_LogConfig, My.Application.GDPictureLicense) @@ -179,7 +418,13 @@ Public Class frmGlobix_Index End Try End Sub - Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SourceDeleteItem.ItemClick + Private Sub BarCheckItem5_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles PreviewItem.CheckedChanged + SetFilePreview(PreviewItem.Checked) + My.UIConfig.Globix.FilePreview = PreviewItem.Checked + My.SystemConfigManager.Save() + End Sub + + Private Sub SourceDeleteItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SourceDeleteItem.CheckedChanged If SourceDeleteItem.Visibility <> DevExpress.XtraBars.BarItemVisibility.Never Then My.Application.Globix.CURR_DELETE_ORIGIN = SourceDeleteItem.Checked My.UIConfig.Globix.DeleteOriginalFile = SourceDeleteItem.Checked @@ -187,16 +432,8 @@ Public Class frmGlobix_Index End If End Sub - Private Sub BarCheckItem5_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles PreviewItem.CheckedChanged - - End Sub - - Private Sub SourceDeleteItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SourceDeleteItem.CheckedChanged - - End Sub - - Private Sub SaveProfileItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles SaveProfileItem.CheckedChanged - My.UIConfig.Globix.ProfilePreselection = SaveProfileItem.Checked + Private Sub SaveProfileItem_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemPreselection.CheckedChanged + My.UIConfig.Globix.ProfilePreselection = checkItemPreselection.Checked My.SystemConfigManager.Save() End Sub @@ -213,4 +450,1391 @@ Public Class frmGlobix_Index chkMultiindexing.Caption = "Inactive" End If End Sub + + Private Sub frmGlobix_Index_Shown(sender As Object, e As EventArgs) Handles Me.Shown + Try + Focus() + Cursor = Cursors.Default + Refresh_Dokart() + pnlIndex.Controls.Clear() + + checkItemTopMost.Checked = My.UIConfig.Globix.TopMost + Me.TopMost = My.UIConfig.Globix.TopMost + BringToFront() + Catch ex As Exception + _Logger.Warn("Unexpected error frmGlobix_Index_Shown Part 1: " & vbNewLine & ex.Message) + End Try + + + FormLoaded = True + + Try + ' Letzte Auswahl merken überschreibt die automatische selektion + If My.UIConfig.Globix.ProfilePreselection Then + checkItemPreselection.Checked = True + + If My.Application.Globix.CURRENT_LASTDOCTYPE <> "" Then + cmbDoctype.SelectedIndex = cmbDoctype.FindStringExact(My.Application.Globix.CURRENT_LASTDOCTYPE) + End If + Else + If My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows.Count > 0 Then + For Each oRoW As DataRow In My.Application.Globix.DTTBGI_REGEX_DOCTYPE.Rows + Dim oOnlyFilename = Path.GetFileName(My.Application.Globix.CURRENT_WORKFILE) + If Regex.IsMatch(oOnlyFilename, oRoW.Item("Regex")) Then + + _Logger.Debug("There is a match on REGEX_DOCTYPE: [{0}]", oRoW.Item("DOCTYPE")) + _Logger.Debug("Regex: [{0}], FileName: [{1}]", oRoW.Item("Regex"), oOnlyFilename) + cmbDoctype.SelectedIndex = cmbDoctype.FindStringExact(oRoW.Item("DOCTYPE")) + Exit For + End If + Next + End If + End If + Catch ex As Exception + _Logger.Warn("Unexpected error frmGlobix_Index_Shown Part 2 - ErrorMessage: " & vbNewLine & ex.Message) + End Try + End Sub + + Private Sub checkItemTopMost_CheckedChanged(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles checkItemTopMost.CheckedChanged + If FormLoaded = True Then + TopMost = checkItemTopMost.Checked + My.UIConfig.Globix.TopMost = checkItemTopMost.Checked + My.SystemConfigManager.Save() + End If + End Sub + + Private Sub cmbDoctype_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbDoctype.SelectedIndexChanged + If cmbDoctype.SelectedIndex <> -1 And FormLoaded = True Then + If cmbDoctype.SelectedValue.GetType.ToString = "System.Int32" Then + My.Application.Globix.CURRENT_DOCTYPE_ID = cmbDoctype.SelectedValue + + 'lblhinweis.Visible = False + ClearNotice() + + 'lblerror.Visible = False + ClearError() + + + Me.pnlIndex.Controls.Clear() + Dim oSql As String = "Select WINDREAM_DIRECT, DUPLICATE_HANDLING from TBDD_DOKUMENTART WHERE GUID = " & cmbDoctype.SelectedValue + Dim oDT As DataTable = My.Database.GetDatatable(oSql) + + My.Application.Globix.ECMDirect = oDT.Rows(0).Item("WINDREAM_DIRECT") + My.Application.Globix.CURRENT_DOCTYPE_DuplicateHandling = oDT.Rows(0).Item("DUPLICATE_HANDLING") + Refresh_IndexeMan(cmbDoctype.SelectedValue) + End If + + End If + End Sub + Private Sub Refresh_IndexeMan(dokartid As Integer) + Dim oSql + Try + oSql = "select T1.BEZEICHNUNG AS DOKUMENTART,T.* from TBDD_INDEX_MAN T, TBDD_DOKUMENTART T1 where T.ACTIVE = 1 AND T.DOK_ID = T1.GUID AND T.DOK_ID = " & dokartid & " ORDER BY T.SEQUENCE" + DT_INDEXEMAN = My.Database.GetDatatable(oSql) + pnlIndex.Visible = True + LoadIndexe_Man() + Catch ex As System.Exception + _Logger.Error(ex) + _Logger.Warn("Fehler Refresh_IndexeMan: DOKART-ID: " & dokartid & " - Fehler: " & vbNewLine & ex.Message & vbNewLine & oSql) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Refresh_IndexeMan:") + End Try + End Sub + Private Sub LoadIndexe_Man() + Try + Dim oControlCount As Integer = 1 + Dim oLabelPosition As Integer = 11 + Dim oControlPosition As Integer = 33 + Dim oControls As New GlobixControls(_LogConfig, pnlIndex, Me) + + If DT_INDEXEMAN.Rows.Count = 0 Then + ShowError("Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDoctype.Text & " definiert") + _Logger.Info(" - Keine Manuellen Indizes für die " & vbNewLine & "Dokumentart " & cmbDoctype.Text & " definiert") + End If + + For Each oRow As DataRow In DT_INDEXEMAN.Rows + Dim oDataType = oRow.Item("DATATYPE") + Dim MultiSelect As Boolean = oRow.Item("MULTISELECT") + Dim AddNewItems As Boolean = oRow.Item("VKT_ADD_ITEM") + Dim PreventDuplicates As Boolean = oRow.Item("VKT_PREVENT_MULTIPLE_VALUES") + Dim oControlName As String = oRow.Item("NAME") + Dim oConnectionId = NotNull(oRow.Item("CONNECTION_ID"), 0) + Dim oSQLSuggestion = oRow.Item("SUGGESTION") + + If oDataType <> "BOOLEAN" Then + addLabel(oControlName, oRow.Item("COMMENT").ToString, oLabelPosition, oControlCount) + End If + + 'Dim DefaultValue = Check_HistoryValues(oControlName, oRow.Item("DOKUMENTART")) + 'If DefaultValue Is Nothing Then + ' DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) + 'End If + Dim DefaultValue = "" + DefaultValue = GetPlaceholderValue(oRow.Item("DEFAULT_VALUE"), My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) + Select Case oDataType + Case "BOOLEAN" + Dim chk As CheckBox = oControls.AddCheckBox(oControlName, oControlPosition, DefaultValue, oRow.Item("COMMENT").ToString) + If Not IsNothing(chk) Then + pnlIndex.Controls.Add(chk) + End If + Case "INTEGER" + If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then + Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion) + If Not IsNothing(oControl) Then + pnlIndex.Controls.Add(oControl) + End If + Else + 'nur eine Textbox + Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, DefaultValue, oDataType) + If Not IsNothing(oControl) Then + pnlIndex.Controls.Add(oControl) + End If + End If + Case "VARCHAR" + If (oSQLSuggestion = True And oRow.Item("SQL_RESULT").ToString.Length > 0) Or MultiSelect = True Then + Dim oControl = oControls.AddVorschlag_ComboBox(oControlName, oControlPosition, oConnectionId, oRow.Item("SQL_RESULT"), MultiSelect, oDataType, DefaultValue, AddNewItems, PreventDuplicates, oSQLSuggestion) + If Not IsNothing(oControl) Then + pnlIndex.Controls.Add(oControl) + End If + Else + If oControlName.ToString.ToLower = "dateiname" Then + Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE), oDataType) + If Not IsNothing(oControl) Then + pnlIndex.Controls.Add(oControl) + End If + Else + Dim VORBELGUNG As String = DefaultValue + Dim oControl = oControls.AddTextBox(oControlName, oControlPosition, VORBELGUNG, oDataType) + If Not IsNothing(oControl) Then + pnlIndex.Controls.Add(oControl) + End If + End If + End If + Case "DATE" + Dim oPicker = oControls.AddDateTimePicker(oControlName, oControlPosition, oDataType, DefaultValue) + pnlIndex.Controls.Add(oPicker) + + Case Else + If My.Application.User.Language = "de-DE" Then + MsgBox("Bitte überprüfen Sie den Datentyp des hinterlegten Indexwertes!", MsgBoxStyle.Critical, "Achtung:") + Else + MsgBox("Please check Datatype of Indexvalue!", MsgBoxStyle.Critical, "Warning:") + End If + + _Logger.Warn(" - Datentyp nicht hinterlegt - LoadIndexe_Man") + End Select + + oControlCount += 1 + oLabelPosition += 50 + oControlPosition += 50 + 'make y as height in fom + Next + Dim oPanelHeight = oControlPosition - 30 + + If pnlIndex.Height < oPanelHeight Then + If (Me.Height - 315) < oPanelHeight Then + Me.Height = (Me.Height - 315) + oPanelHeight + End If + pnlIndex.Height = oPanelHeight + End If + + SendKeys.Send("{TAB}") + Catch ex As Exception + _Logger.Error(ex) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in LoadIndexe_Man:") + End Try + End Sub + Function GetPlaceholderValue(InputValue As String, FileName As String, UserShortName As String) As String + Dim oResult As String + + Try + Select Case InputValue.ToString.ToUpper + Case "$filename_ext".ToUpper + oResult = Path.GetFileName(FileName) + Case "$filename".ToUpper + oResult = Path.GetFileNameWithoutExtension(FileName) + Case "$extension".ToUpper + oResult = Path.GetExtension(FileName).Replace(".", "") + Case "$FileCreateDate".ToUpper + Dim oFileInfo As New FileInfo(FileName) + Dim oCreationDate As Date = oFileInfo.CreationTime + oResult = oCreationDate.ToShortDateString + Case "$FileCreatedWho".ToUpper + Dim oFileSecurity As FileSecurity = File.GetAccessControl(FileName) + Dim oSecurityId As IdentityReference = oFileSecurity.GetOwner(GetType(SecurityIdentifier)) + Dim oNTAccount As IdentityReference = oSecurityId.Translate(GetType(NTAccount)) + Dim oOwner As String = oNTAccount.ToString() + oResult = oOwner + Case "$DateDDMMYYY".ToUpper + oResult = System.DateTime.Now.ToShortDateString + Case "$Username".ToUpper + oResult = Environment.UserName + Case "$Usercode".ToUpper + oResult = UserShortName + Case Else + oResult = InputValue + End Select + Catch ex As Exception + _Logger.Warn("Error in ReplacePlaceholders: " & ex.Message) + _Logger.Error(ex.Message) + oResult = Nothing + End Try + + Return oResult + End Function + + Private Sub frmGlobix_Index_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing + If File.Exists(My.Application.Globix.CURRENT_FILENAME) Then + Select Case CancelAttempts + Case 0 + If My.Application.User.Language = "de-DE" Then + MsgBox("Bitte indexieren Sie die Datei vollständig!" & vbNewLine & "(Abbruch 1 des Indexierungsvorgangs)", MsgBoxStyle.Information) + Else + MsgBox("Please Index file completely" & vbNewLine & "(Abort 1 of Indexdialog)", MsgBoxStyle.Information) + End If + CancelAttempts = CancelAttempts + 1 + e.Cancel = True + Case 1 + Dim result As MsgBoxResult + If My.Application.User.Language = "de-DE" Then + result = MessageBox.Show("Sie brechen nun zum zweiten Mal den Indexierungsvorgang ab!" & vbNewLine & "Wollen Sie die Indexierung aller Dateien abbrechen?", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) + Else + result = MessageBox.Show("You abort the indexdialog for the 2nd time!" & vbNewLine & "Do You want to abort indexing?", "Confirmation needed:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) + End If + + If result = MsgBoxResult.Yes Then + Dim containsfw_file As Boolean = False + Try + My.Application.Globix.ABORT_INDEXING = True + Dim sql As String = "SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')" + Dim DT As DataTable = My.Database.GetDatatable(sql) + + Dim anz = DT.Rows.Count + For Each Filerow As DataRow In DT.Rows + Dim filestring As String = Filerow.Item("FILENAME2WORK") + Dim handletype As String = Filerow.Item("HANDLE_TYPE") + + If handletype = "|MSGONLY|" Or handletype = "|ATTMNTEXTRACTED|" Then + Try + System.IO.File.Delete(filestring) + Catch ex As Exception + + End Try + + ElseIf handletype.StartsWith("|FW") Then + containsfw_file = True + End If + Next + 'Zuerst die Daten des Ablaufs löschen + If My.Database.ExecuteNonQuery("DELETE FROM TBGI_FILES_USER WHERE UPPER(USER@WORK) = UPPER('" & Environment.UserName & "')") = True Then + If containsfw_file = True Then + If My.Application.User.Language = "de-DE" Then + MsgBox("Der Indexierungsprozess beinhaltete (auch) Dateien per Folderwatch!" & vbNewLine & "Diese Dateien wurden nicht gelöscht und verbleiben im Folderwatch-Verzeichnis!" & vbNewLine & "Bitte verschieben Sie die Dateien ggfls.", MsgBoxStyle.Information, "Achtung - Hinweis:") + Else + MsgBox("The Indexingprocess contained (also) files from folderwatch!" & vbNewLine & "These files weren't deleted and will stay in the folderwatch-folder!" & vbNewLine & "Please move these files manually.", MsgBoxStyle.Information, "Achtung - Hinweis:") + End If + + End If + End If + + + Catch ex As Exception + _Logger.Error(ex) + MsgBox("Unexpected Error in Abort Indexing: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) + End Try + + Try + My.Application.Globix.INDEXING_ACTIVE = False + + DocumentViewer1.CloseDocument() + DocumentViewer1.Done() + clswindowLocation.SaveFormLocationSize(Me) + My.Settings.Save() + Catch ex As Exception + _Logger.Info(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") + End Try + + e.Cancel = False + Else + e.Cancel = True + End If + Case Else + Try + My.Application.Globix.INDEXING_ACTIVE = False + + DocumentViewer1.CloseDocument() + DocumentViewer1.Done() + clswindowLocation.SaveFormLocationSize(Me) + My.Settings.Save() + Catch ex As Exception + _Logger.Warn(" - Unexpected error in Schliessen des Formulares - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Schliessen des Formulares:") + End Try + End Select + Else + My.Application.Globix.INDEXING_ACTIVE = False + End If + End Sub + + Private Sub BarButtonItem1_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem1.ItemClick + Pre_Work_File + End Sub + Private Sub Pre_Work_File() + ClearError() + ClearNotice() + + Me.Cursor = Cursors.WaitCursor + Refresh_RegexTable() + For Each rowregex As DataRow In My.Application.BASE_DATA_DT_REGEX.Rows + If rowregex.Item("FUNCTION_NAME").ToString = "CLEAN_FILENAME" Then + My.Application.Globix.REGEX_CLEAN_FILENAME = rowregex.Item("REGEX").ToString + End If + Next + If chkMultiindexing.Checked = True And chkMultiindexing.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Then + 'Die erste Datei indexieren + If Work_File() = True Then + 'Und nun die folgenden + Dim DTFiles2Work As DataTable = My.Database.GetDatatable("SELECT * FROM TBGI_FILES_USER WHERE WORKED = 0 AND GUID <> " & My.Application.Globix.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 + My.Application.Globix.CURRENT_WORKFILE_GUID = filerow.Item("GUID") + My.Application.Globix.CURRENT_WORKFILE = filerow.Item("FILENAME2WORK") + DropType = filerow.Item("HANDLE_TYPE") + + If Work_File() = False Then + err = True + Exit For + End If + Next + Me.Cursor = Cursors.Default + If err = False Then + If My.Application.User.Language = "de-DE" Then + MsgBox("Alle Dateien wurden mit Multiindexing erfolgreich verarbeitet!", MsgBoxStyle.Information, "Erfolgsmeldung:") + Else + MsgBox("All files were successfully processed through Multiindexing", MsgBoxStyle.Information, "Success") + End If + + 'DTACTUAL_FILES.Clear() + + DocumentViewer1.CloseDocument() + DocumentViewer1.Done() + + CancelAttempts = 2 + Me.Close() + End If + End If + End If + Else + If Work_File() = True Then + Me.Cursor = Cursors.Default + If My.Application.Globix.ShowIndexResult = True Then + If My.Application.User.Language = "de-DE" Then + MsgBox("Die Datei wurde erfolgreich verarbeitet!" & vbNewLine & "Ablagepfad:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Erfolgsmeldung") + Else + MsgBox("File sucessfully processed!" & vbNewLine & "Path:" & vbNewLine & My.Application.Globix.CURRENT_NEWFILENAME, MsgBoxStyle.Information, "Success") + End If + End If + + DocumentViewer1.CloseDocument() + DocumentViewer1.Done() + + CancelAttempts = 2 + Me.Close() + End If + End If + Me.Cursor = Cursors.Default + End Sub + Private Function WORK_FILE() + Try + + Dim oSQL = $"SELECT * FROM VWDDINDEX_MAN WHERE DOK_ID = {Me.cmbDoctype.SelectedValue}" + My.Application.Globix.CURR_MAN_INDEXE = My.Database.GetDatatable(oSQL) + oSQL = $"SELECT * FROM VWDDINDEX_MAN WHERE VWDDINDEX_AUTOM WHERE DOCTYPE_ID = {Me.cmbDoctype.SelectedValue}" + My.Application.Globix.CURR_AUTO_INDEXE = My.Database.GetDatatable(oSQL) + + _Logger.Debug("Manuelle Indexe geladen") + + If My.Application.Globix.CURR_MAN_INDEXE.Rows.Count > 0 Then + My.Application.Globix.CURRENT_DOCTYPE_ID = Me.cmbDoctype.SelectedValue + If CheckWrite_IndexeMan(Me.cmbDoctype.SelectedValue) = True Then + '##### Manuelle Indexe indexiert ##### + _Logger.Info("Datei [" & My.Application.Globix.CURRENT_WORKFILE & "] wird nun indexiert...") + If FillIndexe_Autom(Me.cmbDoctype.SelectedValue) = True Then + _Logger.Debug(" ...FillIndexe_Autom durchlaufen") + + 'Den Zielnamen zusammenbauen + If Name_Generieren() = True Then + 'Dokumentenviewer ausblenden um keinen Zugriffsfehler zu produzieren + DocumentViewer1.Done() + DocumentViewer1.CloseDocument() + + _Logger.Debug(" ...Viewer geschlossen") + 'Die Datei verschieben + If Move_File2_Target() = True Then + _Logger.Debug(" ...Move_File2_Target durchlaufen") + My.Application.Globix.CURRENT_LASTDOCTYPE = cmbDoctype.Text + _Logger.Info("Datei '" & My.Application.Globix.CURRENT_NEWFILENAME & "' erfolgreich erzeugt.") + Dim oDEL As String = "DELETE FROM TBGI_FILES_USER WHERE GUID = " & My.Application.Globix.CURRENT_WORKFILE_GUID + My.Database.ExecuteNonQuery(oDEL) + Return True + End If + + Else + If My.Application.User.Language = "de-DE" Then + MsgBox("Unerwarteter Fehler in Name_Generieren - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) + Else + MsgBox("Unexpected error in Name_Generieren - Please check the Logfile", MsgBoxStyle.Critical) + End If + Return False + End If + Else + If My.Application.User.Language = "de-DE" Then + MsgBox("Unerwarteter Fehler in FillIndexe_Autom - Bitte überprüfen sie die Logdatei", MsgBoxStyle.Critical) + Else + MsgBox("Unexpected error in FillIndexe_Autom - Please check the Logfile", MsgBoxStyle.Critical) + End If + Return False + End If + '#### Automatische Werte indexieren #### + End If + Else + If My.Application.User.Language = "de-DE" Then + MsgBox("Bitte überprüfen Sie die Konfiguration dieser Dokumentart." & vbNewLine & "Es sind KEINE manuellen Indizes konfiguriert oder aktiv geschaltet!", MsgBoxStyle.Exclamation) + Else + MsgBox("Please check the configuration for this document-type." & vbNewLine & "There are NO manual indicies that are either configured or set to active!", MsgBoxStyle.Exclamation) + End If + Return False + End If + Catch ex As Exception + _Logger.Error(ex) + MsgBox("Unexpected Error in WORK_FILE:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) + Return False + End Try + End Function + Private Function Move_File2_Target() + Dim oError As Boolean + Try + Dim oSQL As String = "SELECT FOLDER_FOR_INDEX FROM TBDD_DOKUMENTART WHERE GUID = " & My.Application.Globix.CURRENT_DOCTYPE_ID + Dim oFolderForIndex = My.Database.GetScalarValue(oSQL) + If Not IsDBNull(oFolderForIndex) Then + CreateFolderForIndex(oFolderForIndex) + Else + CreateFolderForIndex(String.Empty) + End If + + + Dim oExportSuccessful As Boolean = False + 'Variable Folder + If DropType = "|DROPFROMFSYSTEM|" Or DropType = "|OUTLOOK_ATTACHMENT|" Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|FW_SIMPLEINDEXER|" Then + oExportSuccessful = SINGLEFILE_2_IDB(My.Application.Globix.CURRENT_BusinessEntity) + ElseIf DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or DropType = "|FW_OUTLOOK_MESSAGE|" Then + oExportSuccessful = SINGLEFILE_2_IDB(My.Application.Globix.CURRENT_BusinessEntity) + End If + If oExportSuccessful = True Then + 'Kein Fehler in Export2windream + oError = False + If Write_Indizes() = True Then + 'Kein Fehler in Setzen der windream-Indizes + Dim Insert_String As String + Try + Dim tempCur_WF = My.Application.Globix.CURRENT_WORKFILE.Replace("'", "''") + Dim tempCur_New_FN = My.Application.Globix.CURRENT_NEWFILENAME.Replace("'", "''") + Insert_String = sql_history_INSERT_INTO & ",ADDED_WHO) VALUES ('" & tempCur_WF & "','" & tempCur_New_FN & "'" & sql_history_Index_Values & ",'" & Environment.UserDomainName & "\" & Environment.UserName & "')" + My.Database.ExecuteNonQuery(Insert_String) + If DropType.Contains("MSG") Or DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then + If My.Application.Globix.CURRENT_MESSAGEID <> "" Then + Dim max As String = "SELECT MAX(GUID) FROM TBGI_HISTORY" + Dim GUID = My.Database.ExecuteNonQuery(max) + Try + If GUID > 0 Then + Dim sqlUpdate As String + If DropType = "|ATTMNTEXTRACTED|" Or DropType = "|OUTLOOK_ATTACHMENT|" Then + sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 1, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID + My.Database.ExecuteNonQuery(sqlUpdate) + Else + sqlUpdate = "Update TBGI_HISTORY SET ATTACHMENT = 0, MSG_ID = '" & My.Application.Globix.CURRENT_MESSAGEID & "' WHERE GUID = " & GUID + My.Database.ExecuteNonQuery(sqlUpdate) + End If + End If + Catch ex As Exception + _Logger.Error(ex) + End Try + End If + End If + + Catch ex As Exception + _Logger.Error(ex) + MsgBox("Error in Insert-History - View logfile: " & ex.Message, MsgBoxStyle.Critical) + _Logger.Warn(" - Unexpected error in Insert-History - Fehler: " & vbNewLine & ex.Message) + _Logger.Warn(" - Unexpected error in Insert-History - SQL: " & Insert_String) + oError = True + End Try + Else + oError = True + End If + Else + oError = True + + If My.Application.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 + + If oError = False Then + Return True + Else + 'Fehler aufgetreten + Return False + End If + Catch ex As Exception + _Logger.Error(ex) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected Error in Move File2Target:") + Return False + End Try + End Function + Private Function Write_Indizes() + 'Try + Dim indexierung_erfolgreich As Boolean = False + 'Manuelle Indexe Indexieren + + ' If My.Application.Globix.CURR_MAN_INDEXE.Rows.Count > 0 Then + ' Dim Count As Integer = 0 + ' For Each row As DataRow In DTMan.Rows + ' Dim idxvalue = row.Item("Indexwert") + ' Dim indexname = row.Item("WD_INDEX").ToString + ' _Logger.Debug($"Write_Indizes - Index [{indexname}]...") + ' Dim optional_Index = CBool(row.Item("OPTIONAL")) + ' Dim indexiert = CBool(row.Item("Indexiert")) + ' If indexiert And idxvalue.ToString <> "" And idxvalue <> "EMPTY_OI" Then + ' If indexname <> String.Empty Then + ' If row.Item("SAVE_VALUE") = True Then + ' 'Den Indexwert zwischenspeichern + ' Dim DTTemp As DataTable = MyDataset.TBTEMP_INDEXRESULTS + ' Dim rowexists As Boolean = False + ' For Each rowTemp As DataRow In DTTemp.Rows + ' 'Wenn bereits ein Eintrag existiert..... + ' If rowTemp.Item("Dokumentart") = row.Item("DOKUMENTART") And rowTemp.Item("Indexname") = row.Item("INDEXNAME") Then + ' rowexists = True + ' '......überschreiben + ' rowTemp.Item("Value") = row.Item("Indexwert") + ' End If + ' Next + ' '.....ansonsten neu anlegen + ' If rowexists = False Then + ' Dim newRow As DataRow = DTTemp.NewRow() + ' newRow("Dokumentart") = row.Item("DOKUMENTART").ToString + ' newRow("Indexname") = row.Item("INDEXNAME").ToString + ' newRow("Value") = row.Item("Indexwert") + ' DTTemp.Rows.Add(newRow) + ' End If + ' End If + + ' _Logger.Debug($"Manueller Indexvalue [{idxvalue.ToString}]...NOW THE INDEXING...") + ' Count += 1 + + + ' ' den Typ des Zielindexes auslesen + ' Dim oIndexType As Integer = WINDREAM.GetIndexType(indexname) + ' _Logger.Debug($"oIndexType [{oIndexType.ToString}]...") + ' If oIndexType < WINDREAM.WMObjectVariableValueTypeVector Then + ' _Logger.Debug($"Indexing oIndexType < WINDREAM.WMObjectVariableValueTypeVector...") + ' indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, idxvalue, CURR_DOKART_OBJECTTYPE) + ' Else + ' Dim oSplitArray = Split(idxvalue, ClassConstants.VECTORSEPARATOR) + ' Dim oListofString As New List(Of String) + ' If oSplitArray.Count = 0 Then + ' oListofString.Add(idxvalue) + ' Else + ' For Each oStr In oSplitArray + ' oListofString.Add(oStr) + ' Next + ' End If + + + ' indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) + ' End If + + ' 'indexierung_erfolgreich = ClassWindream.DateiIndexieren(CURRENT_NEWFILENAME, indexname, idxvalue) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in Indexing file - See log", MsgBoxStyle.Critical) + ' Return False + ' Exit For + ' End If + ' Else + + ' _Logger.Debug("No Indexing: indexname: " & indexname) + ' _Logger.Debug("No Indexing: is optional? " & optional_Index.ToString) + ' End If + ' Else + ' _Logger.Debug("Indexvalue is empty or field is not indexed - Indexname: " & indexname) + ' _Logger.Info("Indexvalue is empty or field is not indexed - Indexname: " & indexname) + ' End If + ' Next + + ' End If + ' 'Automatische Indexe Indexieren + + ' If My.Application.Globix.CURR_AUTO_INDEXE.Rows.Count > 0 Then + ' Dim Count As Integer = 0 + ' For Each row As DataRow In My.Application.Globix.CURR_AUTO_INDEXE.Rows + ' Dim indexiert = CBool(row.Item("Indexiert")) + ' Dim Indexvalue = row.Item("Indexwert").ToString + ' Dim indexname = row.Item("INDEXNAME").ToString + ' If indexiert = True And Indexvalue <> "" Then + ' If Indexvalue <> "EMPTY_OI" Then + ' _Logger.Info("Auto Indexname: " & indexname.ToString) + ' _Logger.Info("Indexvalue: " & Indexvalue.ToString) + ' Count += 1 + + ' ' den Typ des Zielindexes auslesen + ' Dim indexType As Integer = WINDREAM.GetIndexType(indexname) + + ' If indexType < WINDREAM.WMObjectVariableValueTypeVector Then + ' indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) + ' Else + ' Dim oSplitArray = Split(Indexvalue, ClassConstants.VECTORSEPARATOR) + ' Dim oListofString As New List(Of String) + ' If oSplitArray.Count = 0 Then + ' oListofString.Add(Indexvalue) + ' Else + ' For Each oStr In oSplitArray + ' oListofString.Add(oStr) + ' Next + ' End If + ' indexierung_erfolgreich = WINDREAM.SetFileIndex(My.Application.Globix.CURRENT_NEWFILENAME, indexname, oListofString, CURR_DOKART_OBJECTTYPE) + ' End If + + ' 'indexierung_erfolgreich = WINDREAM.SetFileIndex(CURRENT_NEWFILENAME, indexname, Indexvalue, CURR_DOKART_OBJECTTYPE) + ' If indexierung_erfolgreich = False Then + ' MsgBox("Error in indexing file - See log", MsgBoxStyle.Critical) + ' Return False + ' Exit For + ' End If + ' End If + ' End If + ' Next + ' End If + ' If DropType = "|OUTLOOK_MESSAGE|" Or DropType = "|FW_MSGONLY|" Or DropType = "|MSGONLY|" Or My.Application.Globix.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 + ' _Logger.Warn("Unexpected error in Write_Indizes - Fehler: " & vbNewLine & ex.Message) + ' _Logger.Error(ex.Message) + ' MsgBox("Error in Write_Indizes:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) + ' Return False + 'End Try + Return True + End Function + Private Function SINGLEFILE_2_IDB(pBusinessEntity As String) As Boolean + Try + 'CURR_DOKART_OBJECTTYPE = _Objekttyp + 'Dim oWMCheckPath = WINDREAM.VersionWMFilename(My.Application.Globix.CURRENT_NEWFILENAME, System.IO.Path.GetExtension(My.Application.Globix.CURRENT_NEWFILENAME)) + 'If CURRENT_NEWFILENAME.ToUpper <> oWMCheckPath.ToString.ToUpper Then + ' _Logger.Info($"Target [{My.Application.Globix.CURRENT_NEWFILENAME}] already existed!! - NewWMFilename [{oWMCheckPath}]") + ' My.Application.Globix.CURRENT_NEWFILENAME = oWMCheckPath + 'End If + + 'Dim oStreamSuccessful = WINDREAM.NewFileStream(My.Application.Globix.CURRENT_WORKFILE, My.Application.Globix.CURRENT_NEWFILENAME) + 'Dim oTempPath As String = Path.Combine("\\windream\objects", My.Application.Globix.CURRENT_NEWFILENAME) + + '_Logger.Debug("Checks for file [{0}]", oTempPath) + '_Logger.Debug("File streamed to Windream: {0}", oStreamSuccessful) + '_Logger.Debug("File exists in Destination: {0}", File.Exists(oTempPath)) + '_Logger.Debug("File should be deleted: {0}", My.Application.Globix.CURR_DELETE_ORIGIN) + + 'If File.Exists(oTempPath) And oStreamSuccessful Then + ' If My.Application.Globix.CURR_DELETE_ORIGIN = True Then + ' Try + ' My.Computer.FileSystem.DeleteFile(My.Application.Globix.CURRENT_WORKFILE) + ' Catch ex As Exception + ' _Logger.Error(ex) + ' End Try + ' End If + 'End If + + 'Return oStreamSuccessful + Catch ex As Exception + _Logger.Error(ex) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in SINGLEFILE_2_WINDREAM:") + Return False + End Try + End Function + Private Function CreateFolderForIndex(DynamicFolderConfig As String) + Try + Dim oRootFolder As String = Path.GetDirectoryName(My.Application.Globix.CURRENT_NEWFILENAME) + Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) + + + If DynamicFolderConfig <> String.Empty Then + '###### + Dim oRegexString As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" + ' einen Regulären Ausdruck laden + Dim oRegex As Regex = New Regex(oRegexString) + ' die Vorkommen im Folder-String auslesen + Dim oMatches As MatchCollection = oRegex.Matches(DynamicFolderConfig) + '#### + + ' alle Vorkommen innerhalb des Ordnerstrings durchlaufen + For Each oMatch As Match In oMatches + _Logger.Info("Elementname in FolderString: '" & oMatch.ToString & "'") + Select Case oMatch.Value.Substring(2, 1).ToUpper + + 'Manueller Indexwert + Case "M" + Dim oManIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) + + 'Dim oIsOptional As Boolean = ClassDatabase.Execute_Scalar("SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND UPPER(NAME) = UPPER('" & oManIndexName & "')", MyConnectionString, True) + Dim oIsOptional As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, $"DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND INDEXNAME = '{oManIndexName}'", "OPTIONAL")) + _Logger.Info("Versuch den Indexwert aus '" & oManIndexName & "' auszulesen.") + Dim oManIndexValue As String = GetManIndex_Value(oManIndexName, "FILE", oIsOptional) + _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oManIndexName & "'") + If Not oManIndexValue = String.Empty Then + If IsDate(oManIndexValue) Then + oManIndexValue = CDate(oManIndexValue).ToString("yyyyMMdd") + End If + + oManIndexValue = oFilesystem.GetCleanPath(oManIndexValue) + 'oManIndexValue = ClassFilehandle.CleanFilename(oManIndexValue, "") + DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oManIndexValue) + + _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") + Else + + If oIsOptional = True Then + _Logger.Info("Optionaler Indexwert ist NICHT gefüllt") + DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, String.Empty) + Else + _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") + Return True + End If + End If + Case "A" + Dim oAutoIndexName = oMatch.Value.Substring(3, oMatch.Value.Length - 4) + _Logger.Info("Versuch den Auto-Indexwert aus '" & oAutoIndexName & "' auszulesen.") + Dim oAutoIndexValue As String = GetAutoIndex_Value(oAutoIndexName) + _Logger.Info("Ergebnis/Wert für neuen Ordner: '" & oAutoIndexName & "'") + If Not oAutoIndexValue = String.Empty Then + + oAutoIndexValue = oFilesystem.GetCleanPath(oAutoIndexValue) + 'oAutoIndexValue = ClassFilehandle.CleanFilename(oAutoIndexValue, "") + If oAutoIndexValue = "EMPTY_OI" Then + DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, "") + Else + DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oAutoIndexValue) + _Logger.Info("FolderPattern: '" & DynamicFolderConfig & "'") + End If + + Else + _Logger.Info(" - Achtung Ausnahme in 'CrFolderForIndex': der Index ist leer!") + End If + Case "V" + Dim oElementTemp As String + Dim _Month As String = My.Computer.Clock.LocalTime.Month + If _Month.Length = 1 Then + _Month = "0" & _Month + End If + Dim _day As String = My.Computer.Clock.LocalTime.Day + If _day.Length = 1 Then + _day = "0" & _day + End If + Dim type = oMatch.Value.Substring(3, oMatch.Value.Length - 4) + If type.StartsWith("_") Then + type = type.Replace("_", "") + End If + Select Case type + Case "YYYY/MM/DD" + oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month & "\" & _day + Case "YYYY/MM" + oElementTemp = My.Computer.Clock.LocalTime.Year & "\" & _Month + Case "YYYY" + oElementTemp = My.Computer.Clock.LocalTime.Year + Case "YYYY-MM" + oElementTemp = My.Computer.Clock.LocalTime.Year & "-" & _Month + End Select + DynamicFolderConfig = DynamicFolderConfig.Replace(oMatch.ToString, oElementTemp) + _Logger.Info("FolderPatter nach V-Element: '" & DynamicFolderConfig & "'") + Case Else + _Logger.Warn(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper) + + If My.Application.User.Language = "de-DE" Then + MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") + Else + MsgBox("Attention - One element in Namingconvention could not be matched!" & vbNewLine & "Elementname: " & oMatch.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") + End If + End Select + Next + End If + + + + + _Logger.Info("Den Root-Folder zusammenfügen>> ") + + Dim oNewFullPath As String = System.IO.Path.Combine(oRootFolder, DynamicFolderConfig) + + _Logger.Info("Fullpath (mit evtl. Sonderzeichen (SZ)) '" & oNewFullPath & "'") + Dim invalidPathChars() As Char = Path.GetInvalidPathChars() + For Each sonderChar As Char In invalidPathChars + 'Sonderzeichen ausser Whitespace entfernen + If Char.IsWhiteSpace(sonderChar) = False Then + If oNewFullPath.Contains(sonderChar) Then + oNewFullPath = oNewFullPath.Replace(sonderChar, "") + End If + End If + Next sonderChar + 'oNewFullPath = WINDREAM.GetCleanedPath(oNewFullPath) + + _Logger.Info("Fullpath (ohne SZ) '" & oNewFullPath & "'") + If Directory.Exists(oNewFullPath) = False Then + Try + Dim oCreatedPath = Directory.CreateDirectory(oNewFullPath) + oNewFullPath = oCreatedPath.FullName + _Logger.Info("Folder '" & oNewFullPath & "' wurde angelegt") + Catch ex As Exception + _Logger.Info("Error in CreateFolderforIndex-Method - Root Folder '" & oNewFullPath & "' could not be created. " & ex.Message) + _Logger.Error(ex.Message) + MsgBox("Attention: Root Folder '" & oNewFullPath & "' could not be created." & vbNewLine & ex.Message, MsgBoxStyle.Critical) + Return False + End Try + End If + + My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oNewFullPath, Path.GetFileName(My.Application.Globix.CURRENT_NEWFILENAME)) + + Return True + Catch ex As Exception + MsgBox("Unexpected Error in CreateFolderforIndex-Method:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) + _Logger.Warn("Fehler in CrFolderForIndex: " & ex.Message) + _Logger.Error(ex) + Return False + End Try + End Function + Private Function Filter_Datatable(pDatatable As DataTable, pFilter As String, pColResult As String) As Object + Try + Dim oreturn As Object + Dim odv As DataView = New DataView(pDatatable) + odv.RowFilter = pFilter + Dim dr2 As DataRow() = pDatatable.Select(pFilter) + + For Each row As DataRow In dr2 + oreturn = row.Item(pColResult) + Exit For + Next + Return oreturn + Catch ex As Exception + Return Nothing + End Try + End Function + + Function CheckWrite_IndexeMan(dokartid As Integer) As Boolean + '#### Zuerst manuelle Werte indexieren #### + Try + _Logger.Info("In CheckWrite_IndexeMan") + Dim result As Boolean = False + For Each oControl As Control In Me.pnlIndex.Controls + ' MsgBox(ctrl.Name) + If oControl.Name.StartsWith("txt") Then + Dim box As DevExpress.XtraEditors.TextEdit = oControl + If box.Text = "" Then + Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(box.Name, "txt", ""), "OPTIONAL")) + '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(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, "Fehlende Eingabe:") + box.Focus() + Return False + Else + Indexwert_Postprocessing(Replace(box.Name, "txt", ""), "") + result = True + End If + Else + If Indexwert_checkValueDB(Replace(box.Name, "txt", ""), box.Text) = False Then + _Logger.Info(" - Der eingegebene Wert wurde nicht in der Datenbank gefunden") + MsgBox("Der eingegebene Wert wurde nicht in der Datenbank gefunden!", MsgBoxStyle.Exclamation, "Fehlerhafte Indexierung:") + box.Focus() + Return False + Else + Indexwert_Postprocessing(Replace(box.Name, "txt", ""), box.Text) + result = True + End If + End If + End If + + If oControl.Name.StartsWith("cmbMulti") Then + Dim oLookup = DirectCast(oControl, 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) + Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(oLookup.Name, "cmbMulti", ""), "OPTIONAL")) + If optional_index = False Then + MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) + oLookup.Focus() + Return False + Else + Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), "") + result = True + End If + Else + Dim vectorValue = String.Join(VECTORSEPARATOR, values) + Indexwert_Postprocessing(Replace(oLookup.Name, "cmbMulti", ""), vectorValue) + result = True + End If + ElseIf oControl.Name.StartsWith("cmbSingle") Then + Dim cmbSingle As TextBox = oControl + + If cmbSingle.Text = "" Then + 'Dim 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) + Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(cmbSingle.Name, "cmbSingle", ""), "OPTIONAL")) + If optional_index = False Then + MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) + cmbSingle.Focus() + Return False + Else + Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), "") + result = True + End If + Else + Indexwert_Postprocessing(Replace(cmbSingle.Name, "cmbSingle", ""), cmbSingle.Text) + result = True + End If + ElseIf oControl.Name.StartsWith("cmb") Then + Dim cmb As ComboBox = oControl + If cmb.Text = "" Then + 'Dim 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) + Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '" & Replace(cmb.Name, "cmb", ""), "OPTIONAL")) + If optional_index = False Then + MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) + cmb.Focus() + Return False + Else + Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), "") + result = True + End If + Else + Indexwert_Postprocessing(Replace(cmb.Name, "cmb", ""), cmb.Text) + result = True + End If + End If + If oControl.Name.StartsWith("dtp") Then + Dim dtp As DevExpress.XtraEditors.DateEdit = oControl + Dim oIndexName As String = Replace(dtp.Name, "dtp", "") + + If dtp.Text = String.Empty Then + 'Dim optional_index As Boolean = My.Database.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {dokartid} And NAME = '{oIndexName}'", MyConnectionString, True) + Dim optional_index As Boolean = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & dokartid & " AND INDEXNAME = '{oIndexName}'", "OPTIONAL")) + + If optional_index = False Then + MsgBox(TEXT_MISSING_INPUT, MsgBoxStyle.Exclamation, Text) + dtp.Focus() + Return False + Else + Indexwert_Postprocessing(oIndexName, "") + result = True + End If + Else + Indexwert_Postprocessing(Replace(dtp.Name, "dtp", ""), dtp.Text) + result = True + End If + End If + If oControl.Name.StartsWith("chk") Then + Dim chk As CheckBox = oControl + Indexwert_Postprocessing(Replace(chk.Name, "chk", ""), chk.Checked) + result = True + End If + If TypeOf (oControl) Is Button Then + Continue For + End If + If oControl.Name.StartsWith("lbl") = False And result = False Then + _Logger.Info("Die Überprüfung der manuellen Indices ist fehlerhaft. Bitte informieren Sie den Systembetreuer") + Return False + End If + Next + + Return True + Catch ex As Exception + _Logger.Warn(" - Unvorhergesehener Fehler in CheckWrite_IndexeMan - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unerwarteter Unexpected error in CheckWrite_IndexeMan:") + Return False + End Try + End Function + Sub Indexwert_Postprocessing(indexname As String, wert_in As String) + Try + + Dim value_post As String = "" + For Each oRowManIndex As DataRow In My.Application.Globix.CURR_MAN_INDEXE.Rows + If oRowManIndex.Item("INDEXNAME") = indexname Then + Dim idxid As Integer = oRowManIndex.Item("GUID") + If idxid > 0 Then + ' In jedem Fall schon mal den Wert einfügen + oRowManIndex.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 = My.Database.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'ONLY FILE/FOLDER' ORDER BY SEQUENCE") + If DTNB Is Nothing = False Then + If DTNB.Rows.Count > 0 Then + value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) + oRowManIndex.Item("Indexwert") = wert_in + oRowManIndex.Item("Indexwert_File") = value_post + End If + End If + 'Jetzt die Fälle für die Variante FILE AND INDEX + DTNB = Nothing + DTNB = My.Database.GetDatatable("SELECT * FROM TBDD_INDEX_MAN_POSTPROCESSING WHERE IDXMAN_ID = " & idxid & " AND VARIANT = 'FILE AND INDEX' ORDER BY SEQUENCE") + If DTNB Is Nothing = False Then + If DTNB.Rows.Count > 0 Then + value_post = clsPostProcessing.Get_Nachbearbeitung_Wert(wert_in, DTNB) + oRowManIndex.Item("Indexwert") = value_post + End If + End If + End If + oRowManIndex.Item("Indexiert") = True + End If + Next + Catch ex As Exception + _Logger.Warn(" - Unvorhergesehener Unexpected error in Indexwert_Postprocessing - Indexname: " & indexname & " - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Indexwert_Postprocessing:") + End Try + End Sub + Function Name_Generieren() + Try + _Logger.Debug("#### Name_Generieren ####") + Dim sql As String = "select VERSION_DELIMITER, FILE_DELIMITER FROM TBDD_MODULES WHERE GUID = 1" + Dim oFilesystem As New DigitalData.Modules.Filesystem.File(_LogConfig) + Dim DT1 As DataTable = My.Database.GetDatatable(sql) + For Each row As DataRow In DT1.Rows + My.Application.Globix.FILE_DELIMITER = row.Item("FILE_DELIMITER") + My.Application.Globix.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(My.Application.Globix.CURRENT_WORKFILE) + Dim DT As DataTable = My.Database.GetDatatable("SELECT * FROM TBDD_DOKUMENTART WHERE GUID = " & My.Application.Globix.CURRENT_DOCTYPE_ID) + sql_history_INSERT_INTO = "INSERT INTO TBGI_HISTORY (FILENAME_ORIGINAL,FILENAME_NEW" + sql_history_Index_Values = "" + Dim AnzahlIndexe As Integer = 1 + 'CURR_DOKART_OBJECTTYPE = DT.Rows(0).Item("OBJEKTTYP") + My.Application.Globix.CURRENT_WORKFILE_EXTENSION = extension + + 'oRAWZielordner = WINDREAM.GetNormalizedPath(DT.Rows(0).Item("ZIEL_PFAD")) + oRAWZielordner = Path.Combine("\\windream\objects", oRAWZielordner) + + '#### + ' Regulären Ausdruck zum Auslesen der Indexe definieren + Dim preg As String = "\[%{1}[a-zA-Z0-9ß\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" + 'schonmal den gesamten Pfad laden + Dim oNamenkonvention As String = DT.Rows(0).Item("NAMENKONVENTION") & My.Application.Globix.CURRENT_WORKFILE_EXTENSION 'oRAWZielordner & "\" & DT.Rows(0).Item("NAMENKONVENTION") + NewFileString = oNamenkonvention + ' einen Regulären Ausdruck laden + Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) + ' die Vorkommen im SQL-String auslesen + Dim oMatchelements As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(oNamenkonvention) + '#### + If oMatchelements.Count = 0 Then + _Logger.Debug("No RegularExpression Fileds on Nameconvention!") + End If + ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen + For Each oElement As System.Text.RegularExpressions.Match In oMatchelements + Select Case oElement.Value.Substring(2, 1).ToUpper + 'Manueller Indexwert + Case "M" + _Logger.Debug("NameGenerieren: Manueller Index wird geprüft...") + Dim Indexname = oElement.Value.Substring(3, oElement.Value.Length - 4) + Dim optional_index As Boolean = My.Database.GetScalarValue($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND UPPER(NAME) = UPPER('{Indexname}')") + Dim oManValue As String = GetManIndex_Value(Indexname, "FILE", optional_index) + If oManValue <> String.Empty Then + Dim firstVectorValue = oManValue.Split("~").First() + + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, firstVectorValue) + NewFileString = oNamenkonvention + sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString + AnzahlIndexe += 1 + sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" + Else + + If optional_index = True Then + oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "-", "-") + oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "_", "_") + oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value & "-", "_") + oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value & "_", "-") + + oNamenkonvention = oNamenkonvention.Replace("-" & oElement.Value, "-") + oNamenkonvention = oNamenkonvention.Replace("_" & oElement.Value, "_") + oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "-", "-") + oNamenkonvention = oNamenkonvention.Replace(oElement.Value & "_", "_") + + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, oManValue) + + Dim oFilenameWithoutExtension = Path.GetFileNameWithoutExtension(oNamenkonvention) + Dim oExtension = Path.GetExtension(oNamenkonvention) + + If oFilenameWithoutExtension.EndsWith("-") Or oFilenameWithoutExtension.EndsWith("_") Then + oFilenameWithoutExtension = oFilenameWithoutExtension.Substring(0, oFilenameWithoutExtension.Count - 1) + End If + + NewFileString = oFilenameWithoutExtension & oExtension + sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString + AnzahlIndexe += 1 + sql_history_Index_Values = sql_history_Index_Values & ", '" & oManValue.Replace("'", "''") & "'" + Else + _Logger.Debug("Der Indexvalue für Index '" & Indexname & "' ist String.Empty") + err = True + End If + + End If + Case "A" + Dim value As String = GetAutoIndex_Value(oElement.Value.Substring(3, oElement.Value.Length - 4)) + If value <> String.Empty Then + If value = "EMPTY_OI" Then + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, "") + NewFileString = oNamenkonvention + Else + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, value) + NewFileString = oNamenkonvention + sql_history_INSERT_INTO = sql_history_INSERT_INTO & ", INDEX" & AnzahlIndexe.ToString + AnzahlIndexe += 1 + sql_history_Index_Values = sql_history_Index_Values & ", '" & value.Replace("'", "''") & "'" + End If + Else + err = True + End If + Case "V" + Dim datetemp As String + Dim _Month As String = My.Computer.Clock.LocalTime.Month + If _Month.Length = 1 Then + _Month = "0" & _Month + End If + Dim _day As String = My.Computer.Clock.LocalTime.Day + If _day.Length = 1 Then + _day = "0" & _day + End If + Dim type = oElement.Value '.ToUpper.Replace("[v%", "") + type = type.Replace("[%v_", "") + type = type.Replace("[%v", "") + type = type.Replace("]", "") + Select Case type + Case "YY_MM_DD" + datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & "_" & _Month & "_" & _day + Case "YYYY_MM_DD" + datetemp = My.Computer.Clock.LocalTime.Year & "_" & _Month & "_" & _day + Case "DD_MM_YY" + datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) + Case "DD_MM_YYYY" + datetemp = _day & "_" & _Month & "_" & My.Computer.Clock.LocalTime.Year + Case "YYMMDD" + datetemp = My.Computer.Clock.LocalTime.Year.ToString.Substring(2) & _Month & _day + Case "YYYYMMDD" + datetemp = My.Computer.Clock.LocalTime.Year & _Month & _day + Case "DDMMYY" + datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year.ToString.Substring(2) + Case "DDMMYYYY" + datetemp = _day & _Month & My.Computer.Clock.LocalTime.Year + Case "OFilename" + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, System.IO.Path.GetFileNameWithoutExtension(My.Application.Globix.CURRENT_WORKFILE)) + Case "Username".ToUpper + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, Environment.UserName) + Case "Usercode".ToUpper + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, My.Application.User.ShortName) + Case "" + End Select + If datetemp <> "" Then + oNamenkonvention = oNamenkonvention.Replace(oElement.Value, datetemp) + End If + NewFileString = oNamenkonvention + Case "[%Version]".ToUpper + Try + Dim version As Integer = 1 + Dim Stammname As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") + Dim _neuername As String = oRAWZielordner & "\" & oNamenkonvention.Replace(oElement.Value, "") + Stammname = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") + _neuername = _neuername.Replace(My.Application.Globix.VERSION_DELIMITER, "") + 'Dim MoveFilename As String = DATEINAME.Replace(element.Value, "") + 'Überprüfen ob File existiert + If File.Exists(_neuername) = False Then + NewFileString = _neuername + Else + Do While File.Exists(_neuername) + version = version + 1 + _neuername = Stammname.Replace(extension, "") & My.Application.Globix.VERSION_DELIMITER & version & extension + NewFileString = _neuername + Loop + End If + Catch ex As Exception + _Logger.Warn(" - Unexpected error in NameGenerieren - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected error in Umbenennnen der Datei:") + err = True + End Try + Case Else + _Logger.Info(" - Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper) + MsgBox("Achtung - in der Namenkonvention wurde ein Element gefunden welches nicht zugeordnet werden kann!" & vbNewLine & "Elementname: " & oElement.Value.ToUpper, MsgBoxStyle.Exclamation, "Unexpected error in Name generieren:") + End Select + Next + + My.Application.Globix.CURRENT_NEWFILENAME = oFilesystem.GetCleanFilename(NewFileString) + 'CURRENT_NEWFILENAME = ClassFilehandle.CleanFilename(NewFileString, "") + My.Application.Globix.CURRENT_NEWFILENAME = Path.Combine(oRAWZielordner, My.Application.Globix.CURRENT_NEWFILENAME) + + _Logger.Debug("#### ENDE Name_Generieren ####") + _Logger.Debug("") + If err = False Then + Return True + Else + Return False + End If + + Catch ex As Exception + _Logger.Warn(" - Unvorhergesehener Unexpected error in Name_Generieren - Fehler: " & vbNewLine & ex.Message) + _Logger.Error(ex.Message) + MsgBox(ex.Message, MsgBoxStyle.Critical, "Allgemeiner Unexpected error in Name_Generieren:") + Return False + End Try + + End Function + Function FillIndexe_Autom(dokart_id As Integer) As Boolean + Try + Dim oRegex As New Regex("\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}") + + If My.Application.Globix.CURR_AUTO_INDEXE.Rows.Count = 0 Then + Return True + End If + + ' 1. Schritt: Einfach-Indexe und Platzhalter ersetzen + For Each oAutoIndexRow As DataRow In My.Application.Globix.CURR_AUTO_INDEXE.Rows + _Logger.Info("Working on AutomaticIndex: " & oAutoIndexRow.Item("INDEXNAME").ToString & "...") + Dim oSqlResult As String = NotNull(oAutoIndexRow.Item("SQL_RESULT"), "") + Dim oSqlActive As Boolean = NotNull(oAutoIndexRow.Item("SQL_ACTIVE"), False) + Dim oSqlConnectionId As Integer = NotNull(oAutoIndexRow.Item("CONNECTION_ID"), -1) + Dim oSqlProvider As String = NotNull(oAutoIndexRow.Item("SQL_PROVIDER"), "") + Dim oEndResult As New List(Of String) + + ' Wenn kein SQL Befehl vorhanden oder aktiv ist, + ' versuchen wir, die Spalte VALUE zu ersetzen + If oSqlResult = String.Empty Or oSqlActive = 0 Then + Dim oPlaceholderResult As String + Dim oValue As String = NotNull(oAutoIndexRow.Item("VALUE"), "") + + oPlaceholderResult = GetPlaceholderValue(oValue, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) + + If Not IsNothing(oPlaceholderResult) Then + oValue = oPlaceholderResult + End If + + oAutoIndexRow.Item("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, My.Application.Globix.CURRENT_WORKFILE, My.Application.User.ShortName) + + ' Einfachen Platzhalter ersetzen + If Not IsNothing(oPlaceholderResult) Then + oSqlResult = oSqlResult.Replace(oMatch.Value, oPlaceholderResult) + End If + oOptionalIndex = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND INDEXNAME = '" & oIndexValue, "OPTIONAL")) + 'oOptionalIndex = ClassDatabase.Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_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("~") Then + oManualIndexResult = Nothing + End If + + If Not IsNothing(oManualIndexResult) Then + oSqlResult = oSqlResult.Replace(oMatch.Value, oManualIndexResult) + End If + Next + + + 'TODO: Replace Windream Patterns? + oSqlResult = clsPatterns.ReplaceControlValues(oSqlResult, pnlIndex) + oSqlResult = clsPatterns.ReplaceInternalValues(oSqlResult) + If oSqlResult <> String.Empty Then + _Logger.Debug("oSqlResult after Replace [" & oSqlResult & "]") + End If + ' Ergebnis: Es wurden alle einfachen Platzhalter ersetzt, jetzt haben wir einen SQL Befehl, + ' der nur noch vektorfelder-platzhalter enthält + + ' 2. Schritt: Vektorfelder ersetzen + Dim oVectorMatches As MatchCollection = oRegex.Matches(oSqlResult) + If oVectorMatches.Count > 0 Then + _Logger.Info(" There are " & oVectorMatches.Count & " matches for vectors!") + Dim oIsFirstMatch = True + + For Each oVectorMatch As Match In oVectorMatches + Dim oIndexValue As String = StripPlaceholder(oVectorMatch.Value) + Dim oOptionalIndex = False + Dim oManualIndexResult As String = Nothing + oOptionalIndex = CBool(Filter_Datatable(My.Application.Globix.CURR_MAN_INDEXE, "DOK_ID = " & My.Application.Globix.CURRENT_DOCTYPE_ID & " AND INDEXNAME = '" & oIndexValue, "OPTIONAL")) + 'oOptionalIndex = My.Database..Execute_Scalar($"SELECT OPTIONAL FROM TBDD_INDEX_MAN WHERE DOK_ID = {My.Application.Globix.CURRENT_DOCTYPE_ID} AND UPPER(NAME) = UPPER('{oIndexValue}')", MyConnectionString, True) + oManualIndexResult = GetManIndex_Value(oIndexValue, "IDX_AUTO", oOptionalIndex) + + Dim oVectorIndexValues = oManualIndexResult.Split("~").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("~", oEndResult.ToArray) + Next + Else + Dim oResult = GetAutomaticIndexSQLValue(oSqlResult, oSqlConnectionId, oSqlProvider) + _Logger.Info("Got a simple SQLResult: " & oResult.ToString) + oAutoIndexRow.Item("Indexiert") = True + oAutoIndexRow.Item("Indexwert") = oResult + + End If + Next + + Return True + Catch ex As Exception + _Logger.Error(ex) + MsgBox(ex.Message) + Return False + End Try + End Function + Function StripPlaceholder(Placeholder As String) As String + Dim oResult = Placeholder + oResult = Regex.Replace(oResult, "^\[%", "") + oResult = Regex.Replace(oResult, "\]$", "") + Return oResult + End Function End Class \ No newline at end of file diff --git a/Modules.Database/MSSQLServer.vb b/Modules.Database/MSSQLServer.vb index 3681a208..123b7f2b 100644 --- a/Modules.Database/MSSQLServer.vb +++ b/Modules.Database/MSSQLServer.vb @@ -49,6 +49,44 @@ Public Class MSSQLServer Return oConnectionStringBuilder.ToString End Function + Public Function Get_ConnectionStringforID(pID As Integer) + Dim connectionString As String = "" + Try + 'Me.TBCONNECTIONTableAdapter.FillByID(Me.DD_DMSLiteDataSet.TBCONNECTION, id) + Dim oDTConnection As DataTable = GetDatatable("SELECT * FROM TBDD_CONNECTION WHERE GUID = " & pID) + If oDTConnection.Rows.Count = 1 Then + Select Case oDTConnection.Rows(0).Item("SQL_PROVIDER").ToString.ToUpper + Case "MS-SQL" + If oDTConnection.Rows(0).Item("USERNAME") = "WINAUTH" Then + connectionString = "Server=" & oDTConnection.Rows(0).Item("SERVER") & ";Database=" & oDTConnection.Rows(0).Item("DATENBANK") & ";Trusted_Connection=True;" + Else + connectionString = "Server=" & oDTConnection.Rows(0).Item("SERVER") & ";Database=" & oDTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";" + End If + ' connectionString = "Server=" & DTConnection.Rows(0).Item("SERVER") & ";Database=" & DTConnection.Rows(0).Item("DATENBANK") & ";User Id=" & DTConnection.Rows(0).Item("USERNAME") & ";Password=" & DTConnection.Rows(0).Item("PASSWORD") & ";" + Case "Oracle" + If oDTConnection.Rows(0).Item("BEMERKUNG").ToString.Contains("without tnsnames") Then + connectionString = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & oDTConnection.Rows(0).Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" & + oDTConnection.Rows(0).Item("DATENBANK") & ")));User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";" + Else + connectionString = "Data Source=" & oDTConnection.Rows(0).Item("SERVER") & ";Persist Security Info=True;User Id=" & oDTConnection.Rows(0).Item("USERNAME") & ";Password=" & oDTConnection.Rows(0).Item("PASSWORD") & ";Unicode=True" + End If + 'Case "ODBC" + ' Dim conn As New OdbcConnection("dsn=" & DTConnection.Rows(0).Item("SERVER") & ";uid=" & DTConnection.Rows(0).Item("USERNAME") & ";pwd=" + DTConnection.Rows(0).Item("PASSWORD")) + ' connectionString = conn.ConnectionString + Case Else + _Logger.Info(" - ConnectionType nicht integriert") + + End Select + Else + _Logger.Info(" No entry for Connection-ID: " & pID.ToString) + End If + + Catch ex As Exception + _Logger.Error(ex) + _Logger.Info(" - Error in bei Get ConnectionString - Fehler: " & vbNewLine & ex.Message) + End Try + Return connectionString + End Function Private Function TestCanConnect() As Boolean Return TestCanConnect(CurrentSQLConnectionString)