Imports WINDREAMLib Imports System.Threading Imports System.Runtime.InteropServices Imports Oracle.ManagedDataAccess.Client Imports Independentsoft Imports System.IO Imports System.Text.RegularExpressions Imports System.ComponentModel Imports DigitalData.Controls.LookupGrid Imports DevExpress.XtraGrid Imports System.Reflection Imports DigitalData.Controls.ChatControl Imports DevExpress.XtraEditors.Repository Imports DigitalData.Modules.EDMI.API Imports DigitalData.Modules.EDMI.API.EDMIServiceReference Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraEditors.Controls Public Class frmValidator Dim strFileList() Dim PROFIL_sortbynewest As Boolean Dim PROFIL_VEKTORINDEX Dim PROFIL_FINISH_SQL Dim PROFIL_LOGINDEX Dim oErrMsgMissingInput Private PMDelimiter As String Dim WD_Search As String Dim finalProfile As Boolean Dim Move2Folder As String Private DataASorDB As ClassDataASorDB Private allgFunk As New ClassAllgemeineFunktionen 'speichert die DocumentDaten Private navStep As String = Nothing Public Shared WMDocPathWindows As String Public WMDocFileString As String Private DocPathWindows As String Dim OLD_Document_Path As String = "" Dim ValueDTP As Date Dim AnzDoks As Integer Dim docCounter As Integer = 1 'Anzahl der Validierungsdokumente Dim Anzahl_ValDoks As Integer 'Anzahl der validierten Dokumente Dim Anzahl_validierte_Dok As Integer = 0 Dim me_closing As Boolean = False Dim first_control As Control Dim last_control As Control Dim _Indexe_Loaded As Boolean = False Public Shared idxerr_message As String = "" Private _CURRENT_INDEX_ARRAY(100, 250) As String Private _frmValidatorSearch As frmValidatorSearch 'You need a reference to Form1 Private _dependingControl_in_action As Boolean = False Private _dependingColumn_in_action As Boolean = False Private _SetControlValue_in_action As Boolean = False Private DTCONTROLS As DataTable Private DTGRID_COLUMNS_WITH_SQL As DataTable Private DTGRID_COLUMNS As DataTable Private DTGRID_SQL_DEFINITION As DataTable Private DTConversations As DataTable Private DTDYNAMIC_RIGHTS As DataTable Private Right_Conversation_Add As Boolean = False Private Right_Conversation_Stop As Boolean = False Private Right_Conversation_Message As Boolean = False Private Conversation_User_Active As Boolean = False Private ConversationQUDT_Delete As DataTable Private Conversation_initialized As Boolean = False Public FormLoaded As Boolean = False Private ItemWorked As Boolean = False Private Override As Boolean = False Private OverrideAll As Boolean = False Private Override_SQLCommand As String = "" Private listChangedLookup As New List(Of String) Private ControlHandleStarted As Boolean = False Public Sub New() 'MyBase.New LOGGER.Debug("Initialize Components...") InitializeComponent() LOGGER.Debug("Initialize _frmValidatorSearch...") Try _frmValidatorSearch = New frmValidatorSearch Catch ex As Exception LOGGER.Error(ex) End Try Localizer.Active = New LookupGridLocalizer() End Sub Private Sub frmValidation_Load(sender As Object, e As System.EventArgs) Handles Me.Load Try LOGGER.Debug("###frmValidation_Load###") DataASorDB = New ClassDataASorDB PMDelimiter = "~" Override = False ItemWorked = False SplitContainer1.Panel2Collapsed = True docCounter = 1 OLD_Document_Path = "" first_control = Nothing me_closing = False 'pdfxchange = False 'sumatra = False FormLoaded = False Catch ex As Exception LOGGER.Warn($"Error in frmValidation_load1: {ex.Message}") End Try Try If My.Settings.frmValidatorPosition.IsEmpty = False Then If My.Settings.frmValidatorPosition.X > 0 And My.Settings.frmValidatorPosition.Y > 0 Then Location = My.Settings.frmValidatorPosition End If End If If My.Settings.frmValidatorSize.IsEmpty = False Then If My.Settings.frmValidatorWindowState = "Normal" Then Size = My.Settings.frmValidatorSize Else Me.WindowState = FormWindowState.Maximized End If End If Catch ex As Exception LOGGER.Info($"Error loading position: {ex.Message}") End Try Dim _step = 0 Try DocumentViewerValidator.Init(LOGCONFIG, GDPICTURE_LICENSE) Catch ex As Exception LOGGER.Error(ex) End Try Try _step = 1 _step = 2 DTVWCONTROL_INDEX.Clear() Dim oExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}" DTVWCONTROLS_INDEX.Select(oExpression, "Y_LOC, X_LOC").CopyToDataTable(DTVWCONTROL_INDEX, LoadOption.PreserveChanges) _step = 3 LOGGER.Debug("Profile Data loaded") Catch ex As Exception LOGGER.Error(ex) MsgBox("Error LOADING profile-data(" & _step.ToString & "):" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry($"ERROR frmValidatorLoad>> {ex.Message}") LOGGER.Info(">> Error in LOADING profile-data: " & ex.Message, True) Me.Close() End Try LOGGER.Debug("frmValidation_Load finished till Step 3!") Try If CURRENT_DT_PROFILE.Rows.Count = 0 Then LOGGER.Info(">> ProfileData could not be loaded - Profile: : " & CURRENT_ProfilName, True) MsgBox("ProfileData could not be loaded - Profile: " & CURRENT_ProfilName, MsgBoxStyle.Critical, "Attention:") Me.Close() End If _step = 4 LOGGER.Debug("Step 4") If CURRENT_DT_PROFILE.Rows.Count > 1 Then MsgBox("More than 1 profile (" & CURRENT_DT_PROFILE.Rows.Count & ") returned!!", MsgBoxStyle.Critical, "Attention:") Else _step = 5 LOGGER.Debug("Step 5") If CURRENT_DT_PROFILE.Rows.Count = 1 Then _step = 6 LOGGER.Debug("Step 6") For Each oProfileRow As DataRow In CURRENT_DT_PROFILE.Rows PROFIL_FINISH_SQL = oProfileRow.Item("SQL_BTN_FINISH") PROFIL_VEKTORINDEX = oProfileRow.Item("PM_VEKTOR_INDEX") PROFIL_LOGINDEX = oProfileRow.Item("LOG_INDEX") CURRENT_PROFILE_LOG_INDEX = PROFIL_LOGINDEX Me.Text = "Process Manager - " & oProfileRow.Item("TITLE") TITLELabel1.Text = oProfileRow.Item("TITLE") DESCRIPTIONLabel.Text = IIf(IsDBNull(oProfileRow.Item("DESCRIPTION")), "", oProfileRow.Item("DESCRIPTION")) If PROFIL_VEKTORINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_VEKTORINDEX = "" End If If PROFIL_LOGINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_LOGINDEX = "" End If WD_Search = oProfileRow.Item("WD_SEARCH") finalProfile = oProfileRow.Item("FINAL_PROFILE") Move2Folder = IIf(IsDBNull(oProfileRow.Item("MOVE2Folder")), "", oProfileRow.Item("MOVE2Folder")) Try If finalProfile = True Then Dim text As String = IIf(IsDBNull(oProfileRow.Item("FINAL_TEXT")), "", oProfileRow.Item("FINAL_TEXT") & (" (F2)")) If text <> "" Then btnSave.Text = text Else Try btnSave.Text = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton") Catch ex As Exception LOGGER.Warn("Missing Config frmValidator.ValidationButton in TBDD_GUI_LANGUAGE_PHRASE") End Try End If Else btnSave.Text = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton") End If LOGGER.Debug("Buttontext validation loaded") Catch ex As Exception LOGGER.Error(ex) MsgBox("Error loading final profile text:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") LOGGER.Info(">> Error loading final profile text: " & ex.Message, True) End Try bbtniNext.Visibility = DevExpress.XtraBars.BarItemVisibility.Always If CURRENT_JUMP_DOC_GUID <> 0 Then bbtniNext.Visibility = DevExpress.XtraBars.BarItemVisibility.Never Anzahl_ValDoks = 1 Else Anzahl_ValDoks = 0 End If Next If LOG_ERRORS_ONLY = False Then LOGGER.Info(" >> profiledata saved:") LOGGER.Info(" >> WD_Search: " & WD_Search) LOGGER.Info(" >> finalProfile: " & finalProfile) LOGGER.Info(" >> Move2Folder: " & Move2Folder) LOGGER.Info(" >> Right_Delete: " & USER_RIGHT_FILE_DELETE) End If PROFIL_sortbynewest = CURRENT_DT_PROFILE.Rows(0).Item("SORT_BY_LATEST") LOGGER.Debug("PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString) 'Delete Button anzeigen ja/nein If USER_RIGHT_FILE_DELETE = True Then bbtniDelete.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Else bbtniDelete.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If If CBool(CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then bbtniAnnotation.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Else bbtniAnnotation.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If LOGGER.Debug("Right_Delete: " & USER_RIGHT_FILE_DELETE.ToString) Create_Controls() End If End If oErrMsgMissingInput = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.MissingInput") RibbonPageConversations.Visible = False If IDB_ACTIVE Then Dim oSQL = $"SELECT * FROM [dbo].[FNIDB_OBJECT_DYNAMIC_CONFIG] ({CURRENT_DOC_ID},{USER_ID})" DTDYNAMIC_RIGHTS = ClassDatabase.Return_Datatable_ConStr(oSQL, CONNECTION_STRING_IDB_READ, "FNIDB_OBJECT_DYNAMIC_CONFIG") RibbonPageGroupConv1.Enabled = False Dim oView As DataView = New DataView(DTDYNAMIC_RIGHTS) Debug.WriteLine(oView.Count, "oView before") oView.RowFilter = "CONF_TITLE like '%CONVERSATION_RIGHT%'" Debug.WriteLine(oView.Count, "oView after") If oView.Count > 0 Then LOGGER.Debug("CONVERSATION-RIGHTS EXISTING") RibbonPageConversations.Visible = True RibbonPageGroupConv1.Enabled = True ConversationQUDT_Delete = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.Conversation_Delete") oView = New DataView(DTDYNAMIC_RIGHTS) oView.RowFilter = "CONF_TITLE = 'CONVERSATION_USER_ACTIVE'" Conversation_initialized = Conversation_init() If oView.Count = 1 Then Conversation_User_Active = True Else SplitContainer2_DV_Chat.Collapsed = True Conversation_User_Active = False SplitContainer2_DV_Chat.Panel2.Visible = False End If Else SplitContainer2_DV_Chat.Collapsed = True RibbonPageConversations.Visible = False End If 'If Not IsNothing(DTConversations) Then ' If DTConversations.Rows.Count >= 1 Then ' SplitContainerMain.Collapsed = False ' Dim oConversations As List(Of String) ' oConversations = ChatControl1.GetConversations(CURRENT_DOC_ID) ' If oConversations.Count > 1 Then ' RibbonPageGroupConv_Change.Visible = True ' For Each oit As String In oConversations ' ' Dim Coll As ComboBoxItemCollection = RepositoryItemComboBox3.Properties.Items ' BarEditItem2..Items.Add(oit) ' Next ' Else ' RibbonPageGroupConv_Change.Visible = False ' End If ' Else ' End If 'Else ' SplitContainerMain.Collapsed = True 'End If Else SplitContainer2_DV_Chat.Collapsed = True End If LOGGER.Debug("frmValidation_Load finished!") Catch ex As Exception LOGGER.Error(ex) MsgBox("Error LOADING Profile-Data1:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry($"ERROR LOADING Profile-Data1 >> {ex.Message}") LOGGER.Info(">> error in LOADING(2) Profile-Data: " & ex.Message, True) End Try End Sub Sub Conversations_Init_Rights() RibbonPageConversations.Visible = True bbtnitem_ConversationNew.Visibility = DevExpress.XtraBars.BarItemVisibility.Never btnitemConversationEnd.Visibility = DevExpress.XtraBars.BarItemVisibility.Never btnitemConversationEnd.Enabled = True btnitemConversation_reload.Enabled = True For Each oRow As DataRow In DTDYNAMIC_RIGHTS.Rows If oRow.Item("CONF_TITLE").ToString = "CONVERSATION_RIGHT" Then Select Case oRow.Item("CONF_VALUE") Case "Admin" bbtnitem_ConversationNew.Visibility = DevExpress.XtraBars.BarItemVisibility.Always btnitemConversationEnd.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Right_Conversation_Add = True Right_Conversation_Stop = True Case "Start" bbtnitem_ConversationNew.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Right_Conversation_Add = True Case "Stop" btnitemConversationEnd.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Right_Conversation_Stop = True Case "AddMessage" Right_Conversation_Message = True End Select 'ElseIf oRow.Item("CONF_TITLE").ToString = "CONVERSATION_USER_ACTIVE" Then ' Conversation_User_Active = True End If Next End Sub Sub Conversations_load() Dim oConversations As List(Of String) oConversations = ChatControl1.GetConversations(CURRENT_DOC_ID) RibbonPageGroupConv_Change.Visible = True If oConversations.Count = 0 Then RibbonPageGroupConv_Change.Visible = False End If RepositoryItemComboBox3.Items.Clear() Dim oActiveConv As Boolean = False RibbonPageGroupConv_Change.Visible = True For Each oconv As String In oConversations If Not oconv.Contains("Started") Then RepositoryItemComboBox3.Items.Add(oconv) End If If oconv.Contains("Started") Then oActiveConv = True End If Next If oActiveConv = False Then btnitemConversationEnd.Enabled = False btnitemConversation_reload.Enabled = False SplitContainer2_DV_Chat.Collapsed = True Else If SplitContainer2_DV_Chat.Panel2.Visible = False Then SplitContainer2_DV_Chat.Panel2.Visible = True End If SplitContainer2_DV_Chat.Collapsed = False End If End Sub Private Sub frmValidation_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Try me_closing = True Try ' Position und Größe speichern My.Settings.frmValidatorSize = Me.Size My.Settings.frmValidatorPosition = Me.Location My.Settings.Save() Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Error in Load FormLayout: " & ex.Message) End Try My.Settings.frmValidatorSize = Me.Size My.Settings.Save() If INACTIVITY_DURATION <> 0 Then frmMain.Timer_Inactivity_Reset_Disable() Catch ex As Exception LOGGER.Error(ex) End Try Try Dim oDel = $"DELETE FROM TBPM_FILES_USER_NOT_INDEXED WHERE UPPER(USR_NAME) = UPPER('{USER_USERNAME}')" ClassDatabase.Execute_non_Query(oDel) Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in delete jumped files:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If CURRENT_DOC_GUID <> 0 Then Try 'If ItemWorked = False Then Free_File() 'End If Catch ex As Exception LOGGER.Error(ex) End Try End If Try DocumentViewerValidator.CloseDocument() DocumentViewerValidator.Done() Catch ex As Exception LOGGER.Warn($"Unexpected error in DocumentViewerValidator.Done: {ex.Message}") End Try Try _frmValidatorSearch.Close() Catch ex As Exception LOGGER.Error(ex) End Try End Sub Public Sub Load_Additional_Searches() Try If BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Or BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then Dim oDocResultCommand As String Dim oDatatableDocResult As DataTable Dim oDataResultCommand As String Dim oDatatableDataResult As DataTable If BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Then 'Check whether DocData is there Dim oConID = BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("CONN_ID") oDataResultCommand = BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("SQL_COMMAND") oDataResultCommand = clsPatterns.ReplaceAllValues(oDataResultCommand, pnldesigner, True) oDatatableDataResult = ClassDatabase.Return_Datatable_ConId(oDataResultCommand, oConID, "Load_Additional_Searches1") End If If BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then 'Check whether DocData is there Dim oConID = BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID") oDocResultCommand = BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND") oDocResultCommand = clsPatterns.ReplaceAllValues(oDocResultCommand, pnldesigner, True) oDatatableDocResult = ClassDatabase.Return_Datatable_ConId(oDocResultCommand, oConID, "Load_Additional_Searches2") End If Dim oDataResultsExist As Boolean = False Dim oDocResultsExist As Boolean = False If BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Then If Not IsNothing(oDatatableDataResult) Then If oDatatableDataResult.Rows.Count > 0 Then oDataResultsExist = True End If End If End If If BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then If Not IsNothing(oDatatableDocResult) Then If oDatatableDocResult.Rows.Count > 0 Then oDocResultsExist = True End If End If End If If oDataResultsExist = True Or oDocResultsExist = True Then bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Always If RibbonPageCustTitle <> "" Then RibbonPageCust.Text = RibbonPageCustTitle RibbonPageCust.Visible = True If RibbonPageCustItm1 <> "" Then BarButtonItemAttmt.Caption = RibbonPageCustItm1 BarButtonItemAttmt.Visibility = DevExpress.XtraBars.BarItemVisibility.Always End If Else RibbonPageCust.Visible = False End If Try _frmValidatorSearch.Show() Dim oPnl1Collapsed As Boolean = True Dim oPnl2Collapsed As Boolean = True If oDataResultsExist = True Then oPnl1Collapsed = False Else oPnl1Collapsed = True End If If oDocResultsExist = True Then oPnl2Collapsed = False Else oPnl2Collapsed = True End If _frmValidatorSearch.TabPreload(oPnl1Collapsed, oPnl2Collapsed, BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count, BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows.Count, BASEDATA_DT_PROFILE_SEARCHES_SQL, BASEDATA_DT_PROFILE_SEARCHES_DOC) If oDataResultsExist Then _frmValidatorSearch._DTSQLSearches = BASEDATA_DT_PROFILE_SEARCHES_SQL Dim oConID = BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("CONN_ID") Dim oCommand = BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("SQL_COMMAND") oCommand = clsPatterns.ReplaceAllValues(oCommand, pnldesigner, True) _frmValidatorSearch.Refresh_Load_GridSQL(oConID, oCommand, 0, BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("TAB_TITLE")) End If If oDocResultsExist Then _frmValidatorSearch._DTDocSearches = BASEDATA_DT_PROFILE_SEARCHES_DOC Dim oConID = BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID") Dim oCommand = BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND") oCommand = clsPatterns.ReplaceAllValues(oCommand, pnldesigner, True) _frmValidatorSearch.RefreshTabDoc(oConID, oCommand, 0, BASEDATA_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("TAB_TITLE")) End If Catch ex As Exception LOGGER.Error(ex) End Try Else LOGGER.Info("Not loading AdditionalSearches 1...!") bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If Else LOGGER.Info("Not loading AdditionalSearches 2...!") bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE) End Try End Sub Sub LoadSQLData(control As Control, pControlId As Integer) Try If TypeOf control Is Label Then Exit Sub LOGGER.Debug($"in LoadSQLData for ControlID [{pControlId}]...") Dim oDTforControl As DataTable = DTCONTROLS_WITH_SQL.Clone() Dim oExpression = $"GUID = {pControlId} AND PROFIL_ID = {CURRENT_ProfilGUID}" DTCONTROLS_WITH_SQL.Select(oExpression).CopyToDataTable(oDTforControl, LoadOption.PreserveChanges) If IsNothing(oDTforControl) Then Exit Sub If oDTforControl.Rows.Count = 0 Then Exit Sub For Each row As DataRow In oDTforControl.Rows Dim name As String = row.Item("NAME") Dim oGUID As String = row.Item("GUID") 'If clsPatterns.HasComplexPatterns(row.Item("SQL_UEBERPRUEFUNG")) Then ' LOGGER.Debug($"SQL [{row.Item("SQL_UEBERPRUEFUNG")}] has complex patterns - GUID: {oGUID}") ' Continue For 'End If If IsDBNull(row.Item("CONNECTION_ID")) Then LOGGER.Info($"No CONNECTION_ID for SQL-Data - oGUID: {oGUID}") Continue For End If If IsDBNull(row.Item("SQL_UEBERPRUEFUNG")) Then Continue For Dim oSQLStatement As String = row.Item("SQL_UEBERPRUEFUNG") Dim oConnectionId As Integer = row.Item("CONNECTION_ID") 'If clsPatterns.HasComplexPatterns(sqlStatement) Then ' Continue For 'End If If IsNothing(oSQLStatement) Then Continue For End If 'oSql = clsPatterns.ReplaceUserValues(sqlStatement, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_LANGUAGE, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) 'oSql = clsPatterns.ReplaceInternalValues(oSql) oSQLStatement = clsPatterns.ReplaceAllValues(oSQLStatement, pnldesigner, True) If IsNothing(oSQLStatement) Then Continue For End If If clsPatterns.HasComplexPatterns(oSQLStatement) Then LOGGER.Warn($"Unexpected error LoadSQLData2 - sql Statement still has complex patterns! [{oSQLStatement}]") Continue For End If 'sql = ClassPatterns.ReplaceInternalValues(sqlStatement) Dim oDTContent As DataTable = ClassDatabase.Return_Datatable_ConId(oSQLStatement, oConnectionId, $"LoadSQLData - pControlId: {pControlId}") If IsNothing(oDTContent) Then LOGGER.Warn($"SQL-Query [{oSQLStatement}] for control {control.Name} is invalid.") Exit Sub End If Dim oValue If TypeOf control Is TextBox Then Try Dim firstRow As DataRow = oDTContent.Rows(0) Dim value = firstRow.Item(0) control.Text = value oValue = value Catch ex As Exception LOGGER.Warn("Error in TextBoxLoadSQLData: " & ex.Message) End Try ElseIf TypeOf control Is ComboBox Then Try Dim oMyComboBox As ComboBox = control Dim oselectedIndex = oMyComboBox.SelectedIndex LOGGER.Debug($"oMyComboBox {oMyComboBox.Name} - Saving selected index {oselectedIndex}") Dim list As New List(Of String) For Each _row As DataRow In oDTContent.Rows list.Add(_row.Item(0)) Next oMyComboBox.DataSource = list oMyComboBox.SelectedIndex = oselectedIndex Catch ex As Exception LOGGER.Warn("Error in ComboBoxLoadSQLData: " & ex.Message) End Try ElseIf TypeOf control Is LookupControl3 Then Try Dim lookup As LookupControl3 = control lookup.Properties.DataSource = oDTContent lookup.Properties.ValueMember = oDTContent.Columns.Item(0).ColumnName lookup.Properties.DisplayMember = oDTContent.Columns.Item(0).ColumnName Catch ex As Exception LOGGER.Warn("Error in LookUpLoadSQLData: " & ex.Message) End Try ElseIf TypeOf control Is GridControl Then Try Dim dataGridView As GridControl = control Dim oDataSource As DataTable = dataGridView.DataSource If oDataSource Is Nothing OrElse oDataSource.Rows.Count = 0 Then 'dataGridView.DataSource = dt Dim oDatatable As DataTable = oDTContent.Clone() For Each oColumn As DataColumn In oDatatable.Columns If oDataSource.Columns(oColumn.ColumnName) Is Nothing Then 'oDataSource.Columns.Add(oColumn) oDataSource.Columns.Add(oColumn.ColumnName, oColumn.DataType) End If Next For Each oRow As DataRow In oDTContent.Rows oDataSource.ImportRow(oRow) Next dataGridView.DataSource = oDataSource End If Catch ex As Exception LOGGER.Warn("Error in GridControlSQLData: " & ex.Message) End Try End If Next Catch ex As Exception LOGGER.Warn($"{ex.Message} - Loading ControlID: {pControlId}") MsgBox("Error in LoadSQLData: " & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE) End Try End Sub Private Function PreventNulletc(myObject As Object, pType As String) If IsDBNull(myObject) Then If pType = "String" Then Return String.Empty Else Return 0 End If ElseIf IsNothing(myObject) Then If pType = "String" Then Return String.Empty Else Return 0 End If Else Return myObject End If End Function Sub Create_Controls() Dim oControlInfo As String Try pnldesigner.Controls.Clear() Dim oSQL = $"SELECT [dbo].[FNPM_LANGUAGE_CONTROL_TEXT] (NAME,'{USER_LANGUAGE}',CTRL_TYPE,CTRL_TEXT) CTRL_CAPTION_LANG, * FROM TBPM_PROFILE_CONTROLS WHERE CONTROL_ACTIVE = 1 AND PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY Y_LOC, X_LOC" DTCONTROLS = DataASorDB.GetDatatable("DD_ECM", oSQL, "TBPM_PROFILE_CONTROLS_LANGUAGE", $"LANGUAGE = '{USER_LANGUAGE}' AND PROFIL_ID = {CURRENT_ProfilGUID}", "Y_LOC, X_LOC") oSQL = $"SELECT T1.GUID As CONTROL_ID, T1.PROFIL_ID, T.CONNECTION_ID, T.SQL_COMMAND, T.SPALTENNAME,T.FORMATTYPE,T.FORMATSTRING from TBPM_CONTROL_TABLE T, TBPM_PROFILE_CONTROLS T1 WHERE CONTROL_ACTIVE = 1 AND T.CONTROL_ID = T1.GUID AND T1.PROFIL_ID = {CURRENT_ProfilGUID} AND LEN(T.SQL_COMMAND) > 0 AND T.LOAD_AFT_LOAD_CONTROL = 0 ORDER BY T.SEQUENCE" DTGRID_COLUMNS_WITH_SQL = DataASorDB.GetDatatable("DD_ECM", oSQL, "DTGRID_COLUMNS_WITH_SQL", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE") oSQL = $"SELECT T.* from TBPM_CONTROL_TABLE T, TBPM_PROFILE_CONTROLS T1 WHERE T1.CONTROL_ACTIVE = 1 AND T.CONTROL_ID = T1.GUID AND T1.PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY T.SEQUENCE" DTGRID_COLUMNS = DataASorDB.GetDatatable("DD_ECM", oSQL, "TBPM_CONTROL_TABLE", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE") oSQL = $"SELECT T1.GUID As CONTROL_ID, T1.PROFIL_ID, T.CONNECTION_ID, T.SQL_COMMAND, T.SPALTENNAME,T.FORMATTYPE,T.FORMATSTRING from TBPM_CONTROL_TABLE T, TBPM_PROFILE_CONTROLS T1 WHERE T1.CONTROL_ACTIVE = 1 AND T.CONTROL_ID = T1.GUID AND T1.PROFIL_ID = {CURRENT_ProfilGUID} AND LEN(T.SQL_COMMAND) > 0 AND T.LOAD_AFT_LOAD_CONTROL = 1 ORDER BY T.SEQUENCE" DTGRID_SQL_DEFINITION = DataASorDB.GetDatatable("DD_ECM", oSQL, "DTGRID_SQL_DEFINITION", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE") Dim oCount As Integer = 0 For Each oControlRow As DataRow In DTCONTROLS.Rows Dim oMyControl As Control Dim oControlID = oControlRow.Item("GUID") oControlInfo = $"CtrlID: {oControlID} - CtrlName: {oControlRow.Item("NAME")} - CtrlIndex: {oControlRow.Item("INDEX_NAME")}" Try Select Case oControlRow.Item("CTRL_TYPE").ToString.ToUpper Case "TXT" Try oControlInfo = "TXT#" & oControlInfo LOGGER.Debug($"[{oControlInfo}] - TXT Try to create control...") Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(oControlRow, False) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp oMyControl = txt LOGGER.Debug($"[{oControlInfo}] - TXT Created!!") Catch ex As Exception LOGGER.Warn($"Unexpected error in Create_Controls TXT [{oControlInfo}]: {ex.Message}") End Try Case "LBL" oControlInfo = "LBL#" & oControlInfo oMyControl = ClassControlCreator.CreateExistingLabel(oControlRow, False) Case "CMB" oControlInfo = "CMB#" & oControlInfo LOGGER.Debug($"[{oControlInfo}] - CMB Try to create control...") If oControlRow.Item("READ_ONLY") Then Dim cmbReadonly = ClassControlCreator.CreateExistingTextbox(oControlRow, False) oMyControl = cmbReadonly Else Dim oComboBox = ClassControlCreator.CreateExistingCombobox(oControlRow, False) AddHandler oComboBox.SelectedValueChanged, AddressOf OnCmbselectedIndex AddHandler oComboBox.GotFocus, Sub(sender As Control, e As EventArgs) If DirectCast(oComboBox.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then oComboBox.BackColor = Color.LightSteelBlue End If End Sub AddHandler oComboBox.LostFocus, Sub(sender As Control, e As EventArgs) If DirectCast(oComboBox.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then oComboBox.BackColor = Color.White End If End Sub #Region "CONTROL LIST" LOGGER.Debug("In add_ComboBox - GUID: " & oControlID) Dim oCONID As Integer Try oCONID = PreventNulletc(oControlRow.Item("CONNECTION_ID"), "Integer") Catch ex As Exception oCONID = 0 End Try If oCONID > 0 Then Dim oCommandSQL_UBPF Try oCommandSQL_UBPF = oControlRow.Item("SQL_UEBERPRUEFUNG") Catch ex As Exception oCommandSQL_UBPF = "" End Try 'TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) LOGGER.Debug("ConID <> String.Empty") If oCONID > 0 And oCommandSQL_UBPF <> String.Empty Then LOGGER.Debug("ConID > 0 And commandsql <> String.Empty") Try oSQL = PreventNulletc(oControlRow.Item("SQL_UEBERPRUEFUNG"), "String") 'TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) If clsPatterns.HasOnlySimplePatterns(oSQL) Then LOGGER.Debug("SQL HasOnlySimplePatterns!") oSQL = clsPatterns.ReplaceInternalValues(oSQL) oSQL = clsPatterns.ReplaceControlValues(oSQL, pnldesigner, True) Dim oDT As DataTable = ClassDatabase.Return_Datatable_ConId(oSQL, oCONID, $"CreateControls - oControlID: {oControlID}") If Not IsNothing(oDT) Then For Each oRow As DataRow In oDT.Rows oComboBox.Items.Add(oRow.Item(0)) Next End If End If Catch ex As Exception LOGGER.Warn($"Unexpected error in CMB GetValues SQL - Error: {ex.Message}") End Try Else LOGGER.Debug("Else Row 571") End If Else LOGGER.Debug("AListe Handling") Dim AListe As String = oControlRow.Item("CHOICE_LIST") LOGGER.Debug("In add_ComboBox - AListe: " & AListe) If AListe Is Nothing = False Then 'Dim liste = _windreamPM.GetValuesfromAuswahlliste(AListe) Dim liste = WINDREAM.GetValuesfromAuswahlliste(AListe) If liste IsNot Nothing Then oComboBox.Items.Add("") For Each index As String In liste oComboBox.Items.Add(index) Next oComboBox.SelectedIndex = -1 Else MsgBox("Resultliste windream is nothing!", MsgBoxStyle.Exclamation, AListe) End If Else MsgBox("AListe from database is nothing!", MsgBoxStyle.Exclamation, AListe) End If End If #End Region 'Dim oMaxWidth As Integer = oComboBox.Width 'Using oGraphics As Graphics = oComboBox.CreateGraphics() ' Dim oStringLength = oGraphics.MeasureString(Text, oComboBox.Font).Width ' If oStringLength + 30 > oMaxWidth Then ' oMaxWidth = oStringLength + 30 ' End If 'End Using 'Using g As Graphics = Me.CreateGraphics ' For Each oItem As Object In oComboBox.Items 'Für alle Einträge... ' Dim g1 As Graphics = oComboBox.CreateGraphics ' If g1.MeasureString(Text, oComboBox.Font).Width + 30 > oMaxWidth Then ' oMaxWidth = g1.MeasureString(Text, oComboBox.Font).Width + 30 ' End If ' g1.Dispose() ' Next oItem 'End Using 'oComboBox.DropDownWidth = oMaxWidth oMyControl = oComboBox End If LOGGER.Debug($"[{oControlInfo}] - CMB CONTROL created") Case "DTP" oControlInfo = "DTP#" & oControlInfo oMyControl = ClassControlCreator.CreateExistingDatepicker(oControlRow, False) Case "DGV" Dim dgv = ClassControlCreator.CreateExistingDataGridView(oControlRow, False) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating oMyControl = dgv Case "LOOKUP" oControlInfo = "LOOKUP#" & oControlInfo Dim oMultiselect = oControlRow.Item("MULTISELECT") Dim oReadonly = oControlRow.Item("READ_ONLY") If oMultiselect = False And oReadonly = True Then Dim lookupReadonly = ClassControlCreator.CreateExistingTextbox(oControlRow, False) oMyControl = lookupReadonly Else Dim lookup As LookupControl3 = ClassControlCreator.CreateExistingLookupControl(oControlRow, False) lookup.Properties.PreventDuplicates = oControlRow.Item("VKT_PREVENT_MULTIPLE_VALUES") lookup.Properties.AllowAddNewValues = oControlRow.Item("VKT_ADD_ITEM") lookup.Properties.MultiSelect = oMultiselect If NotNull(oControlRow.Item("DEFAULT_VALUE"), "") <> "" Then lookup.Properties.SelectedValues = New List(Of String) From {oControlRow.Item("DEFAULT_VALUE")} End If oMyControl = lookup AddHandler lookup.Properties.SelectedValuesChanged, AddressOf LookupListChanged 'Wenn Multiselect false dann prüfen ob abhängiges Control If CBool(oControlRow.Item("MULTISELECT")) = False Then Dim oFilteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oMyControl.Name}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredData, LoadOption.PreserveChanges) If oFilteredData.Rows.Count >= 1 Then LOGGER.Debug($"createControlsLU - Found {oFilteredData.Rows.Count} Controls which are depending on {oMyControl.Name}") 'AddHandler lookup.EditValueChanged, AddressOf onLookUp1 AddHandler lookup.Properties.SelectedValuesChanged, AddressOf onLookUpselectedValue End If oExpression = $"SQL_ENABLE like '%#CTRL#{oMyControl.Name}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredData, LoadOption.PreserveChanges) If oFilteredData.Rows.Count >= 1 Then LOGGER.Debug($"createControlsLU - Found {oFilteredData.Rows.Count} Controls which' enable state is depending on {oMyControl.Name}") 'AddHandler lookup.EditValueChanged, AddressOf onLookUp1 AddHandler lookup.Properties.SelectedValuesChanged, AddressOf onLookUpselectedValue End If oFilteredData = DTCONTROLS.Clone() oExpression = $"GUID = {oControlRow.Item("GUID")} and Len(SET_CONTROL_DATA) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredData, LoadOption.PreserveChanges) If oFilteredData.Rows.Count = 1 Then 'AddHandler lookup.EditValueChanged, AddressOf onLookUp1 AddHandler lookup.Properties.SelectedValuesChanged, AddressOf onLookUpselectedValue_Control2Set End If oFilteredData = DTCONTROLS.Clone() End If AddHandler lookup.GotFocus, Sub(sender As Control, e As EventArgs) If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then lookup.BackColor = Color.LightSteelBlue End If End Sub AddHandler lookup.LostFocus, Sub(sender As Control, e As EventArgs) If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then lookup.BackColor = Color.White End If End Sub End If 'Return filteredData 'AddHandler lookup.Leave, AddressOf onLookUp0 Case "CHK" oControlInfo = "CHK#" & oControlInfo oMyControl = ClassControlCreator.CreateExisingCheckbox(oControlRow, False) Dim mycheckbox As CheckBox = oMyControl AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange 'prüfen ob abhängiges Control 'Dim filteredData As DataTable = DTCONTROLS.Clone() 'Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oMyControl.Name}%'" 'DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges) 'If filteredData.Rows.Count = 1 Then ' AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange 'End If 'oExpression = $"SQL_ENABLE like '%#CTRL#{oMyControl.Name}%'" 'DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges) 'If filteredData.Rows.Count >= 1 Then ' 'AddHandler lookup.EditValueChanged, AddressOf onLookUp1 ' AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange 'End If 'filteredData = DTCONTROLS.Clone() 'oExpression = $"GUID = {oControlRow.Item("GUID")} and Len(SET_CONTROL_DATA) > 0" 'DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges) 'If filteredData.Rows.Count >= 1 Then ' AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange 'End If 'Dim oCONTROL_ID = DirectCast(oControlRow.Item("GUID"), ClassControlCreator.ControlMetadata).Guid 'Dim ofilteredData As DataTable = DTCONTROLS.Clone() 'oExpression = $"GUID = {oCONTROL_ID} and Len(SET_CONTROL_DATA) > 0" 'DTCONTROLS.Select(oExpression).CopyToDataTable(ofilteredData, LoadOption.PreserveChanges) 'If ofilteredData.Rows.Count = 1 Then ' AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange 'End If Case "TABLE" oControlInfo = "TABLE#" & oControlInfo 'Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DD_DMSLiteDataSet.TBPM_CONTROL_TABLE ' Where r.CONTROL_ID = oControlRow.Item("GUID") ' Select r).ToList() Dim oFilteredDatatable As DataTable = DTGRID_COLUMNS.Clone() Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}" DTGRID_COLUMNS.Select(oExpression, "SEQUENCE").CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count >= 1 Then LOGGER.Debug($"We got a definition for DTGRID_COLUMNS!!") Else Continue For End If Dim oGrid = ClassControlCreator.CreateExistingGridControl(oControlRow, oFilteredDatatable, False) AddHandler oGrid.ProcessGridKey, Sub(ByVal _sender As Object, ByVal e As KeyEventArgs) If e.KeyCode = Keys.Tab Then Dim gridControl = TryCast(_sender, GridControl) Dim view = TryCast(gridControl.FocusedView, Views.Base.ColumnView) If (e.Modifiers = Keys.None And view.IsNewItemRow(view.FocusedRowHandle) And view.FocusedColumn.VisibleIndex = view.VisibleColumns.Count - 1) Then If view.IsEditing Then view.CloseEditor() Me.SelectNextControl(gridControl, e.Modifiers = Keys.None, True, True, True) e.Handled = True End If End If End If End Sub oMyControl = oGrid Case "LINE" oMyControl = ClassControlCreator.CreateExistingLine(oControlRow, False) Case "BUTTON" Dim obutton = ClassControlCreator.CreateExistingButton(oControlRow, False) AddHandler obutton.Click, AddressOf onCustomButtonClick oMyControl = obutton End Select LOGGER.Debug($"[{oControlInfo}]: End of Select...") If TypeOf oMyControl IsNot Label Then If first_control Is Nothing Then first_control = oMyControl End If last_control = oMyControl oMyControl.TabIndex = oCount End If ' oMyControl.Tag = CInt(oControlRow.Item("GUID")) pnldesigner.Controls.Add(oMyControl) oCount += 1 Catch ex As Exception Dim st As New StackTrace(True) st = New StackTrace(ex, True) 'LOGGER.Error(ex) Dim omsg = $"Unexpected Error in Create_Controls (Select Case) [{oControlInfo}] - ERROR: {ex.Message}" LOGGER.Warn(omsg) If LOG_ERRORS_ONLY = False Then MsgBox(omsg, MsgBoxStyle.Critical, "Attention:") End Try Next LOGGER.Debug("Create_Controls finished!") Catch ex As Exception Dim st As New StackTrace(True) st = New StackTrace(ex, True) 'LOGGER.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Error in Create_Controls") LOGGER.Warn($"Unexpected Error in Create_Controls [{oControlInfo}] Line: {st.GetFrame(0).GetFileLineNumber().ToString} - {ex.Message}") If LOG_ERRORS_ONLY = False Then MsgBox("Error CreateControls: " & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry($"ERROR CreateControls >> {ex.Message}") End Try End Sub Private Sub GridControlColumnWidthChanged(sender As System.Object, e As System.EventArgs) Try Dim oMyGridView As DevExpress.XtraGrid.Views.Grid.GridView = sender Dim oControlID = DirectCast(oMyGridView.GridControl.Tag, ClassControlCreator.ControlMetadata).Guid SaveDevExpressGridControl_Layout(CURRENT_ProfilGUID, oControlID, oMyGridView) Catch ex As Exception End Try End Sub Sub Clear_all_Input() For Each inctrl As Control In Me.pnldesigner.Controls Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" inctrl.Text = "" Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl cmb.SelectedIndex = -1 Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = inctrl If dgv.Rows.Count > 0 Then dgv.Rows.Clear() End If Case "System.Windows.Forms.CheckBox" End Select Next 'set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If End Sub Public Sub OnTextBoxFocus(sender As Object, e As EventArgs) Dim box As TextBox = sender If DirectCast(box.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then box.BackColor = Color.LightSteelBlue box.SelectAll() End If End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim oTextbox As TextBox = sender If DirectCast(oTextbox.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then oTextbox.BackColor = Color.White End If Dim oCONTROL_ID = DirectCast(oTextbox.Tag, ClassControlCreator.ControlMetadata).Guid Dim ofilteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"GUID = {oCONTROL_ID} and Len(SET_CONTROL_DATA) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(ofilteredData, LoadOption.PreserveChanges) If ofilteredData.Rows.Count = 1 Then Dynamic_SetControlData(oTextbox, ofilteredData.Rows(0)) End If End Sub Private Function GetControlID(ByVal PROFILEID As Integer, Controlname As String) For Each oROW As DataRow In DTVWCONTROL_INDEX.Rows Next End Function Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs) If ControlHandleStarted = True Then ControlHandleStarted = False Exit Sub End If Dim box As TextBox = sender If box.Text <> String.Empty And me_closing = False And _Indexe_Loaded = True And box.Height < 25 Then If (e.KeyCode = Keys.Return) Or (e.KeyCode = Keys.Tab) Or (e.KeyCode = Keys.Enter) Then Try Dim CONTROL_ID = DirectCast(box.Tag, ClassControlCreator.ControlMetadata).Guid Dim oSql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE CONTROL_ACTIVE = 1 AND PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, box.Name) Dim DTCONTROLS_UEBP As DataTable DTCONTROLS_UEBP = DataASorDB.GetDatatable("DD_ECM", oSql, "TBPM_PROFILE_CONTROLS_SQL_UEP", $"PROFIL_ID = {CURRENT_ProfilGUID} AND SQL_UEBERPRUEFUNG LIKE '%{box.Name}%'") If Not IsNothing(DTCONTROLS_UEBP) And DTCONTROLS_UEBP.Rows.Count > 0 Then For Each ROW As DataRow In DTCONTROLS_UEBP.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, True) '' Regulären Ausdruck zum Auslesen der Indexe definieren 'Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" '' einen Regulären Ausdruck laden 'Dim regulärerAusdruck As Regex = New Regex(preg) '' die Vorkommen im SQL-String auslesen 'Dim elemente As Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(sql_Statement) ''#### '' alle Vorkommen innerhalbd er Namenkonvention durchlaufen 'For Each element As Text.RegularExpressions.Match In elemente ' Try ' If LogErrorsOnly = False Then LOGGER.Info(" >> element in RegeX: " & element.Value) ' Dim MyPattern = element.Value.Substring(2, element.Value.Length - 3) ' Dim input_value ' If MyPattern.Contains(ClassControlCreator.PREFIX_TEXTBOX) Then ' Dim txt As TextBox = CType(pnldesigner.Controls(MyPattern), TextBox) ' input_value = txt.Text ' ElseIf MyPattern.Contains(ClassControlCreator.PREFIX_COMBOBOX) Then ' Dim cmb As ComboBox = CType(pnldesigner.Controls(MyPattern), ComboBox) ' input_value = cmb.Text ' End If ' sql_Statement = sql_Statement.ToString.Replace(element.Value, input_value) ' Catch ex As Exception ' LOGGER.Info("Unexpected Error in Checking control values for Variable SQL Result - ERROR: " & ex.Message) ' End Try 'Next _dependingControl_in_action = True Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _dependingControl_in_action = False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try If box.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End If End Sub Private Sub onCustomButtonClick(sender As System.Object, e As System.EventArgs) Dim oButton As Button = sender Dim oControlID = DirectCast(oButton.Tag, ClassControlCreator.ControlMetadata).Guid Dim oSQL = ClassControlCreator.GET_CONTROL_PROPERTY(DTCONTROLS, oControlID, "SQL_UEBERPRUEFUNG") If IsNothing(oSQL) Then LOGGER.Warn("onCustomButtonClick - SQL_UEBERPRUEFUNG IS NOTHING") Exit Sub End If If Check_UpdateIndexe() = False Then LOGGER.Warn("onCustomButtonClick - Check_UpdateIndexe = False >> Exit Click") Exit Sub End If Override_SQLCommand = ClassControlCreator.GET_CONTROL_PROPERTY(DTCONTROLS, oControlID, "SQL2") If IsNothing(Override_SQLCommand) Then Override_SQLCommand = "" End If oSQL = clsPatterns.ReplaceAllValues(oSQL, pnldesigner, True) Override_SQLCommand = clsPatterns.ReplaceAllValues(Override_SQLCommand, pnldesigner, True) Dim oDT_ACTIONS As DataTable = ClassDatabase.Return_Datatable(oSQL, "onCustomButtonClick") If IsNothing(oDT_ACTIONS) Then MsgBox("Something went wrong in custom action - Please check Your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) Exit Sub ElseIf oDT_ACTIONS.Rows.Count = 0 Then MsgBox("Something went wrong in custom action (No row) - Please check Your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) Exit Sub End If Dim oAction Dim oControlName Dim oQuestion Dim oTitle Dim oCaption Dim oColor Try oAction = oDT_ACTIONS?.Rows(0).Item("ActionType") Catch ex As Exception oAction = "" End Try Try oControlName = oDT_ACTIONS?.Rows(0).Item("Controlname") Catch ex As Exception oControlName = "" End Try Try oQuestion = oDT_ACTIONS?.Rows(0).Item("Question") Catch ex As Exception oQuestion = "" End Try Try oTitle = oDT_ACTIONS?.Rows(0).Item("Title") Catch ex As Exception oTitle = "" End Try Try oCaption = oDT_ACTIONS?.Rows(0).Item("CaptionButton").ToString Catch ex As Exception oCaption = "" End Try Try oColor = System.Drawing.Color.FromName(oDT_ACTIONS?.Rows(0).Item("Color")) Catch ex As Exception oColor = "" End Try Try OverrideAll = oDT_ACTIONS?.Rows(0).Item("OverrideAll") Catch ex As Exception LOGGER.Warn($"Could not set OverrideAll {ex.Message}") OverrideAll = False End Try If OverrideAll = True Then LOGGER.Info($"CURRENT_DOC_ID: {CURRENT_DOC_ID} - OverrideAll will be in Action!") End If Select Case oAction.ToString.ToUpper Case "SetButton".ToUpper btnSave.Text = oCaption & " (F2)" btnSave.BackColor = oColor Case "Override_Question".ToUpper If oQuestion <> "" Then Dim result As MsgBoxResult result = MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.Yes Then Override = True Finish_WFStep() End If End If Case "Update_Single_Control".ToUpper Dim oResult1 As Boolean = True If oQuestion <> "" Then Dim result As MsgBoxResult result = MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.No Then oResult1 = False End If Else End If If oResult1 = True Then Dim oREsult As Boolean = True If Override_SQLCommand <> "" Then oREsult = ClassDatabase.Execute_non_Query(Override_SQLCommand) End If If oREsult = True Then Reload_Controls(oControlName) Else MsgBox("Unexpected error in Button Refresh_Controls - Check Your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) End If End If Case "Update_Controls".ToUpper If oQuestion <> "" Then Dim result As MsgBoxResult result = MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.Yes Then Dim oREsult As Boolean = True If Override_SQLCommand <> "" Then oREsult = ClassDatabase.Execute_non_Query(Override_SQLCommand) End If If oREsult = True Then SetStatusLabel("Refreshed single control", "Yellow") FillIndexValues(False) Else MsgBox("Unexpected error in Button Refresh_Controls - Check Your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) End If End If End If Case "Override_Direct".ToUpper Override = True If Check_UpdateIndexe() = True Then Finish_WFStep(False) End If Case "Override incFinal".ToUpper If Check_UpdateIndexe() = True Then Finish_WFStep(False) End If Case Else MsgBox($"No configured action provided for onCustomButtonClick [{oAction}]", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) LOGGER.Warn($"No configured action provided for onCustomButtonClick [{oAction}]") End Select End Sub Public Sub onDGVRowValidating(ByVal sender As Object, ByVal e As DataGridViewCellCancelEventArgs) Dim dgv As DataGridView = sender Try Dim CONTROL_ID = DirectCast(dgv.Tag, ClassControlCreator.ControlMetadata).Guid Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE CONTROL_ACTIVE = 1 AND PROFIL_ID = {0} And SQL_UEBERPRUEFUNG Like '%{1}%'", CURRENT_ProfilGUID, dgv.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "onDGVRowValidating") If Not IsNothing(DT) And DT.Rows.Count > 0 Then For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) Dim cellvalue = dgv.Rows(dgv.Rows.Count - 2).Cells(0).Value.ToString() sql_Statement = sql_Statement.ToString.Replace(dgv.Name, cellvalue) Dim resultDT As DataTable = ClassDatabase.Return_Datatable_ConId(sql_Statement, ROW.Item(1), $"oControlID[{CONTROL_ID}]") If resultDT.Rows.Count >= 1 Then 'Nur dediziert einen Wert zurückerhalten For Each row1 As DataRow In resultDT.Rows Dim result = row1.Item(0) If Not IsNothing(result) Then pnldesigner.Controls(displayboxname).Text = result.ToString Exit For Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING" Exit For End If Next Else pnldesigner.Controls(displayboxname).Text = "NO RESULT" End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try End Sub Public Sub onLookUpselectedValue(sender As Object, SelectedValues As List(Of String)) LOGGER.Debug("onLookUpselectedValue") If FormLoaded = False Then Exit Sub End If Dim oRepositoryItem As RepositoryItemLookupControl3 = sender Dim oLookup As LookupControl3 = oRepositoryItem.OwnerEdit Try If Not IsNothing(SelectedValues) Then If SelectedValues.Count = 1 Then LookupControl_DependingControls(oLookup, SelectedValues) LookupControl_EnablingControls(oLookup, SelectedValues) LookupControl_DependingColumn(oLookup, SelectedValues) Else LOGGER.Debug("Attention: onLookUpselectedValue: SelectedValues.Count <> 1 ") End If End If Catch ex As Exception LOGGER.Error(ex) End Try End Sub Public Sub LookupListChanged(sender As Object, SelectedValues As List(Of String)) If FormLoaded = False Then Exit Sub End If LOGGER.Debug("LookupListChanged") Dim oLookup As RepositoryItemLookupControl3 = sender Try listChangedLookup.Add(oLookup.Name) Catch ex As Exception LOGGER.Error(ex) End Try End Sub Public Sub onCheckBox_CheckedChange(sender As Object, e As EventArgs) LOGGER.Debug("onCheckBox_CheckedChange") If FormLoaded = False Then Exit Sub End If Dim oCheckbox As CheckBox = sender Try CheckBox_DependingControls(oCheckbox) Checkbox_EnablingControls(oCheckbox) CheckBox_DependingColumn(oCheckbox) Dim oCONTROL_ID = DirectCast(oCheckbox.Tag, ClassControlCreator.ControlMetadata).Guid Dim ofilteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"GUID = {oCONTROL_ID} and Len(SET_CONTROL_DATA) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(ofilteredData, LoadOption.PreserveChanges) If ofilteredData.Rows.Count = 1 Then Dynamic_SetControlData(oCheckbox, ofilteredData.Rows(0)) End If Catch ex As Exception LOGGER.Error(ex) End Try End Sub Public Sub onLookUpselectedValue_Control2Set(sender As Object, SelectedValues As List(Of String)) If FormLoaded = False Then Exit Sub End If LOGGER.Debug("onLookUpselectedValue_Control2Set") Dim oRepositoryItem As RepositoryItemLookupControl3 = sender Dim oLookup As LookupControl3 = oRepositoryItem.OwnerEdit Try If Not IsNothing(SelectedValues) Then If SelectedValues.Count = 1 Then SetControlValues(oLookup, SelectedValues) Else LOGGER.Debug("Attention - onLookUpselectedValue_Control2Set: SelectedValues.Count <> 1 - Not implemented multiple selections!") End If End If Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Sub Dynamic_SetControlData(pControl As Control, oDataRow As DataRow) If FormLoaded = False Then Exit Sub End If LOGGER.Debug("onDynamic_SetControlData") Dim oControlID = DirectCast(pControl.Tag, ClassControlCreator.ControlMetadata).Guid Dim oControl2Set Dim oControlGUID2Set = oControlID Dim oControlname2Set = oDataRow.Item("NAME") LOGGER.Debug($"Workin on SetControLValue for Control [{oControlID}-{oControlname2Set}] ...") If _SetControlValue_in_action = True Then LOGGER.Debug($"..but _SetControlValue_in_action = True ==> Exit Sub!") Exit Sub End If If Not IsDBNull(oDataRow.Item("CONNECTION_ID")) And Not IsDBNull(oDataRow.Item("SET_CONTROL_DATA")) Then Dim oSqlCommand = IIf(IsDBNull(oDataRow.Item("SET_CONTROL_DATA")), "", oDataRow.Item("SET_CONTROL_DATA")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _SetControlValue_in_action = True Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oDataRow.Item("CONNECTION_ID"), $"Dynamic_SetControlData-Control [{oControlID}-{oControlname2Set}]") For Each oRowControl2Set As DataRow In oDTDEPENDING_RESULT.Rows Try oControl2Set = oRowControl2Set.Item("Control2Set") If oControl2Set.ToString.ToUpper = "BTN_FINISH".ToUpper Then Try Try Dim btntext = oRowControl2Set.Item("Caption") btnSave.Text = btntext & " (F2)" Catch ex As Exception End Try Try Dim oColor1 = System.Drawing.Color.FromName(oRowControl2Set.Item("BackgroundColor")) btnSave.BackColor = oColor1 Catch ex As Exception btnSave.BackColor = Color.Transparent End Try Try Dim oColor2 = System.Drawing.Color.FromName(oRowControl2Set.Item("FontColor")) btnSave.ForeColor = oColor2 Catch ex As Exception btnSave.ForeColor = Color.Black End Try Catch ex As Exception End Try _SetControlValue_in_action = False Continue For End If Dim oFound As Boolean = False If IsNumeric(oControl2Set) = False Then LOGGER.Warn("Careful: the oControl2Set contains no CONTROL_GUID") Exit Sub End If For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oControl2Set Then oFound = True LOGGER.Debug($"Got the Control22Set: {oControl2Set}..Setting the values..") 'NUR TEXTBOX Select Case oControl.GetType.ToString Case GetType(TextBox).ToString Dim oTextOption = "Replace" Try oTextOption = oRowControl2Set.Item("TextOption") Catch ex As Exception oTextOption = "Replace" End Try Try Dim oTEXT = oRowControl2Set.Item("Caption") If oTextOption = "Replace" Then oControl.Text = oTEXT Else oControl.Text = oControl.Text & oTEXT End If Catch ex As Exception End Try Dim oColor Try oColor = System.Drawing.Color.FromName(oRowControl2Set.Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception oControl.BackColor = Color.White End Try Try oColor = System.Drawing.Color.FromName(oRowControl2Set.Item("FontColor")) oControl.ForeColor = oColor Catch ex As Exception oControl.ForeColor = Color.Black End Try Case GetType(LookupControl3).ToString Dim oDependingLookup As LookupControl3 = oControl oDependingLookup.Properties.DataSource = oDTDEPENDING_RESULT oDependingLookup.Properties.ValueMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName oDependingLookup.Properties.DisplayMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName Case GetType(GridControl).ToString 'ClassControlCreator.GridTables End Select _SetControlValue_in_action = False Exit For End If Next If oFound = False Then LOGGER.Debug($"Could not find the Control2Set with ID {oControlGUID2Set} on panel!!!") End If Catch ex As Exception LOGGER.Warn($"Error while Dynamic_SetControlData for [{oControlname2Set}]: " & ex.Message) _SetControlValue_in_action = False End Try Next Else LOGGER.Debug($"Error Dynamic_SetControlData: Check ConnID and SQL on NULL VALUES!") End If End Sub Private Sub SetControlValues(LookupControl As LookupControl3, SelectedValues As List(Of String)) Dim oLOOKUPValue = SelectedValues.Item(0) Dim oLOOKUPName = LookupControl.Name LOGGER.Debug($"oLOOKUPValue is [{oLOOKUPValue}]!") Dim oControlID = DirectCast(LookupControl.Tag, ClassControlCreator.ControlMetadata).Guid Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"GUID = {oControlID} and LEN(SET_CONTROL_DATA) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count = 1 Then LOGGER.Debug($"We got a definition for SetControlValues!!") Else Exit Sub End If Dim oControl2Set Dim oControlGUID2Set = oControlID Dim oControlname2Set = oFilteredDatatable.Rows(0).Item("NAME") LOGGER.Debug($"Workin on SetControLValue for {oControlname2Set} ...") If _SetControlValue_in_action = True Then LOGGER.Debug($"..but _SetControlValue_in_action = True ==> Exit Sub!") Exit Sub End If If Not IsDBNull(oFilteredDatatable.Rows(0).Item("CONNECTION_ID")) And Not IsDBNull(oFilteredDatatable.Rows(0).Item("SET_CONTROL_DATA")) Then Dim oSqlCommand = IIf(IsDBNull(oFilteredDatatable.Rows(0).Item("SET_CONTROL_DATA")), "", oFilteredDatatable.Rows(0).Item("SET_CONTROL_DATA")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _SetControlValue_in_action = True Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oFilteredDatatable.Rows(0).Item("CONNECTION_ID"), $"SetControlValues - CTRLID {oControlID}") For Each oRowControl2Set As DataRow In oDTDEPENDING_RESULT.Rows Try oControl2Set = oRowControl2Set.Item("Control2Set") If oControl2Set.ToString.ToUpper = "BTN_FINISH".ToUpper Then Try Try Dim btntext = oRowControl2Set.Item("Caption") btnSave.Text = btntext & " (F2)" Catch ex As Exception End Try Try Dim oColor1 = System.Drawing.Color.FromName(oRowControl2Set.Item("BackgroundColor")) btnSave.BackColor = oColor1 Catch ex As Exception btnSave.BackColor = Color.Transparent End Try Try Dim oColor2 = System.Drawing.Color.FromName(oRowControl2Set.Item("FontColor")) btnSave.ForeColor = oColor2 Catch ex As Exception btnSave.ForeColor = Color.Black End Try Catch ex As Exception End Try _SetControlValue_in_action = False Continue For End If Dim oFound As Boolean = False If IsNumeric(oControl2Set) = False Then LOGGER.Warn("Careful: the oControl2Set contains no CONTROL_GUID") Exit Sub End If 'Dim oDependingLookup As LookupControl3 = pnldesigner.Controls.Find(oDEPENDING_CtrlName, False).FirstOrDefault() For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oControl2Set Then oFound = True LOGGER.Debug($"Got the Control22Set: {oControl2Set}..Setting the values..") Select Case oControl.GetType.ToString Case GetType(TextBox).ToString Dim oTextOption = "Replace" Try oTextOption = oRowControl2Set.Item("TextOption") Catch ex As Exception oTextOption = "Replace" End Try Try Dim oTEXT = oRowControl2Set.Item("Caption") If oTextOption = "Replace" Then oControl.Text = oTEXT Else oControl.Text = oControl.Text & oTEXT End If Catch ex As Exception End Try Dim oColor Try oColor = System.Drawing.Color.FromName(oRowControl2Set.Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception oControl.BackColor = Color.White End Try Try oColor = System.Drawing.Color.FromName(oRowControl2Set.Item("FontColor")) oControl.ForeColor = oColor Catch ex As Exception oControl.ForeColor = Color.Black End Try Case GetType(LookupControl3).ToString Dim oDependingLookup As LookupControl3 = oControl oDependingLookup.Properties.DataSource = oDTDEPENDING_RESULT oDependingLookup.Properties.ValueMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName oDependingLookup.Properties.DisplayMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName Case GetType(GridControl).ToString 'ClassControlCreator.GridTables End Select _SetControlValue_in_action = False Exit For End If Next If oFound = False Then LOGGER.Debug($"Could not find the Control2Set with ID {oControlGUID2Set} on panel!!!") End If Catch ex As Exception LOGGER.Warn($"Error while Control2Set for [{oControlname2Set}]: " & ex.Message) _SetControlValue_in_action = False End Try Next Else LOGGER.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!") End If End Sub Private Sub LookupControl_DependingControls(LookupControl As LookupControl3, SelectedValues As List(Of String)) Dim oLOOKUPValue = SelectedValues.Item(0) Dim oLOOKUPName = LookupControl.Name LOGGER.Debug($"oLOOKUPValue is [{oLOOKUPValue}]!") Dim oControlID = DirectCast(LookupControl.Tag, ClassControlCreator.ControlMetadata).Guid Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oLOOKUPName}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count > 0 Then LOGGER.Debug($"We got {oFilteredDatatable.Rows.Count} depending controls!!") Else LOGGER.Debug($"Sorry NO depending controls!!") End If For Each oRowDependingControl As DataRow In oFilteredDatatable.Rows Dim oDEPENDING_GUID = oRowDependingControl.Item("GUID") Dim oDEPENDING_CtrlName = oRowDependingControl.Item("NAME") LOGGER.Debug($"Control {oDEPENDING_CtrlName} is depending on lookUp {oLOOKUPName}..") If _dependingControl_in_action = True Then LOGGER.Debug($"..but _dependingControl_in_action = True ==> Exit Sub!") Exit Sub End If If Not IsDBNull(oRowDependingControl.Item("CONNECTION_ID")) And Not IsDBNull(oRowDependingControl.Item("SQL_UEBERPRUEFUNG")) Then Dim oSqlCommand = IIf(IsDBNull(oRowDependingControl.Item("SQL_UEBERPRUEFUNG")), "", oRowDependingControl.Item("SQL_UEBERPRUEFUNG")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _dependingControl_in_action = True Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oRowDependingControl.Item("CONNECTION_ID"), $"LookupControl_DependingControls - oControlID: {oControlID}") Try Dim oFound As Boolean = False For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_GUID Then oFound = True LOGGER.Debug($"Got the depending control ID:{oDEPENDING_GUID}..Setting the values..") Select Case oControl.GetType.ToString Case GetType(TextBox).ToString Try Dim oTEXT = oDTDEPENDING_RESULT.Rows(0).Item(0) Try If Not IsNothing(oTEXT) Then If Not IsDBNull(oTEXT) Then oControl.Text = oTEXT End If End If Catch ex As Exception LOGGER.Warn($"Unexpected error in Checking oTEXT: {ex.Message}") End Try Catch ex As Exception LOGGER.Warn($"Unexpected error in Dim oTEXT = oDTDEPENDING_RESULT.Rows(0).Item(0): {ex.Message}") End Try Dim oColor Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception oControl.BackColor = Color.White End Try Try Dim btntext = oDTDEPENDING_RESULT.Rows(0).Item("btnFinishCaption") btnSave.Text = btntext & " (F2)" Catch ex As Exception End Try Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("btnFinishColor")) btnSave.BackColor = oColor Catch ex As Exception btnSave.BackColor = Color.Transparent End Try Case GetType(LookupControl3).ToString Dim oDependingLookup As LookupControl3 = oControl oDependingLookup.Properties.DataSource = oDTDEPENDING_RESULT oDependingLookup.Properties.ValueMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName oDependingLookup.Properties.DisplayMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName Case GetType(GridControl).ToString 'ClassControlCreator.GridTables Case GetType(CheckBox).ToString Try Dim oCheckState = CBool(oDTDEPENDING_RESULT.Rows(0).Item(0)) Dim oDependingChk As CheckBox = oControl oDependingChk.CheckState = oCheckState Dim oColor Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception End Try Catch ex As Exception LOGGER.Warn($"Unexpected error in Checking oCheckBoxDependingControlLOOKUP: {ex.Message}") End Try End Select _dependingControl_in_action = False Exit For End If Next If oFound = False Then LOGGER.Debug($"Could not find the depending Control with ID {oDEPENDING_GUID} on panel!!!") End If Catch ex As Exception LOGGER.Warn($"Error while setting depending control-value for [{oDEPENDING_CtrlName}]: " & ex.Message) _dependingControl_in_action = False End Try SendKeys.Send("{TAB}") ControlHandleStarted = True Else LOGGER.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!") End If Next If oFilteredDatatable.Rows.Count = 1 Then End If End Sub Private Sub CheckBox_DependingControls(pCheckbox As CheckBox) Dim oCheckboxname = pCheckbox.Name LOGGER.Debug($"pCheckStateTrue [{pCheckbox.Checked}]!") Dim oControlID = DirectCast(pCheckbox.Tag, ClassControlCreator.ControlMetadata).Guid Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oCheckboxname}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count > 0 Then LOGGER.Debug($"We got {oFilteredDatatable.Rows.Count} depending controls!!") Else LOGGER.Debug($"Sorry NO depending controls!!") End If For Each oRowDependingControl As DataRow In oFilteredDatatable.Rows Dim oDEPENDING_GUID = oRowDependingControl.Item("GUID") Dim oDEPENDING_CtrlName = oRowDependingControl.Item("NAME") LOGGER.Debug($"Control {oDEPENDING_CtrlName} is depending on lookUp {oCheckboxname}..") If _dependingControl_in_action = True Then LOGGER.Debug($"..but _dependingControl_in_action = True ==> Exit Sub!") Exit Sub End If If Not IsDBNull(oRowDependingControl.Item("CONNECTION_ID")) And Not IsDBNull(oRowDependingControl.Item("SQL_UEBERPRUEFUNG")) Then Dim oSqlCommand = IIf(IsDBNull(oRowDependingControl.Item("SQL_UEBERPRUEFUNG")), "", oRowDependingControl.Item("SQL_UEBERPRUEFUNG")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _dependingControl_in_action = True Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oRowDependingControl.Item("CONNECTION_ID"), $"CheckBox_DependingControls - oControlID: {oControlID}") Try Dim oFound As Boolean = False 'Dim oDependingLookup As LookupControl3 = pnldesigner.Controls.Find(oDEPENDING_CtrlName, False).FirstOrDefault() For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_GUID Then oFound = True LOGGER.Debug($"Got the depending control ID:{oDEPENDING_GUID}..Setting the values..") Select Case oControl.GetType.ToString Case GetType(TextBox).ToString Try Dim oTEXT = oDTDEPENDING_RESULT.Rows(0).Item(0) Try If Not IsNothing(oTEXT) Then If Not IsDBNull(oTEXT) Then oControl.Text = oTEXT End If End If Catch ex As Exception LOGGER.Warn($"Unexpected error in Checking oTEXT: {ex.Message}") End Try Catch ex As Exception LOGGER.Warn($"Unexpected error in Dim oTEXT = oDTDEPENDING_RESULT.Rows(0).Item(0): {ex.Message}") End Try Dim oColor Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception oControl.BackColor = Color.White End Try Try Dim btntext = oDTDEPENDING_RESULT.Rows(0).Item("btnFinishCaption") btnSave.Text = btntext & " (F2)" Catch ex As Exception End Try Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("btnFinishColor")) btnSave.BackColor = oColor Catch ex As Exception btnSave.BackColor = Color.Transparent End Try Case GetType(LookupControl3).ToString Dim oDependingLookup As LookupControl3 = oControl oDependingLookup.Properties.DataSource = oDTDEPENDING_RESULT oDependingLookup.Properties.ValueMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName oDependingLookup.Properties.DisplayMember = oDTDEPENDING_RESULT.Columns.Item(0).ColumnName Case GetType(GridControl).ToString 'ClassControlCreator.GridTables Case GetType(CheckBox).ToString Try Dim oCheckState = CBool(oDTDEPENDING_RESULT.Rows(0).Item(0)) Dim oDependingChk As CheckBox = oControl oDependingChk.CheckState = oCheckState Dim oColor Try oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor")) oControl.BackColor = oColor Catch ex As Exception End Try Catch ex As Exception LOGGER.Warn($"Unexpected error in Checking oCheckBoxDependingControlCHK: {ex.Message}") End Try End Select _dependingControl_in_action = False Exit For End If Next If oFound = False Then LOGGER.Debug($"Could not find the depending Control with ID {oDEPENDING_GUID} on panel!!!") End If Catch ex As Exception LOGGER.Warn($"Error while setting depending control-value for [{oDEPENDING_CtrlName}]: " & ex.Message) _dependingControl_in_action = False End Try SendKeys.Send("{TAB}") ControlHandleStarted = True Else LOGGER.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!") End If Next End Sub Private Sub LookupControl_EnablingControls(LookupControl As LookupControl3, SelectedValues As List(Of String)) Dim oLOOKUPValue = SelectedValues.Item(0) LOGGER.Debug($"LookupControl_EnablingControls [{LookupControl.Name()}] - oLOOKUPValue is [{oLOOKUPValue}]!") Dim oControlID = DirectCast(LookupControl.Tag, ClassControlCreator.ControlMetadata).Guid Controls2beEnabled(LookupControl.Name) End Sub Private Sub Checkbox_EnablingControls(pCheckbox As CheckBox) Dim oControlID = DirectCast(pCheckbox.Tag, ClassControlCreator.ControlMetadata).Guid Controls2beEnabled(pCheckbox.Name) End Sub Private Sub LookupControl_DependingColumn(LookupControl As LookupControl3, SelectedValues As List(Of String)) Dim oSQLColumnDatatable As DataTable = DTGRID_COLUMNS_WITH_SQL.Clone() Dim oExpression = $"SQL_COMMAND like '%#CTRL#{LookupControl.Name}%'" DTGRID_COLUMNS_WITH_SQL.Select(oExpression).CopyToDataTable(oSQLColumnDatatable, LoadOption.PreserveChanges) If oSQLColumnDatatable.Rows.Count > 0 Then For Each oRow As DataRow In oSQLColumnDatatable.Rows Dim oDEPENDING_CONTROL_ID = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("CONTROL_ID") Dim oCONNID = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("CONNECTION_ID") Dim oDEPENDING_COLUMN = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("SPALTENNAME") Dim oSqlCommand = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("SQL_COMMAND") If _dependingColumn_in_action = True Then Exit Sub End If oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _dependingColumn_in_action = True Try Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oCONNID, $"LookupControl_DependingColumn - oDEPENDING_CONTROL_ID: {oDEPENDING_CONTROL_ID}") If Not IsNothing(oDTDEPENDING_RESULT) Then LOGGER.Debug($"Trying to fill the DropDown (DC) for ControlID [{oDEPENDING_CONTROL_ID}]..RowCount: [{oDTDEPENDING_RESULT.Rows.Count}] ") For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_CONTROL_ID Then ClassControlCreator.GridTables.Item(oControl.Name).Add(oDEPENDING_COLUMN, oDTDEPENDING_RESULT) _dependingColumn_in_action = False Exit For End If Next End If Catch ex As Exception LOGGER.Error(ex) _dependingColumn_in_action = False End Try Next End If End Sub Private Sub CheckBox_DependingColumn(pCheckbox As CheckBox) Dim oSQLColumnDatatable As DataTable = DTGRID_COLUMNS_WITH_SQL.Clone() Dim oExpression = $"SQL_COMMAND like '%#CTRL#{pCheckbox.Name}%'" DTGRID_COLUMNS_WITH_SQL.Select(oExpression).CopyToDataTable(oSQLColumnDatatable, LoadOption.PreserveChanges) If oSQLColumnDatatable.Rows.Count > 0 Then For Each oRow As DataRow In oSQLColumnDatatable.Rows Dim oDEPENDING_CONTROL_ID = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("CONTROL_ID") Dim oCONNID = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("CONNECTION_ID") Dim oDEPENDING_COLUMN = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("SPALTENNAME") Dim oSqlCommand = DTGRID_COLUMNS_WITH_SQL.Rows(0).Item("SQL_COMMAND") If _dependingColumn_in_action = True Then Exit Sub End If oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _dependingColumn_in_action = True Try Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oCONNID, $"CheckBox_DependingColumn - oDEPENDING_CONTROL_ID: {oDEPENDING_CONTROL_ID}") If Not IsNothing(oDTDEPENDING_RESULT) Then LOGGER.Debug($"Trying to fill the DropDown (DC) for ControlID [{oDEPENDING_CONTROL_ID}]..RowCount: [{oDTDEPENDING_RESULT.Rows.Count}] ") For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_CONTROL_ID Then ClassControlCreator.GridTables.Item(oControl.Name).Add(oDEPENDING_COLUMN, oDTDEPENDING_RESULT) _dependingColumn_in_action = False Exit For End If Next End If Catch ex As Exception LOGGER.Error(ex) _dependingColumn_in_action = False End Try Next End If End Sub Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs) Dim oCombobox As ComboBox = sender If oCombobox.SelectedIndex <> -1 And _Indexe_Loaded = True Then If oCombobox.Name = last_control.Name Then 'Abschluss() Else Try Dim CONTROL_ID = DirectCast(oCombobox.Tag, ClassControlCreator.ControlMetadata).Guid Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE CONTROL_ACTIVE = 1 AND PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, oCombobox.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql, "OnCmbselectedIndex") If Not IsNothing(DT) And DT.Rows.Count > 0 Then If _dependingControl_in_action = True Then Exit Sub End If Dim _Step = 0 For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString _Step = 1 If Not IsDBNull(ROW.Item("CONNECTION_ID")) And Not IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")) Then _Step = 2 Dim sql_Statement = IIf(IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")), "", ROW.Item("SQL_UEBERPRUEFUNG")) sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, True) _Step = 3 _dependingControl_in_action = True _Step = 4 Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _Step = 5 _dependingControl_in_action = False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result (Combobox) for control: (" & _Step.ToString & ")" & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Controls2beEnabled(oCombobox.Name) Dim ofilteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"GUID = {CONTROL_ID} and Len(SET_CONTROL_DATA) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(ofilteredData, LoadOption.PreserveChanges) If ofilteredData.Rows.Count = 1 Then Dynamic_SetControlData(oCombobox, ofilteredData.Rows(0)) End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result ComboBox - ERROR: " & ex.Message) End Try ControlHandleStarted = True End If End If End Sub Private Sub Controls2beEnabled(pControlName As String) Try Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_ENABLE like '%#CTRL#{pControlName}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count > 0 Then LOGGER.Debug($"We got {oFilteredDatatable.Rows.Count} controls which got enable definitions!!") Else LOGGER.Debug($"Sorry NO controls with enabling definition!!") End If For Each oRowEnablingControl As DataRow In oFilteredDatatable.Rows Dim oENABLE_GUID = oRowEnablingControl.Item("GUID") Dim oENABLE_CtrlName = oRowEnablingControl.Item("NAME") LOGGER.Debug($"Control {oENABLE_CtrlName} is depending on Control: {pControlName}..") If _dependingControl_in_action = True Then LOGGER.Debug($"..but _dependingControl_in_action = True ==> Exit Sub!") Exit Sub End If If Not IsDBNull(oRowEnablingControl.Item("CONNECTION_ID")) And Not IsDBNull(oRowEnablingControl.Item("SQL_ENABLE")) Then Dim oSqlCommand = IIf(IsDBNull(oRowEnablingControl.Item("SQL_ENABLE")), "", oRowEnablingControl.Item("SQL_ENABLE")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) _dependingControl_in_action = True Dim oENABLERESULT As Boolean = ClassDatabase.Execute_Scalar_ConID(oSqlCommand, oRowEnablingControl.Item("CONNECTION_ID"), $"Controls2beEnabled - oENABLE_CTRLID: {oENABLE_GUID}") Try Dim oFound As Boolean = False For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oENABLE_GUID Then oFound = True LOGGER.Debug($"Got the depending control ID:{oENABLE_GUID}..Setting enabled/Disabled...") oControl.Enabled = oENABLERESULT _dependingControl_in_action = False Exit For End If Next If oFound = False Then LOGGER.Debug($"Could not find the enabling Control with ID {oENABLE_GUID} on panel!!!") End If Catch ex As Exception LOGGER.Warn($"Error while setting enabling control-value for [{oENABLE_CtrlName}]: " & ex.Message) _dependingControl_in_action = False End Try Else LOGGER.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!") End If Next Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Sub Controls2beDisabled() Try Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"LEN(SQL_ENABLE) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count > 0 Then LOGGER.Debug($"We got {oFilteredDatatable.Rows.Count} controls which need to be disabled!!") End If For Each oRowEnablingControl As DataRow In oFilteredDatatable.Rows Dim oENABLE_GUID = oRowEnablingControl.Item("GUID") Dim oENABLE_CtrlName = oRowEnablingControl.Item("NAME") For Each oControl As Control In pnldesigner.Controls If oENABLE_GUID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid Then oControl.Enabled = False Exit For End If Next Next Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Sub Controls2B_EnDisabled_on_Load() Try Dim oFilteredDatatable As DataTable = DTCONTROLS.Clone() Dim oExpression = $"LEN(SQL_ENABLE_ON_LOAD) > 0" DTCONTROLS.Select(oExpression).CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) If oFilteredDatatable.Rows.Count > 0 Then LOGGER.Debug($"We got {oFilteredDatatable.Rows.Count} controls which need to be checked dis/enable on load!") End If For Each oRowEnablingControl As DataRow In oFilteredDatatable.Rows Dim oENABLE_GUID = oRowEnablingControl.Item("GUID") Dim oENABLE_CtrlName = oRowEnablingControl.Item("NAME") For Each oControl As Control In pnldesigner.Controls If oENABLE_GUID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid Then LOGGER.Debug($"Found the Control on panel which needs to be checked [{oENABLE_GUID}]...") Dim oSqlCommand = IIf(IsDBNull(oRowEnablingControl.Item("SQL_ENABLE_ON_LOAD")), "", oRowEnablingControl.Item("SQL_ENABLE_ON_LOAD")) Dim oConID = oRowEnablingControl.Item("SQL_ENABLE_ON_LOAD_CONID") If Not IsDBNull(oConID) Then oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) Dim oENABLERESULT As Boolean = ClassDatabase.Execute_Scalar_ConID(oSqlCommand, oRowEnablingControl.Item("SQL_ENABLE_ON_LOAD_CONID"), $"Controls2B_EnDisabled_on_Load - oENABLE_CTRLID: {oENABLE_GUID}") Try LOGGER.Debug($"oENABLERESULT [{oENABLERESULT}]...") oControl.Enabled = oENABLERESULT Catch ex As Exception LOGGER.Warn($"Error en/disabling control onLoad: [{ex.Message}]") End Try Else LOGGER.Warn($"Attention SQL_ENABLE_ON_LOAD_CONID seems to be null!") End If End If Next Next Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Sub Depending_Control_Set_Result(displayboxname As String, sqlCommand As String, sqlConnection As String) Try Dim resultDT As DataTable = ClassDatabase.Return_Datatable_ConStr(sqlCommand, sqlConnection) If Not IsNothing(resultDT) Then 'Ist das Control ein Control was mehrfachwerte enthalten kann If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_LOOKUP) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_TABLE) Then If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Then Dim cmbpanel As ComboBox = pnldesigner.Controls(displayboxname) cmbpanel.DataSource = Nothing cmbpanel.DataSource = resultDT cmbpanel.DisplayMember = resultDT.Columns(0).ColumnName cmbpanel.ValueMember = resultDT.Columns(0).ColumnName 'Dim oMaxWidth As Integer = cmbpanel.Width 'Using oGraphics As Graphics = cmbpanel.CreateGraphics() ' Dim oStringLength = oGraphics.MeasureString(Text, cmbpanel.Font).Width ' If oStringLength + 30 > oMaxWidth Then ' oMaxWidth = oStringLength + 30 ' End If 'End Using 'Using g As Graphics = Me.CreateGraphics ' For Each oItem As Object In cmbpanel.Items 'Für alle Einträge... ' Dim g1 As Graphics = cmbpanel.CreateGraphics ' If g1.MeasureString(Text, cmbpanel.Font).Width + 30 > oMaxWidth Then ' oMaxWidth = g1.MeasureString(Text, cmbpanel.Font).Width + 30 ' End If ' g1.Dispose() ' Next oItem 'End Using 'cmbpanel.DropDownWidth = oMaxWidth ElseIf displayboxname.StartsWith(ClassControlCreator.PREFIX_LOOKUP) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_TABLE) Then LOGGER.Warn("Depending_Control_Set_Result PREFIX_LOOKUP NOT IMPLEMENTED") 'not implemented End If Else If resultDT.Rows.Count = 1 Then pnldesigner.Controls(displayboxname).Text = resultDT.Rows(0).Item(0).ToString Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING or MORE THAN 1 ROW" End If End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Depending_Control_Set_Result - ERROR: " & ex.Message) MsgBox("Unexpected error: " & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE) End Try End Sub Public Sub OnDTPValueChanged(sender As System.Object, e As System.EventArgs) Dim dtp As DateTimePicker = sender If _Indexe_Loaded = True Then ValueDTP = dtp.Value If dtp.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End Sub Private Function CheckValueExists(ByVal control As Control) Try For Each dr As DataRow In DTVWCONTROL_INDEX.Rows If dr.Item("PROFIL_ID") = CURRENT_ProfilGUID And dr.Item("CTRL_NAME") = control.Name Then Dim check = dr.Item("SQL_UEBERPRUEFUNG") If IsDBNull(check) Then LOGGER.Debug("SQL Check is not configured!") Return True End If If check.ToString.Length > 0 And dr.Item("INDEX_NAME") <> "DD PM-ONLY FOR DISPLAY" Then Dim cs As String = ClassDatabase.Get_ConnectionString(dr.Item("CONNECTION_ID")) If allgFunk.CheckValue_Exists(dr.Item("SQL_UEBERPRUEFUNG"), "@Eingabe", control.Text, dr.Item("TYP"), cs, CURRENT_ProfilGUID) = True Then Return True Else errormessage = "the input-value '" & control.Text & "' is not existing in database!" My.Settings.Save() Return False End If Else Return True End If End If Next Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected error in CheckValueExists:" & ex.Message) Return False End Try End Function Public Function IsProcessRunning(name As String) As Boolean 'here we're going to get a list of all running processes on 'the computer For Each Process As Process In Process.GetProcesses() If Process.ProcessName.StartsWith(name) Then 'process found so it's running so return true Return True End If Next 'process not found, return false Return False End Function Function Get_Next_GUID() As Integer Try LOGGER.Debug("Get_Next_GUID...") Dim oNewGUID As Integer LOGGER.Debug("Old Document_Path: " & OLD_Document_Path) Dim oBIT As Integer = 0 If PROFIL_sortbynewest = True Then oBIT = 1 End If Dim oSQL = $"SELECT * from [dbo].[FNPM_GET_NEXT_DOC_INFO] ({CURRENT_ProfilGUID},{oBIT},{CURRENT_DOC_GUID},'{USER_USERNAME}')" Dim oDT As DataTable = ClassDatabase.Return_Datatable(oSQL, "Get_Next_GUID") If oDT.Rows.Count > 0 Then oNewGUID = oDT.Rows(0).Item(0) CURRENT_DOC_ID = oDT.Rows(0).Item(1) Else LOGGER.Info(" >> Attention: in GetNextGUID - Could not get a GUID(1)") oNewGUID = 0 Return oNewGUID End If 'newGUID = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING, True) WMDocPathWindows = "" CURRENT_DOC_PATH = "" CURRENT_WMFILE = Nothing If oNewGUID > 0 Then LOGGER.Debug("newGUID: " & oNewGUID.ToString) ElseIf oNewGUID <> 0 Then LOGGER.Info(" >> Attention: in GetNextGUID - Could not get a GUID(2)") oNewGUID = 0 End If Return oNewGUID Catch ex As Exception LOGGER.Error(ex) oErrMsgMissingInput = "Unexpected error in Get_Next_GUID: " & ex.Message LOGGER.Info(">> Unexpected error in Get_Next_GUID:: " & ex.Message, True) Return 0 End Try End Function Private Function CreateWMObject() As String LOGGER.Debug($"in GetWMDocFileString...'") Dim oWMRELPATH As String = BASEDATA_DT_CONFIG.Rows.Item(0).Item("WM_REL_PATH") If oWMRELPATH.EndsWith("\") = False Then oWMRELPATH = oWMRELPATH & "\" End If Dim oWMOwnPath = WMDocPathWindows.Replace(oWMRELPATH, "") LOGGER.Debug($"oWMOwnPath: {oWMOwnPath}") Try Dim oNormalizedPath = WINDREAM.NormalizePath(oWMOwnPath) CURRENT_WMFILE = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oNormalizedPath) WMDocFileString = oNormalizedPath LOGGER.Debug("WMDocFileString: " & WMDocFileString) Return True Catch ex As Exception Dim _err1 As Boolean = False LOGGER.Error(ex) allgFunk.Insert_LogEntry($"ERROR CreateWMObject >> {ex.Message}") LOGGER.Info("Unexpected error creating WMObject(1) in GetWMDocFileString: " & ex.Message) LOGGER.Info("Error Number: " & Err.Number.ToString) errormessage = $"Could not create a WMObject(1) for [{oWMOwnPath}]!" frmError.ShowDialog() WMDocFileString = "" Return False End Try End Function Private Function GetDocPathWindows(_CheckStandard As Integer) Try Dim oResult As String Dim oSQL = $"SELECT dbo.FNPM_GET_FILEPATH ({CURRENT_DOC_GUID},{_CheckStandard})" oResult = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING, "GetDocPathWindows1") LOGGER.Debug($"Checking file 0 [{oResult}] exists?...") WMDocPathWindows = String.Empty If File.Exists(oResult) = False Then DocPathWindows = oResult LOGGER.Info($"GetWMDocPathWindows returned false [{oResult}] - trying with standard again...") oSQL = $"SELECT [dbo].[FNPM_GET_FILEPATH] ({CURRENT_DOC_GUID},1)" oResult = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING, "GetDocPathWindows2") LOGGER.Debug($"Checking file 1[{oResult}] exists?...") If File.Exists(oResult) = False Then LOGGER.Info($"GetWMDocPathWindows FileExists2 also returned false [{oResult}]!") DocPathWindows = oResult LOGGER.Warn($"GetDocPathWindows: File [{oResult}] not existing!") Return False End If End If WMDocPathWindows = oResult OLD_Document_Path = WMDocPathWindows CURRENT_DOC_PATH = WMDocPathWindows LOGGER.Info($"GetWMDocPathWindows CURRENT_DOC_PATH: {CURRENT_DOC_PATH}") Return True Catch ex As Exception WMDocPathWindows = "" OLD_Document_Path = "" CURRENT_DOC_PATH = "" errormessage = $"Unexpected error in GetDocPathWindows: [{ex.Message}]!" frmError.ShowDialog() Return False End Try End Function Sub Load_IDB_DOC_DATA() Try Dim oSQl As String = IDB_DOC_DATA_SQL oSQl = oSQl.Replace("@DOC_GUID", CURRENT_DOC_GUID) oSQl = oSQl.Replace("@DOC_ID", CURRENT_DOC_ID) oSQl = oSQl.Replace("@DocID", CURRENT_DOC_ID) IDB_DT_DOC_DATA = ClassDatabase.Return_Datatable(oSQl, "Load_IDB_DOC_DATA") Catch ex As Exception LOGGER.Error(ex) End Try End Sub Sub Load_Next_Document(first As Boolean) CURRENT_WMFILE = Nothing activate_controls(False) oErrMsgMissingInput = "" WMDocPathWindows = "" WMDocFileString = "" CURRENT_HTML_DOC = "" 'Me.lblerror.Visible = False _Indexe_Loaded = False LOGGER.Debug("In Load_Next_Document") Try If first = True Then LOGGER.Debug("First Document") CURRENT_WMFILE = Nothing Else LOGGER.Debug("Following Document ") docCounter += 1 End If ' Controls nicht beim ersten Laden leeren If first = False Then Clear_all_Input() End If 'Select Case navtype ' Case "next" ' Case "previous" ' Case "first" ' Case "last" 'End Select LOGGER.Debug($"CURRENT_JUMP_DOC_GUID: {CURRENT_JUMP_DOC_GUID}'") If CURRENT_JUMP_DOC_GUID = 0 Then CURRENT_DOC_GUID = Get_Next_GUID() LOGGER.Debug($"CURRENT_JUMP_DOC_GUID = 0 ## NEW CURRENT_DOC_GUID: {CURRENT_DOC_GUID}'") ElseIf first = False Then CURRENT_DOC_GUID = 0 End If LOGGER.Debug("Dokument-GUID: '" & CURRENT_DOC_GUID.ToString & "'") If CURRENT_DOC_GUID > 0 Then If GetDocPathWindows(0) = False Then SetStatusLabel($"File not accessable: {DocPathWindows}", "DarkOrange") MsgBox("The file can not be diplayed or is not accessable!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) End If If IDB_ACTIVE = False Then If CreateWMObject() = False Then Exit Sub End If Else Load_IDB_DOC_DATA() If IDB_DT_DOC_DATA.Rows.Count = 1 Then LOGGER.Debug("Got one IDB DocData Result") End If End If 'Beschriftung des Navigators 'lblNavigator_anzDok.Text = position & " of " & Anzahl_ValDoks & " files" 'If WMDocPathWindows <> String.Empty Then ' >> >> >> >> >> >>##### Das Dokument in Bearbeitung nehmen ########################### Dim sql = $"UPDATE TBPM_PROFILE_FILES SET IN_WORK = 1, IN_WORK_WHEN = GETDATE(), WORK_USER = '{USER_USERNAME}' WHERE GUID = {CURRENT_DOC_GUID}" ClassDatabase.Execute_non_Query(sql) ' ############ Infos eintragen ################# ' txtDateipfad.Text = Document_Path bsiInformation.Caption = "Datei " & docCounter.ToString & " von " & Anzahl_ValDoks.ToString bsiDocID.Caption = "Document-ID: " & CURRENT_DOC_ID & " - GUID: " & CURRENT_DOC_GUID LOGGER.Debug("AllDocInfo created...") If IDB_ACTIVE = False Then oErrMsgMissingInput = Windream_get_Doc_info() Else ' oErrorMessage = IDB_GetDocInfo() End If If oErrMsgMissingInput = "" Then If WMDocPathWindows <> String.Empty Then load_viewer() LOGGER.Debug("Viewer loaded!") If WMDocPathWindows.ToLower.EndsWith(".pdf") = False Then bbtniAnnotation.Visibility = DevExpress.XtraBars.BarItemVisibility.Never End If End If FillIndexValues(first) For Each oControl As Control In pnldesigner.Controls LoadSQLData(oControl, DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid) Next LOGGER.Debug("Indexmask loaded") 'Nun im Vektoprindex loggen das das Profil geladen wurde 'If PROFIL_VEKTORINDEX <> "" Then ' Dim Profilstring = "DD-PM" & PMDelimiter & "Profil: '" & PROFIL_NAME & "'" & PMDelimiter & USER_NAME & PMDelimiter & Now.ToString ' If Indexiere_VektorfeldPM(Profilstring, PROFIL_VEKTORINDEX) = False Then ' If LogErrorsOnly = False Then LOGGER.Info(" >> Profilname erfolgreich in Vektorfeld PM geschrieben") ' 'Else ' ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' ' My.Settings.Save() ' ' frmError.ShowDialog() ' ' _error = True ' End If 'End If 'Nun loggen das das Profil geladen wurde If PROFIL_LOGINDEX <> "" Then Dim oLogString = $"PMProfile loaded: [{CURRENT_ProfilGUID}-{CURRENT_ProfilName}]{PMDelimiter}{USER_USERNAME}{PMDelimiter}{Now.ToString}" If IDB_ACTIVE = False Then WMIndexVectofield(oLogString, PROFIL_LOGINDEX) Else oLogString = $"PMProfile loaded: [{CURRENT_ProfilGUID}-{CURRENT_ProfilName}]" IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogString) 'LOGGER.Debug("Profilname erfolgreich in Vektorfeld LOG geschrieben") 'Else ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' My.Settings.Save() ' frmError.ShowDialog() ' _error = True End If End If activate_controls(True) Else errormessage = oErrMsgMissingInput frmError.ShowDialog() End If 'Else ' errormessage = oErrorMessage ' frmError.ShowDialog() 'End If Else If oErrMsgMissingInput <> "" Then errormessage = oErrMsgMissingInput frmError.ShowDialog() Else Dim oMsg = "Ende des Profils - Keine weiteren Vorgänge!" If USER_LANGUAGE <> "de-DE" Then oMsg = "End of profile - no more objects!" End If LOGGER.Info(oMsg) Dim oROW As DataRow = ClassAllgemeineFunktionen.GUI_LANGUAGE_MSGBOX("frmValidator.NoMoreDocument") 'Try ' MsgBox(oROW.Item("STRING1"), MsgBoxStyle.Information, oROW.Item("STRING2")) 'Catch ex As Exception ' MsgBox("No more documents! (No translation so far)" & vbNewLine & "Form will be closed now!", MsgBoxStyle.Information, ADDITIONAL_TITLE) 'End Try activate_controls(True) Me.Close() End If End If LOGGER.Debug("frmValidator: LoadNextDocument finished!") Catch ex As Exception LOGGER.Error(ex) allgFunk.Insert_LogEntry($"ERROR LoadNextDocument >> {ex.Message}") errormessage = "unexpected error in Load_Next_Document:" & ex.Message My.Settings.Save() LOGGER.Info("unexpected error in Load_Next_Document: " & ex.Message) frmError.ShowDialog() End Try End Sub Sub load_viewer() DocumentViewerValidator.LoadFile(WMDocPathWindows) DocumentViewerValidator.RightOnlyView(USER_RIGHT_VIEW_ONLY) 'war auskommentiert.....WARUM? If USER_RIGHT_VIEW_ONLY = True Then RibbonPageFile.Visible = False Else RibbonPageFile.Visible = True End If SplitContainer1.Panel2Collapsed = False End Sub Sub activate_controls(status As Boolean) Me.pnldesigner.Enabled = status Me.btnSave.Enabled = status End Sub Private Function Windream_get_Doc_info() Try 'If CultureInfo.CurrentUICulture.ThreeLetterISOLanguageName = "eng" Then ' My.Settings.vIDX_DMS_ERSTELLT = "DMS Created" ' dmsCreated = "DMS Created" ' My.Settings.vIDX_DMS_ERSTELLT_Zeit = "DMS Created Time" ' dmscreatedtime = "DMS Created Time" ' My.Settings.Save() 'Else 'End If Try LOGGER.Debug($"GetVariableValue [{INDEX_DMS_ERSTELLT}]...") CURRENT_DOC_CREATION_DATE = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT) Catch ex As Exception LOGGER.Error(ex) If ex.Message.Contains("Variable: " & INDEX_DMS_ERSTELLT & " not found!") Then LOGGER.Info("1. Ausnahme in Windream_get_Doc_info: Variable: " & INDEX_DMS_ERSTELLT & " not found", True) LOGGER.Info("1. Ausnahme-Fehler: " & ex.Message) If INDEX_DMS_ERSTELLT = "DMS Created" Then INDEX_DMS_ERSTELLT = "DMS erstellt" INDEX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS erstellt") Else INDEX_DMS_ERSTELLT = "DMS Created" INDEX_DMS_ERSTELLT_ZEIT = "DMS Created Time" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt Time") End If CURRENT_DOC_CREATION_DATE = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT) Else LOGGER.Info("error in Windream_get_Doc_info 1: " & ex.Message) Return "error in Windream_get_Doc_info 1: " & ex.Message End If End Try LOGGER.Debug("DMS-Erstellt aus WD: " & CURRENT_DOC_CREATION_DATE) Try LOGGER.Debug($"GetVariableValue [{INDEX_DMS_ERSTELLT_ZEIT}]...") CURRENT_DOC_CREATION_TIME = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Catch ex As Exception If ex.Message.Contains("Variable: " & INDEX_DMS_ERSTELLT_ZEIT & " not found!") Then LOGGER.Info("1. Ausnahme in Windream_get_Doc_info: Variable: " & INDEX_DMS_ERSTELLT_ZEIT & " not found", True) If INDEX_DMS_ERSTELLT = "DMS Created" Then INDEX_DMS_ERSTELLT = "DMS erstellt" INDEX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") Else INDEX_DMS_ERSTELLT = "DMS Created" INDEX_DMS_ERSTELLT_ZEIT = "DMS Created Time" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS Created Time") End If LOGGER.Debug($"GetVariableValue (2) [{INDEX_DMS_ERSTELLT_ZEIT}]...") CURRENT_DOC_CREATION_TIME = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Else LOGGER.Error(ex) LOGGER.Info("error in Windream_get_Doc_info 3: " & ex.Message) Return "error in Windream_get_Doc_info 3: " & ex.Message End If End Try LOGGER.Debug("DMSErstelltZeit aus WD: " & CURRENT_DOC_CREATION_TIME) If CURRENT_DOC_CREATION_TIME.Length > 11 Then CURRENT_DOC_CREATION_DATE = CURRENT_DOC_CREATION_DATE & " " & CURRENT_DOC_CREATION_TIME.Substring(10) Else CURRENT_DOC_CREATION_DATE = CURRENT_DOC_CREATION_DATE & " " & CURRENT_DOC_CREATION_TIME End If Return "" Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("error in Windream_get_Doc_info (GENERELL): " & ex.Message) Return "error in Windream_get_Doc_info (GENERELL): " & ex.Message End Try End Function Private Function Return_VektorArray(ByVal oDocument As WMObject, vktIndexName As String, NIIndexe As Object, CheckDuplikat As Boolean, vType As Object) Dim ValueArray() ' Try Dim missing As Boolean = False Dim Anzahl As Integer = 0 'Jeden Wert des Vektorfeldes durchlaufen Dim wertWD = oDocument.GetVariableValue(vktIndexName) If wertWD Is Nothing = False Then 'Nochmals prüfen ob wirklich Array If wertWD.GetType.ToString.Contains("System.Object") Then 'Keine Duplikatprüfung also einfach neues Array füllen If CheckDuplikat = False Then For Each value As Object In wertWD 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, value) Anzahl += 1 Next 'Und jetzt den/die Neuen Wert(e) anfügen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, NewValue) Anzahl += 1 End If Next Else 'Duplikat Prüfung an, also nur anhängen wenn Wert <> For Each WDValue As Object In wertWD If WDValue Is Nothing = False Then 'Erst einmal die ALten Werte schreiben ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, WDValue) Anzahl += 1 End If Next 'Jetzt die Neuen Werte auf Duplikate überprüfen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, NewValue) Anzahl += 1 Else End If End If Next End If End If Else 'Den/die Neuen Wert(e) anfügen For Each NewValue As Object In NIIndexe If NewValue Is Nothing = False Then If CheckDuplikat = True Then If ValueArray Is Nothing = False Then If ValueArray.Contains(NewValue) = False Then 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, NewValue) Anzahl += 1 Else End If Else 'Dererste Wert, also hinzufügen 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, NewValue) Anzahl += 1 End If Else 'Das Array anpassen ReDim Preserve ValueArray(Anzahl) 'Den Wert im Array speichern ValueArray(Anzahl) = ConvertVectorType(vType, NewValue) Anzahl += 1 End If End If Next End If Return ValueArray 'Catch ex As Exception ' Return ValueArray 'End Try End Function Public Function ConvertVectorType(vType As Object, value As String) Select Case vType Case 36865 ' 36865 'Umwandeln in String Return value Case 4097 '4097 'Umwandeln in String Return value Case 4098 '4098 'Umwandeln in Integer value = value.Replace(" ", "") Return CInt(value) Case 4099 '4099 value = value. Replace(" ", ""). Replace(".", ",") 'Umwandeln in Double Return CDbl(value) Case 4100 '4100 'Umwandeln in Boolean Return CBool(value) Case 4101 '4101 'Umwandeln in Date Return CDate(value) Case 4107 '4107 Return Convert.ToInt64(value) Case 4103 '4103 'Umwandeln in Datum Uhrzeit Return value Case Else 'Umwandeln in String Return value End Select End Function Private Function ReturnVektor_IndexValue(VKTBezeichner As String) Try Dim value Dim name = VKTBezeichner.Replace("[%VKT", "") Dim Sort_Arr() As String Dim i As Integer = 0 'Jetzt im Vektorfeld des Profils nachsehen ob der WErt bereits vorhanden ist Dim wertWD = CURRENT_WMFILE.GetVariableValue(PROFIL_VEKTORINDEX) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then 'es handelt sich um ein Vektorfeld - Zuweisen der Indexwerte des Vektorfeldes zu Array For Each obj As Object In wertWD If obj Is Nothing = False Then ReDim Preserve Sort_Arr(i) Sort_Arr(i) = obj.ToString() i += 1 End If Next 'Das Ergebnis-Array nun Rückwärts sortieren, um die letzte Änderung zu finden For Each _string As Object In Sort_Arr.Reverse() Dim DDPM_String As String = _string.ToString() ' Dim VektorArray() = Split(DDPM_String, PMDelimiter) If VektorArray(1).ToString.ToLower = name.ToLower Then value = VektorArray(2) Exit For End If Next End If End If If value Is Nothing Then value = "" Return value Catch ex As Exception LOGGER.Error(ex) MsgBox("error in ReturnVektor_IndexValue: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE) LOGGER.Info("error in ReturnVektor_IndexValue: " & ex.Message) Return "" End Try End Function Private Function GetVariableValuefromSource(oSourceIndexName As String, Optional oIDBTyp As Integer = 0, Optional FromIDB As Boolean = False) As Object Try Dim oValuefromSource If IDB_ACTIVE = False Then oValuefromSource = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) Else oValuefromSource = IDBData.GetVariableValue(oSourceIndexName, oIDBTyp, FromIDB) End If Return oValuefromSource Catch ex As Exception LOGGER.Error(ex) Return Nothing End Try End Function Sub FillIndexValues(first As Boolean, Optional SingleAttribute As String = "") Dim oControlType As String Dim oIndexName As String Dim oControName As String Dim oIDBOverride As Boolean = False Try If DTVWCONTROL_INDEX.Rows.Count > 0 Then Dim oCount As Integer = 0 For Each oControl As Control In Me.pnldesigner.Controls If SingleAttribute <> "" Then oIDBOverride = True If SingleAttribute <> oControl.Name Then Continue For End If End If Dim oValueFromSource Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid Dim oControlRow = (From form In DTVWCONTROL_INDEX.AsEnumerable() Select form Where form.Item("GUID") = oControlId).Single() Dim oType As String = oControl.GetType.ToString Dim oTyp As String = oControlRow.Item("CTRL_TYPE") Dim oIDBTyp As String If IDB_ACTIVE Then oIDBTyp = oControlRow.Item("IDB_TYP") End If Dim oSourceIndexName As String = oControlRow.Item("INDEX_NAME") ' Wenn kein defaultValue existiert, leeren String setzen Dim oDefaultValue As String = NotNull(oControlRow.Item("DEFAULT_VALUE"), String.Empty) oIndexName = oSourceIndexName oControName = oControl.Name Dim oLoadIndex As Boolean = oControlRow.Item("LOAD_IDX_VALUE") LOGGER.Debug("INDEX: " & oSourceIndexName & " - CONTROLNAME: " & oControl.Name & " - LOAD IDXVALUES: " & oLoadIndex.ToString) _CURRENT_INDEX_ARRAY(oCount, 0) = oSourceIndexName Select Case oType Case "System.Windows.Forms.TextBox" Try oControlType = "Textbox" If oSourceIndexName = "" Then MsgBox("Attention wrong configuration:" & vbNewLine & "for control " & oControl.Name & " no INDEX configured!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then ' Wenn kein Index exisitiert, defaultValue laden oControl.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue LOGGER.Debug("Indexwert soll nicht geladen werden.") Exit Select End If If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) If oValueFromSource Is Nothing Then oValueFromSource = "" Else If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug("TextBox with VektorField: " & oSourceIndexName) Try LOGGER.Debug($"Length of Vektorarray: {oValueFromSource.length}") Catch ex As Exception LOGGER.Info($"Error in gettin the lenth of vektorfield {oSourceIndexName} - {ex.Message}") End Try If oValueFromSource.length = 1 Then oValueFromSource = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") oValueFromSource = oValueFromSource(0) End If LOGGER.Debug($"wertWD has been saved...") End If End If End If Try oControl.Text = NotNull(oValueFromSource, oDefaultValue) _CURRENT_INDEX_ARRAY(oCount, 1) = NotNull(oValueFromSource, oDefaultValue) Catch ex As Exception LOGGER.Info("ERROR while converting defaultValue [" & oDefaultValue & "]: " & ex.Message) oControl.Text = "" _CURRENT_INDEX_ARRAY(oCount, 1) = "" End Try End If Catch ex As Exception LOGGER.Error(ex) errormessage = $"Unvorhergesehener Fehler bei FillIndexValues TextBox [{oControl.Name}]:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() LOGGER.Info("Unexpected error in FillIndexValuesTextBox: " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType) LOGGER.Info(">> Indexname windream: " & oIndexName) Exit Sub End Try Case "System.Windows.Forms.ComboBox" oControlType = "ComboBox" Dim oMyCombobox As ComboBox = oControl Try If oSourceIndexName = "" Then MsgBox("Attention wrong configuration:" & vbNewLine & "for control " & oControl.Name & " no INDEX configured!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then If oDefaultValue = String.Empty Then oMyCombobox.SelectedIndex = -1 Else oMyCombobox.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue End If LOGGER.Debug($" oMyComboBox {oMyCombobox.Name}: Indexwert soll nicht geladen werden.") Exit Select End If If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) End If If oValueFromSource Is Nothing Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} - Indexvalue from index {oSourceIndexName}: Nothing") If oDefaultValue = String.Empty Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wurde nicht gefunden") oMyCombobox.SelectedIndex = -1 Else LOGGER.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wird geladen") oMyCombobox.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue 'cmb.SelectedIndex = cmb.FindStringExact(defaultValue) End If Else If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} - Combobox with VektorField: " & oSourceIndexName) Try LOGGER.Debug($"Length of Vektorarray: {oValueFromSource.length}") Catch ex As Exception LOGGER.Info($"Error in gettin the length of vektorfield {oSourceIndexName} - {ex.Message}") End Try If oValueFromSource.length = 1 Then oValueFromSource = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") oValueFromSource = oValueFromSource(0) End If LOGGER.Debug($"wertWD has been saved...") Else End If LOGGER.Debug($"Indexwert from Index {oSourceIndexName}: {oValueFromSource}") LOGGER.Debug($"Items in Combobox: {oMyCombobox.Items.Count}") _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource LOGGER.Debug($"_CURRENT_INDEX_ARRAY set...") If oMyCombobox.Items.Count = 0 Then ' If LogErrorsOnly = False Then LOGGER.Info($"Index Wert wurde gesetzt") oMyCombobox.Text = oValueFromSource Else ' If LogErrorsOnly = False Then LOGGER.Info($"Index Wert wurde ausgewählt") oMyCombobox.SelectedIndex = oMyCombobox.FindStringExact(oValueFromSource) LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} .SelectedIndex: {oMyCombobox.SelectedIndex}") End If End If End If LOGGER.Debug("") Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Unexpected error in FillIndexValues(Combobox: " & oMyCombobox.Name & "): " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType) LOGGER.Info(">> Indexname windream: " & oIndexName) errormessage = "Unexpected error in FillIndexValues(Combobox: " & oMyCombobox.Name & "): " & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() End Try Case "DevExpress.XtraGrid.GridControl" oControlType = "DevExpress.XtraGrid.GridControl" Dim oMyGridControl As GridControl = oControl Dim oDTColumnsPerDevExGrid As DataTable = DTGRID_COLUMNS.Clone() If oSourceIndexName = "" Then MsgBox("Attention wrong configuration:" & vbNewLine & "for control " & oControl.Name & " no INDEX configured!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical, ADDITIONAL_TITLE) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Then LOGGER.Debug("Indexwert soll nicht geladen werden.") Exit Select End If LOGGER.Debug($"getting wmValue for Index {oSourceIndexName}...") ' Dim wertWD = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) If oValueFromSource Is Nothing = False Then Dim oValueType = oValueFromSource.GetType.ToString LOGGER.Debug($"oValueType is [{oValueType}]!") 'Es wird gegen ein Vektorfeld nachindexiert If oValueType.Contains("System.Object") Or oValueType = "System.Data.DataTable" Or oValueType = "System.String" Then Select Case oTyp 'Tabellendarstellung Case "TABLE" Dim oExpression = $"CONTROL_ID = {oControlId}" DTGRID_COLUMNS.Select(oExpression, "SEQUENCE").CopyToDataTable(oDTColumnsPerDevExGrid, LoadOption.PreserveChanges) Dim oColValuesfromSource As String() LOGGER.Debug($"DevExpressGrid: {oDTColumnsPerDevExGrid.Rows.Count} Columns configured for control {oControlId}.") If oDTColumnsPerDevExGrid.Rows.Count >= 1 Then Dim oDataSource As DataTable = oMyGridControl.DataSource oDataSource.Rows.Clear() If IDB_ACTIVE = False Then LOGGER.Debug("ValueFromSource contains {0} items", oValueFromSource) For Each Zeile As Object In oValueFromSource LOGGER.Debug($"vektorrow Value {Zeile.ToString}...") oColValuesfromSource = Split(Zeile, PMDelimiter) Dim oNewRow = oDataSource.NewRow() LOGGER.Debug("Creating new row..") For index = 0 To oDTColumnsPerDevExGrid.Rows.Count - 1 LOGGER.Debug("Column Index {0}", index) If oColValuesfromSource.Length > index Then LOGGER.Debug("Value: {0}", oColValuesfromSource(index)) oNewRow.Item(index) = oColValuesfromSource(index) Else LOGGER.Debug("Value: String.Empty") oNewRow.Item(index) = String.Empty End If Next LOGGER.Debug("Adding row to grid..") oDataSource.Rows.Add(oNewRow) Next Else If oValueType = "System.String" Then LOGGER.Debug($"IDB Fill Grid [{oControl.Name}] with String") oColValuesfromSource = Split(oValueFromSource.ToString, PMDelimiter) If oColValuesfromSource.Length > 8 Then LOGGER.Warn("Fill Grid Error - Max 8 columns can be configured!") End If Select Case oColValuesfromSource.Length Case 1 oDataSource.Rows.Add(New String() {oColValuesfromSource(0)}) Case 2 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1)}) Case 3 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2)}) Case 4 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3)}) Case 5 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4)}) Case 6 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5)}) Case 7 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5), oColValuesfromSource(6)}) Case 8 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5), oColValuesfromSource(6), oColValuesfromSource(7)}) End Select ElseIf oValueType = "System.Data.DataTable" Then Dim oMyDatatable As DataTable = oValueFromSource LOGGER.Debug($"IDB Fill Grid [{oControl.Name}] with Datatable - Rows: " & oMyDatatable.Rows.Count) For Each oRow As DataRow In oMyDatatable.Rows LOGGER.Debug($"IDB ROW Vector {oRow.Item(0).ToString}...") oColValuesfromSource = Split(oRow.Item(0).ToString, PMDelimiter) 'If USER_USERNAME.ToLower = "'marscheiber" Then MsgBox($"IDB ROW Vector {oRow.Item(0).ToString}...") If oColValuesfromSource.Length > 8 Then LOGGER.Warn("Fill Grid with DatatableSplit Error - Max 8 columns can be configured!") End If Select Case oColValuesfromSource.Length Case 1 oDataSource.Rows.Add(New String() {oColValuesfromSource(0)}) Case 2 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1)}) Case 3 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2)}) Case 4 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3)}) Case 5 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4)}) Case 6 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5)}) Case 7 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5), oColValuesfromSource(6)}) Case 8 oDataSource.Rows.Add(New String() {oColValuesfromSource(0), oColValuesfromSource(1), oColValuesfromSource(2), oColValuesfromSource(3), oColValuesfromSource(4), oColValuesfromSource(5), oColValuesfromSource(6), oColValuesfromSource(7)}) End Select Next End If End If Else End If Case Else 'es handelt sich um ein einfaches Vektorfeld mit einem Wert Dim oDataSource As DataTable = oMyGridControl.DataSource For Each obj As Object In oValueFromSource If obj Is Nothing = False Then oDataSource.Rows.Add(New String() {obj.ToString}) 'dgv.Rows.Add(New String() {obj.ToString}) End If Next End Select Else LOGGER.Warn($"Could not load Devexpress.Grid [{oControl.Name }] as omytype is [{oValueType}]!") End If Else If first = False Then Dim oDataSource As DataTable = oMyGridControl.DataSource If oDataSource.Rows.Count > 0 Then oDataSource.Rows.Clear() End If End If End If Try 'Dim oFilteredDatatable As DataTable = DTGRID_COLUMNS.Clone() 'Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}" 'DTGRID_COLUMNS.Select(oExpression, "SEQUENCE").CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges) Dim oMyGridView As DevExpress.XtraGrid.Views.Grid.GridView = oMyGridControl.MainView oMyGridView.OptionsView.ColumnAutoWidth = False 'AddHandler oMyGridView.ColumnWidthChanged, AddressOf GridControlColumnWidthChanged For Each oRow As DataRow In oDTColumnsPerDevExGrid.Rows For Each oActGridColumn As DevExpress.XtraGrid.Columns.GridColumn In oMyGridView.Columns Dim oGridDXFieldName = oActGridColumn.FieldName Dim GridDXColumnEditName = oActGridColumn.ColumnEditName If oRow.Item("SPALTENNAME") = oGridDXFieldName Then oActGridColumn.Width = oRow.Item("SPALTENBREITE") Exit For End If Next Next Dim i = 0 ' RestoreDevExpressGridControl_Layout(CURRENT_CLICKED_PROFILE_ID, oControlId, oMyGridView) Catch ex As Exception LOGGER.Error(ex) End Try End If Case "System.Windows.Forms.CheckBox" LOGGER.Debug("Loading checkbox...") oControlType = "CheckBox" If oSourceIndexName = "" Then MsgBox("Attention wrong configuration:" & vbNewLine & "for control " & oControl.Name & " no INDEX configured!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical, ADDITIONAL_TITLE) Exit For End If If oSourceIndexName Is Nothing = False Then Dim myCheckBox As CheckBox = oControl If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then LOGGER.Debug("Indexwert soll nicht geladen werden.") End If LOGGER.Debug("Loading Bool-Value from Source...") If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else Try LOGGER.Debug($"..Now GetVariableValue({oSourceIndexName})...") oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) Catch ex As Exception LOGGER.Warn($"Could not get the windreamValue for CheckboxIndex: {oSourceIndexName} [{ex.Message}]") End Try End If If oValueFromSource Is Nothing Then LOGGER.Info(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Checking defaultvalue") LOGGER.Debug(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Checking defaultvalue") If oDefaultValue <> String.Empty Then _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue LOGGER.Info($"Using Default value [{oDefaultValue}]") LOGGER.Debug($"Using Default value [{oDefaultValue}]") myCheckBox.Checked = CBool(oDefaultValue) Exit Select Else LOGGER.Debug("No Default Value for Checkbox - so using false!") myCheckBox.Checked = False myCheckBox.CheckState = CheckState.Unchecked End If Else LOGGER.Debug("oValueFromSource: " & oValueFromSource.ToString) _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString If oValueFromSource.ToString = "" Then LOGGER.Info(">> Versuch, default Value zu laden") If oDefaultValue <> String.Empty Then Dim result = False If Boolean.TryParse(oDefaultValue, result) Then LOGGER.Info(">> defaultValue wurde geladen") myCheckBox.Checked = result If result = False Then myCheckBox.CheckState = CheckState.Unchecked Else myCheckBox.CheckState = CheckState.Checked End If Else myCheckBox.Checked = False myCheckBox.CheckState = CheckState.Unchecked End If Else LOGGER.Info(">> defaultValue war leer") myCheckBox.Checked = False myCheckBox.CheckState = CheckState.Unchecked End If Else Dim _value If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug("CheckBoxValue with VectorField: " & oSourceIndexName) If oValueFromSource.length = 1 Then _value = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") _value = oValueFromSource(0) End If Else _value = oValueFromSource LOGGER.Debug($"Value is not nothing and also not System.Object: [{_value}]") End If Try Select Case CBool(_value) Case True LOGGER.Debug(">> CBool(_value) = True") myCheckBox.Checked = True myCheckBox.CheckState = CheckState.Checked Case False LOGGER.Debug(">> CBool(_value) = False") myCheckBox.Checked = False myCheckBox.CheckState = CheckState.Unchecked End Select Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected error in CBool(wertWD) - CheckBox: " & ex.Message & vbNewLine & "Wert WD: " & oValueFromSource.ToString, True) myCheckBox.Checked = False myCheckBox.CheckState = CheckState.Unchecked End Try End If End If End If Case "DigitalData.Controls.LookupGrid.LookupControl3" Try Dim oLookup As LookupControl3 = oControl oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) 'Dim oWindreamValue = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) Try oLookup.Properties.SelectedValues = Nothing oLookup.Properties.SelectedValues = New List(Of String) Catch ex As Exception End Try If Not IsNothing(oValueFromSource) Then Dim oMyType = oValueFromSource.GetType.ToString If oMyType.Contains("System.Object") Or oMyType = "System.Data.DataTable" Then Dim oArrlist As New List(Of String) If IDB_ACTIVE = False Then For Each oVectorRow As Object In oValueFromSource Dim Ocontent = oVectorRow.ToString oArrlist.Add(Ocontent) Next Else Dim myDT As DataTable = oValueFromSource For Each oVectorRow As DataRow In myDT.Rows Dim Ocontent = oVectorRow.Item(0) oArrlist.Add(Ocontent) Next End If oLookup.Properties.SelectedValues = oArrlist _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString Else Dim oArrlist As New List(Of String) oArrlist.Add(oValueFromSource.ToString) oLookup.Properties.SelectedValues = oArrlist _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString End If Else If Not IsNothing(oLookup.Properties.SelectedValues) Then If oLookup.Properties.SelectedValues.Count = 0 And oDefaultValue <> String.Empty Then Dim oValues As List(Of String) = oDefaultValue.Split(",").ToList() oLookup.Properties.SelectedValues = oValues End If End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & oIndexName & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Add LookupControl3:") End Try Case "System.Windows.Forms.DateTimePicker" oControlType = "DateTimePicker" Dim DTP As DateTimePicker = oControl If oSourceIndexName = "" Then MsgBox("Attention wrong configuration:" & vbNewLine & "for control " & oControl.Name & " no INDEX configured!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical, ADDITIONAL_TITLE) Exit For End If If oSourceIndexName Is Nothing = False Then Try If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then LOGGER.Debug("DATE über PM-Vektor holen") oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) LOGGER.Info(">> DTP is """) Else oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride) End If If oValueFromSource Is Nothing Then oValueFromSource = "" Dim tempdate As Date = CDate("01.01.0001 00:00:00") If oValueFromSource.ToString.Length > 0 Then Try tempdate = CDate(oValueFromSource) LOGGER.Debug("DATE konnte umgewandelt werden") Catch ex As Exception LOGGER.Error(ex) ValueDTP = tempdate LOGGER.Debug("DATE wurde auf heute gesetzt") End Try DTP.Text = tempdate Else LOGGER.Debug("DATE ist leer") ValueDTP = tempdate DTP.Text = tempdate End If _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString Catch ex As Exception LOGGER.Error(ex) errormessage = "Unvorhergesehener Fehler bei DTP: " & vbNewLine & ex.Message LOGGER.Info("Unexpected error in FillIndex DTP: " & ex.Message & vbNewLine & "Wert WD: " & oValueFromSource.ToString & vbNewLine & "Indexname: " & oSourceIndexName, True) frmError.ShowDialog() LOGGER.Info("Unexpected error in FillIndex DTP: " & ex.Message, True) End Try End If 'Case Else ' MsgBox(Type) End Select oCount += 1 Next ' set_foreground() If first_control Is Nothing = False Then first_control.Focus() Try For Each oRow As DataRow In DTGRID_SQL_DEFINITION.Rows Dim oDEPENDING_CTRL_ID = oRow.Item("CONTROL_ID") Dim oDEPENDING_COLUMN = oRow.Item("SPALTENNAME") Dim oSqlCommand = oRow.Item("SQL_COMMAND") Dim oCONNID = oRow.Item("CONNECTION_ID") oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True) Try Dim oDTRESULT_FOR_COLUMN As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oCONNID, $"oDEPENDING_CTRL_ID: {oDEPENDING_CTRL_ID}") If Not IsNothing(oDTRESULT_FOR_COLUMN) Then LOGGER.Debug($"Trying to create a DropDown(FIV) for CONTROL-ID [{oDEPENDING_CTRL_ID}] - RowCount: [{oDTRESULT_FOR_COLUMN.Rows.Count}] ") For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_CTRL_ID Then ClassControlCreator.GridTables.Item(oControl.Name).Add(oDEPENDING_COLUMN, oDTRESULT_FOR_COLUMN) Exit For End If Next Else LOGGER.Warn($"FillIndexValues - oDTRESULT_FOR_COLUMN is nothing!") End If Catch ex As Exception LOGGER.Warn($"FillIndexValues - Unexpected error in creating Grid-Dropdown-Column [{oDEPENDING_COLUMN}] for CONTROL-ID [{oDEPENDING_CTRL_ID}]: " & ex.Message) End Try Next Catch ex As Exception LOGGER.Warn($"FillIndexValues - Unexpected error in creating dropdown for Grid: " & ex.Message) End Try If IDB_ACTIVE = True Then Try Dim oSQL = $"select Attribut, TERM_VALUE from VWIDB_VALUE_TEXT WHERE LANG_CODE = '{USER_LANGUAGE}' AND IDB_OBJ_ID = {CURRENT_DOC_ID} AND Attribut in ('PM_Info1','PM_Info2') ORDER BY Attribut" Dim oDTINFO As DataTable = ClassDatabase.Return_Datatable_ConStr(oSQL, CONNECTION_STRING_IDB_READ) If Not IsNothing(oDTINFO) Then Dim oColor As System.Drawing.Color If oDTINFO.Rows.Count > 0 Then Dim oColumns As String() If oDTINFO.Rows.Count = 1 Then oColumns = Split(oDTINFO.Rows(0).Item("TERM_VALUE"), "#") If oColumns.Length = 1 Then bsiInfo1.Caption = oDTINFO.Rows(0).Item("TERM_VALUE") ElseIf oColumns.Length = 2 Then bsiInfo1.Caption = oColumns(0) Try oColor = System.Drawing.Color.FromName(oColumns(1)) bsiInfo1.ItemAppearance.Normal.ForeColor = oColor Catch ex As Exception End Try End If bsiInfo2.Visibility = DevExpress.XtraBars.BarItemVisibility.Never ElseIf oDTINFO.Rows.Count = 2 Then 'ITEM 1 oColumns = Split(oDTINFO.Rows(0).Item("TERM_VALUE"), "#") If oColumns.Length = 1 Then bsiInfo1.Caption = oDTINFO.Rows(0).Item("TERM_VALUE") ElseIf oColumns.Length = 2 Then bsiInfo1.Caption = oColumns(0) Try oColor = System.Drawing.Color.FromName(oColumns(1)) bsiInfo1.ItemAppearance.Normal.ForeColor = oColor Catch ex As Exception End Try End If 'ITEM 1 oColumns = Split(oDTINFO.Rows(1).Item("TERM_VALUE"), "#") If oColumns.Length = 1 Then bsiInfo2.Caption = oDTINFO.Rows(1).Item("TERM_VALUE") ElseIf oColumns.Length = 2 Then bsiInfo2.Caption = oColumns(0) Try oColor = System.Drawing.Color.FromName(oColumns(1)) bsiInfo2.ItemAppearance.Normal.ForeColor = oColor Catch ex As Exception End Try End If bsiInfo2.Visibility = DevExpress.XtraBars.BarItemVisibility.Always End If RibbonPageGroup2.Visible = True Else LOGGER.Debug($"No PM_Info-Configuration!!") RibbonPageGroup2.Visible = False End If Else LOGGER.Warn($"oDTINFO is nothing!!") RibbonPageGroup2.Visible = False End If Catch ex As Exception LOGGER.Warn($"Unexpected error in Setting PMINFO - ERROR: {ex.Message}") RibbonPageGroup2.Visible = False End Try Else RibbonPageGroup2.Visible = False End If 'Flag setzen das Indexe geladen sind _Indexe_Loaded = True Load_Additional_Searches() Else MsgBox("Für dieses Profil wurde noch keine Eingabemaske definiert!" & vbNewLine & "Informieren Sie Ihren PM-Administrator!" & vbNewLine & "Das Fenster wird geschlossen!", MsgBoxStyle.Exclamation, "Achtung:") Me.Close() End If Catch ex As Exception LOGGER.Warn($"Unexpected error in FillIndexValues: [{oControName} -TYPE: {oControlType}-INDEXNAME: {oIndexName}] ERROR: {ex.Message}") errormessage = "Unvorhergesehener Fehler bei FillIndexValues:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() End Try End Sub Private Sub frmValidation_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown ' Refresh_FileList() Load_Next_Document(True) Controls2B_EnDisabled_on_Load() _dependingControl_in_action = False _dependingColumn_in_action = False Controls2beDisabled() BringToFront() If bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Then _frmValidatorSearch?.BringToFront() End If FormLoaded = True LOGGER.Debug("frmValidation_Shown finished!") End Sub Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click btnSave.Enabled = False ' TODO: Use when working on Validation If ForceGridValidation() = True Then Finish_WFStep() End If btnSave.Enabled = True End Sub Private Function ForceGridValidation() Dim oValidation As Boolean = True Dim oGrids = (From oControl In pnldesigner.Controls Where TypeOf oControl Is GridControl Select oControl).ToList() For Each oGrid As GridControl In oGrids Dim oView As GridView = oGrid.MainView If oView.RowCount = 0 Then Continue For End If If oView.UpdateCurrentRow() = False Then oValidation = False Return False End If If oValidation = False Then Return False End If Next Return True End Function Private Function btnFinish_continue() Try Dim oSQL = PROFIL_FINISH_SQL oSQL = clsPatterns.ReplaceAllValues(oSQL, pnldesigner, True) Dim oDT_ACTIONS As DataTable = ClassDatabase.Return_Datatable(oSQL, "btnFinish_continue") If IsNothing(oDT_ACTIONS) Then MsgBox("Something went wrong in btnFinish_continue - Please check Your log and inform the workflow-team!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) Return False ElseIf oDT_ACTIONS.Rows.Count = 0 Then MsgBox("Something went wrong in btnFinish_continue (No row) - Please check Your log and inform the workflow-team!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) Return False End If 'Select Case'Override' as Action_Type, 'Sind Sie sicher dass Sie nicht zuständig sind?' as Question,'Nicht Zuständig' as Caption,'Red' as Color Dim oMsgType Dim oQuestion Dim oTitle LOGGER.Debug("## btnFinish_continue ##") Try oMsgType = oDT_ACTIONS?.Rows(0).Item("MsgType") Catch ex As Exception oMsgType = "" End Try Try oQuestion = oDT_ACTIONS?.Rows(0).Item("Question") Catch ex As Exception LOGGER.Warn($"btnFinishContinue - No QUESTION-Column in select-Result!") oQuestion = "" End Try Try oTitle = oDT_ACTIONS?.Rows(0).Item("Title") Catch ex As Exception oTitle = "" End Try LOGGER.Debug($"Case is: [{oMsgType.ToString.ToUpper}]") Select Case oMsgType.ToString.ToUpper Case "MsgboxResult".ToUpper If oQuestion <> "" Then Dim result As MsgBoxResult result = MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.Yes Then Return True Else Dim oLogString = $"Msgboxresult [{oQuestion}] = [No]" If IDB_ACTIVE = False Then WMIndexVectofield(oLogString, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogString) End If Return False End If End If Case "MsgboxStop".ToUpper MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Return False Case "Msgbox".ToUpper MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.OK, MessageBoxIcon.Exclamation) Return True Case "Continue".ToUpper Return True Case Else MsgBox($"No valid action provided [{oMsgType}] in btnFinishContinue - Check Your log and inform the WorkflowTeam", MsgBoxStyle.Exclamation, "") LOGGER.Warn($"No valid action provided [{oMsgType}] in btnFinishContinue!") Return False End Select Catch ex As Exception LOGGER.Error(ex) MsgBox("An unhandled exeception occured in btnFinish Procedure! Please inform Your WorkflowTeam and Check Your log!" & vbNewLine & ex.Message, MsgBoxStyle.Critical) Return False End Try End Function Sub Finish_WFStep(Optional includeFI As Boolean = True) btnSave.Enabled = False LOGGER.Debug("Abschluss für Dok: " & CURRENT_DOC_PATH & " gestartet") ItemWorked = True Dim oErrorOcurred As Boolean = False If OverrideAll = False Then 'Eingaben auf Form überprüfen If Check_UpdateIndexe() = True Then If PROFIL_FINISH_SQL <> String.Empty Then If btnFinish_continue() = False Then Exit Sub End If End If If includeFI = True Then Try Dim oSQL = $"SELECT * FROM TBPM_PROFILE_FINAL_INDEXING WHERE PROFIL_ID = {CURRENT_ProfilGUID} AND ACTIVE = 1 ORDER BY SEQUENCE" Dim oDTFinalIndexing As DataTable oDTFinalIndexing = DataASorDB.GetDatatable("DD_ECM", oSQL, "TBPM_PROFILE_FINAL_INDEXING", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE") If oDTFinalIndexing?.Rows.Count > 0 Then 'Jetzt finale Indexe setzen LOGGER.Debug("FINAL INDEXING STARTING...") For Each oFinalIndexRow As DataRow In oDTFinalIndexing.Rows Dim oValue As String = oFinalIndexRow.Item("VALUE").ToString Dim oFinalIndex = oFinalIndexRow.Item("INDEXNAME") Dim oContinueOnIndifferentState As Boolean = CBool(oFinalIndexRow.Item("CONTINUE_INDETERMINED")) Dim oIndexType = 0 If IDB_ACTIVE = False Then oIndexType = WINDREAM.GetTypeOfIndex(oFinalIndexRow.Item("INDEXNAME")) End If If oValue.ToUpper = "SQL-Command".ToUpper Then '###### Indexierung mit variablen SQL ### LOGGER.Debug("Indexing wih dynamic sql...") Dim oGUID = oFinalIndexRow.Item("GUID") Dim oSQLCommand = oFinalIndexRow.Item("SQL_COMMAND") Dim oConnectionID = oFinalIndexRow.Item("CONNECTION_ID") oSQLCommand = clsPatterns.ReplaceAllValues(oSQLCommand, pnldesigner, True) If IsNothing(oSQLCommand) Then errormessage = "Error while replacing Values in final indexing - Check the log" My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False End If If Not IsNothing(oSQLCommand) Then Dim oResultfromSQL = ClassDatabase.Execute_Scalar_ConID(oSQLCommand, oConnectionID, "FinalIndex - oGUID: {oGUID}") If Not IsNothing(oResultfromSQL) Then LOGGER.Debug($"oResultfromSQL is [{oResultfromSQL.ToString}]") If IsDBNull(oResultfromSQL) Then If oContinueOnIndifferentState = False Then errormessage = "Result from SQL is DBNull - Check the SQL and the log" My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False Else LOGGER.Warn($"FinalIndexResult from SQL is DBNull - AttributeName [{oFinalIndexRow.Item("INDEXNAME")}] - oContinueOnIndifferentState = true, Continuing with next Attribute and Replacing with empty String") oResultfromSQL = "" Continue For End If End If If Len(oResultfromSQL) = 0 Then If oContinueOnIndifferentState = False Then errormessage = "Result from SQL is EmptyValue - Check the SQL and the log" My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False Else LOGGER.Warn($"FinalIndexResult from SQL is EmptyValue - AttributeName [{oFinalIndexRow.Item("INDEXNAME")}] - oContinueOnIndifferentState = true, So continuing with next Attribute") Continue For End If End If oValue = oResultfromSQL Else LOGGER.Warn("ATTENTION: DYNAMIC VALUE IS NOTHING!") Continue For End If End If Else If oValue.StartsWith("v") Then Select Case oFinalIndexRow.Item("VALUE").ToString Case "vDate" oValue = Now.ToShortDateString Case "vUserName" oValue = USER_USERNAME Case Else oValue = oFinalIndexRow.Item("VALUE") End Select End If End If If oErrorOcurred Then Exit For End If Dim oResult() As String ReDim Preserve oResult(0) oResult(0) = oValue LOGGER.Debug($"oIndexType {oIndexType.ToString}") If oIndexType > 4000 And oIndexType < 5000 Then 'If dr.Item("INDEXNAME").ToString.StartsWith("[%VKT") Then ' Dim PM_String = Return_PM_VEKTOR(value, dr.Item("INDEXNAME")) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oValue, oFinalIndexRow.Item("INDEXNAME"), oFinalIndexRow.Item("PREVENT_DUPLICATES"), oFinalIndexRow.Item("ALLOW_NEW_VALUES")) = False Then LOGGER.Debug("Final Vektorindex '" & oFinalIndexRow.Item("INDEXNAME").ToString & "' has beens et suxxessfully!") Else errormessage = "Error in final indexing:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False End If Else LOGGER.Debug("Now the final indexing...") If oValue.ToUpper = "SQL-Command".ToUpper Then MsgBox("Something went wrong while final-indexing. Check Your log and inform the admin-team!", MsgBoxStyle.Critical, ADDITIONAL_TITLE) LOGGER.Warn("Something went wrong while final-indexing") Exit For End If Dim oFIResult As Boolean = False If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oFinalIndexRow.Item("INDEXNAME"), oResult) = True Then oFIResult = True LOGGER.Debug("FINALER INDEX '" & oFinalIndexRow.Item("INDEXNAME") & "' WURDE ERFOLGREICH GESETZT") 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim logstr = Return_LOGString(oValue, "DDFINALINDEX", oFinalIndexRow.Item("INDEXNAME")) WMIndexVectofield(logstr, PROFIL_LOGINDEX) End If End If Else If IDBData.SetVariableValue(oFinalIndexRow.Item("INDEXNAME"), oValue) = True Then oFIResult = True LOGGER.Debug($"Final index IDB '{oFinalIndexRow.Item("INDEXNAME")}' was updated with [{oValue.ToString}]") End If End If If oFIResult = False Then errormessage = "Error in final indexing:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False End If End If If oErrorOcurred = True Then ItemWorked = False Exit For End If Next End If Catch ex As Exception LOGGER.Warn($"Error in finalIndexing: {ex.Message}") oErrorOcurred = True End Try End If Try ''Wenn kein Fehler nach der finalen Indexierung gesetzt wurde If Override = True And Override_SQLCommand <> "" Then ClassDatabase.Execute_non_Query(Override_SQLCommand) End If If oErrorOcurred = False Then Dim WORK_HISTORY_ENTRY = Nothing Try WORK_HISTORY_ENTRY = CURRENT_DT_PROFILE.Rows(0).Item("WORK_HISTORY_ENTRY") If IsDBNull(WORK_HISTORY_ENTRY) Then WORK_HISTORY_ENTRY = Nothing End If Catch ex As Exception LOGGER.Error(ex) WORK_HISTORY_ENTRY = Nothing End Try If Not IsNothing(WORK_HISTORY_ENTRY) Then If WORK_HISTORY_ENTRY <> String.Empty Then Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' die Vorkommen im SQL-String auslesen Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(WORK_HISTORY_ENTRY) '#### ' alle Vorkommen innerhalb der Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente Try LOGGER.Debug("element in RegeX WORK_HISTORY_ENTRY: " & element.Value) Dim CTRL_ID = element.Value.Substring(2, element.Value.Length - 3) CTRL_ID = CTRL_ID.Replace("CTRLID", "") Dim value_from_control If IsNumeric(CTRL_ID) Then For Each oControl As Control In Me.pnldesigner.Controls Try If IsNothing(DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid) Then Continue For End If Catch ex As Exception Continue For End Try If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = CTRL_ID Then '###### Dim Type As String = oControl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" Try value_from_control = oControl.Text Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = oControl Try value_from_control = cmb.Text Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = oControl Try value_from_control = dtp.Value.ToString Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = oControl Try value_from_control = chk.Checked Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try End Select End If Next End If If Not IsNothing(value_from_control) Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace(element.Value, value_from_control) End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Checking control values for WORK_HISTORY_ENTRY - ERROR: " & ex.Message) End Try Next If WORK_HISTORY_ENTRY.ToString.Contains("@DATE") Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace("@DATE", Now.ToShortDateString) End If If WORK_HISTORY_ENTRY.ToString.Contains("@USERNAME") Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace("@USERNAME", USER_USERNAME) End If Else WORK_HISTORY_ENTRY = "" End If End If Dim ins = String.Format("INSERT INTO TBPM_FILES_WORK_HISTORY (PROFIL_ID, DOC_ID,WORKED_BY,WORKED_WHERE,STATUS_COMMENT) VALUES ({0},{1},'{2}','{3}','{4}')", CURRENT_ProfilGUID, CURRENT_DOC_ID, USER_USERNAME, Environment.MachineName, WORK_HISTORY_ENTRY) ClassDatabase.Execute_non_Query(ins) Dim oFIsql As String 'Close_document_viewer() If WMDocPathWindows.ToLower.EndsWith(".pdf") Then If Not IsNothing(WORK_HISTORY_ENTRY) Then If CBool(CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then oFIsql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBPM_FILES_WORK_HISTORY WHERE PROFIL_ID = {0} AND DOC_ID = {1})", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRY As DataTable = ClassDatabase.Return_Datatable(oFIsql, "Finish_WFStep2") If Not IsNothing(DT_ENTRY) Then If DT_ENTRY.Rows.Count = 1 Then Dim AnnotationString = DT_ENTRY.Rows(0).Item("WORKED_WHEN") & " " & DT_ENTRY.Rows(0).Item("WORKED_BY") & ": " & DT_ENTRY.Rows(0).Item("STATUS_COMMENT") ClassAnnotation.Annotate_PDF("Workflow-State:", AnnotationString, 0, False) End If End If End If Dim oAnnotateAllWHEs = CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_ALL_WORK_HISTORY_ENTRIES") If CBool(oAnnotateAllWHEs) = True Then oFIsql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE DOC_ID = {1} ORDER BY GUID", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRIES As DataTable = ClassDatabase.Return_Datatable(oFIsql, "Finish_WFStep3") If Not IsNothing(DT_ENTRIES) Then If DT_ENTRIES.Rows.Count > 0 Then Dim AnnotationString As String = "" For Each rw As DataRow In DT_ENTRIES.Rows AnnotationString = AnnotationString & rw.Item("WORKED_WHEN") & " " & rw.Item("WORKED_BY") & ": " & rw.Item("STATUS_COMMENT") & vbNewLine Next ClassAnnotation.Annotate_PDF("Workflow History:", AnnotationString, 0, False, 10, 40) End If End If End If End If End If 'wenn Move2Folder aktiviert wurde If Move2Folder <> "" Then idxerr_message = allgFunk.Move2Folder(WMDocPathWindows, Move2Folder, CURRENT_ProfilGUID, WINDREAM_ALLG) If idxerr_message <> "" Then errormessage = "Fehler bei Move2Folder:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False End If End If 'Validierungsfile löschen wenn vorhanden 'allgFunk.Delete_xffres(WMDocPathWindows, _windream) 'LOGGER.Debug("Delete_xffres ausgeführt") End If Catch ex As Exception LOGGER.Error(ex) errormessage = "Unexpected error in Finish:" & ex.Message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True ItemWorked = False LOGGER.Info("Unexpected error in Finish: " & ex.Message, True) Exit Sub End Try Else 'lblerror.Visible = True 'lblerror.Text = errmessage errormessage = oErrMsgMissingInput frmError.ShowDialog() oErrorOcurred = True ItemWorked = False Exit Sub End If Else LOGGER.Info($"Overriding all in action for DocID: {CURRENT_DOC_ID} - ProfileID: {CURRENT_ProfilGUID}") If Override_SQLCommand <> "" Then If ClassDatabase.Execute_non_Query(Override_SQLCommand) = False Then oErrorOcurred = True End If End If End If If oErrorOcurred = True Then MsgBox("Unhandled error occured ... please check your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) ItemWorked = False Else 'Das Dokument freigeben und as editiert markieren 'Dim sql = String.Format("UPDATE TBPM_PROFILE_FILES SET IN_WORK = 0, IN_WORK_WHEN = NULL, WORK_USER = '{0}', EDIT = 1 WHERE GUID = {1}", USER_USERNAME, CURRENT_DOC_GUID) 'ClassDatabase.Execute_non_Query(sql) Anzahl_validierte_Dok += 1 'tstrlbl_Info.Text = "Anzahl Dateien: " & TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(PROFIL_ID) LOGGER.Debug("Validation of document ended successfully!") Dim oPROCSQL = $"EXEC PRPM_CHECK_NEXT_WF {CURRENT_DOC_GUID}" ClassDatabase.Execute_non_Query(oPROCSQL) End If If CURRENT_JUMP_DOC_GUID <> 0 Then Me.Close() Else 'Das nächste Dokument laden Load_Next_Document(False) ' set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If btnSave.Enabled = True End Sub Function Check_Missing(control As Control, typ As String) Select Case typ Case "txt" If control.Text = String.Empty Then Return True End If Return False End Select End Function Function Return_PM_VEKTOR(input As String, VKTBezeichner As String) Dim PM_String As String Try Dim Bezeichner As String = VKTBezeichner.Replace("[%VKT", "") PM_String = "DD-PM" & PMDelimiter & Bezeichner & PMDelimiter & input & PMDelimiter & USER_USERNAME & PMDelimiter & Now.ToString Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> error in Return_PM_VEKTOR: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Function Return_LOGString(input As String, old As String, indexname As String) Dim PM_String As String Try If old = "DDFINALINDEX" Then PM_String = $"DD-PMLog-FINAL{PMDelimiter}{indexname}{PMDelimiter}{input}{PMDelimiter}{USER_USERNAME}{PMDelimiter}{Now.ToString}" Else PM_String = $"DD-PMLog-CHG{PMDelimiter}{indexname}{PMDelimiter}NEW: [{input}] - OLD: [{old}]{PMDelimiter}{USER_USERNAME}{PMDelimiter}{Now.ToString}" End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> error in Return_LOGString: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Private Function WMIndexVectofield(input As String, NameVKTIndex As String, Optional PreventDuplicates As Boolean = False, Optional AllowAddNewValues As Boolean = True, Optional IndexBehaviour As String = "Add") Dim oOldValue As Object = CURRENT_WMFILE.GetVariableValue(NameVKTIndex) Dim oValueList As New List(Of Object) Dim oNewValue As Object() Dim oMissing As Boolean = False If oOldValue IsNot Nothing AndAlso TypeOf oOldValue Is Object Then ' If new values are allowed, add the old values first If AllowAddNewValues Then oValueList = DirectCast(oOldValue, Object()).ToList() End If ' Add the new value oValueList.Add(input) Else ' Just add input as the only value oValueList.Add(input) End If If PreventDuplicates Then oValueList = oValueList. Distinct(). ToList() End If oNewValue = oValueList.ToArray() If oNewValue.Length > 0 Then 'Jetzt die Datei indexieren If Indexiere_File(CURRENT_WMFILE, NameVKTIndex, oNewValue) = False Then oMissing = True LOGGER.Info("Error while indexing Vektorfeld '" & NameVKTIndex & "' - ERROR: " & idxerr_message) oErrMsgMissingInput = "Error while indexing Vektorfeld '" & NameVKTIndex & "' - ERROR: " & idxerr_message End If End If Return oMissing End Function Function DT_FOR_ARRAY(pArr As String()) As DataTable Dim odt As New DataTable odt.Columns.Add("ID", GetType(Integer)) odt.Columns.Add("Result", GetType(String)) Dim N As Integer = odt.Columns("ID").AutoIncrement For Each oStr In pArr odt.Rows.Add(N, oStr) Next Return odt End Function Function Check_UpdateIndexe() As Boolean Dim oControlName Dim oControlId As String Try Dim oMissing As Boolean = False 'Jedes Control auf panel durchlaufen For Each oControl As Control In Me.pnldesigner.Controls 'Der input der Box,Cmb muss jedes mal geleert werden Dim oMyInput As String = "" 'Jedes Control in Konfig Tab durchlaufn For Each oControlRow As DataRow In DTVWCONTROL_INDEX.Rows Dim oCtrlType = oControlRow.Item("CTRL_TYPE").ToString If oCtrlType = "LBL" Or oCtrlType = "LINE" Or oCtrlType = "BUTTON" Then Continue For End If 'Den Indexnamen auslesen Dim oIndexName As String = oControlRow.Item("INDEX_NAME") Dim oIsRequired As Boolean = CBool(oControlRow.Item("VALIDATION")) Dim oSQLCheckCommand As String = IIf(IsDBNull(oControlRow.Item("SQL_UEBERPRUEFUNG")), "", oControlRow.Item("SQL_UEBERPRUEFUNG")) Dim oIsReadOnly As Boolean = CBool(oControlRow.Item("READ_ONLY")) Dim oControlType As String = oControlRow.Item("CTRL_TYPE") Dim oIDBTyp As Integer If IDB_ACTIVE Then oIDBTyp = oControlRow.Item("IDB_TYP") End If oControlId = oControlRow.Item("GUID") Dim oRegexMatch As String = NotNull(oControlRow.Item("REGEX_MATCH"), String.Empty) Dim oRegexMessage As String = NotNull(oControlRow.Item("REGEX_MESSAGE_DE"), String.Empty) oControlName = oControlRow.Item("CTRL_NAME") Dim oOVERWRITE_DATA = oControlRow.Item("OVERWRITE_DATA") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist If oControlRow.Item("CTRL_NAME") = oControl.Name And oIndexName <> "DD PM-ONLY FOR DISPLAY" Then '(oIsReadOnly = False Or oSQLCheckCommand <> "") And LOGGER.Debug("Indexierung für Control (" & oControlId & ") '" & oControlName & "' gestartet. Indexname '" & oIndexName & "'") If oIndexName = "" Then LOGGER.Info(" >> Indexname is unexpected empty.") Continue For End If Dim Type As String = oControl.GetType.ToString Select Case Type Case "DigitalData.Controls.LookupGrid.LookupControl3" Try Dim lookup As LookupControl3 = oControl If lookup.Properties.SelectedValues.Count = 0 And oIsRequired = True Then oMissing = True oErrMsgMissingInput = $"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'" LOGGER.Warn($"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'") oControl.BackColor = Color.Red Exit For Else If lookup.Properties.MultiSelect = True Then Dim oLookupRows As Integer = lookup.Properties.SelectedValues.Count 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oLookupRows > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each value As String In lookup.Properties.SelectedValues If value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = value ZeilenGrid += 1 End If Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message LOGGER.Warn($"Error while indexing [{oIndexName}] von LookupGrid - ERROR: " & idxerr_message) Exit For End If Else Dim oMyDT = DT_FOR_ARRAY(myVektorArr) If IDBData.SetVariableValue(oIndexName, oMyDT, oOVERWRITE_DATA, oIDBTyp) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing IDB-Object LookupGrid" LOGGER.Warn($"Error while indexing IDB-Object LookupGrid [{oIndexName}] ") Exit For End If End If Else Dim oValues As New List(Of Object) From {String.Empty} If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, oValues.ToArray) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing von LookupGrid - ERROR: " & idxerr_message LOGGER.Warn($"Error while indexing LookupGrid [{oIndexName}] ") Exit For End If Else For Each ochangedLookub In listChangedLookup If lookup.Name = ochangedLookub Then IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) Exit For End If Next End If End If Else oMyInput = lookup.Properties.SelectedValues.FirstOrDefault() If IsNothing(oMyInput) And oIsRequired = True Then oMissing = True oErrMsgMissingInput = $"Could not get FirstOrDefault-Value of LookUpGrid! - LookUPGridName: {lookup.Name}" LOGGER.Warn(oErrMsgMissingInput) Exit For ElseIf IsNothing(oMyInput) And oIsRequired = False Then For Each ochangedLookub In listChangedLookup If lookup.Name = ochangedLookub Then IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) Exit For End If Next Continue For End If 'den aktuellen Wert in windream auslesen Dim oValueFromObject If oIndexName.StartsWith("[%VKT") Then oValueFromObject = ReturnVektor_IndexValue(oIndexName) Else oValueFromObject = GetVariableValuefromSource(oIndexName, oIDBTyp) Dim oValueIsIndifferent As Boolean = False If Not IsNothing(oValueFromObject) Then If IDB_ACTIVE = False Then If oValueFromObject.ToString = "System.Object[]" Then If oValueFromObject.Length = 1 Then oValueFromObject = oValueFromObject(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oValueFromObject = oValueFromObject(0) End If End If End If Else oValueFromObject = "" End If If IsNothing(oValueFromObject) Then LOGGER.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is NOTHING!") oValueIsIndifferent = True End If If oValueIsIndifferent = False Then If IsDBNull(oValueFromObject) Then LOGGER.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is DBNULL!") oValueIsIndifferent = True End If End If Dim oValueSourceIsDifferent As Boolean = False If oValueIsIndifferent = False Then LOGGER.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is [{oValueFromObject}]") Try If oValueFromObject <> oMyInput Then oValueSourceIsDifferent = True LOGGER.Debug($"CheckUpdateIndex.LookUpGrid: There is a difference between oValueFromObject and [{oValueFromObject}]") End If Catch ex As Exception oValueSourceIsDifferent = True LOGGER.Debug($"oValueFromObject <> oMyInput not possible as one object might be a multiple row object") End Try Else End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden 'IsNothing(oValueFromObject) Or oValueFromObject <> oMyInput If (oValueIsIndifferent = True Or oValueSourceIsDifferent = True) Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrMsgMissingInput = "Error while indexing Textbox as VEKTOR - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then Dim result() As String ReDim Preserve result(0) result(0) = oMyInput If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing Textbox - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then Dim oLogStr = Return_LOGString(oMyInput, oValueFromObject, oIndexName) WMIndexVectofield(oLogStr, PROFIL_LOGINDEX) 'Else ' IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogStr) End If End If 'Nun das Logging End If End If End If End If End If Catch ex As Exception LOGGER.Error(ex) End Try Case "System.Windows.Forms.TextBox" Try Dim oWrongInputMessage = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.WrongInputControl") If oRegexMatch <> String.Empty AndAlso Not Regex.IsMatch(oControl.Text, oRegexMatch) Then oMissing = True oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" LOGGER.Warn(oErrMsgMissingInput) If oRegexMessage <> String.Empty Then oErrMsgMissingInput &= ":" & vbCrLf & oRegexMessage End If oControl.BackColor = Color.Red Exit For End If 'as erstes überprüfen ob überhaupt etwas eingetragen worden ist If Check_Missing(oControl, "txt") = True And oIsRequired = True Then 'NICHTS EINGETRAGEN oMissing = True oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'" LOGGER.Warn(oErrMsgMissingInput) oControl.BackColor = Color.Red Exit For Else oMyInput = oControl.Text 'den aktuellen Wert in windream auslesen Dim oSourceValue = GetVariableValuefromSource(oIndexName, oIDBTyp) If oIndexName.StartsWith("[%VKT") Then oSourceValue = ReturnVektor_IndexValue(oIndexName) Else 'wertWD = CURRENT_WMFILE.GetVariableValue(oIndexName) If Not IsNothing(oSourceValue) Then If oSourceValue.ToString = "System.Object[]" Then If oSourceValue.Length = 1 Then oSourceValue = oSourceValue(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oSourceValue = oSourceValue(0) End If End If Else oSourceValue = "" End If End If Dim oSetValue As Boolean = False If IsDBNull(oSourceValue) Then oSetValue = True End If If oSetValue = False Then If IsNothing(oSourceValue) Then oSetValue = True End If End If If oSetValue = False Then Try If oSourceValue <> oMyInput Then oSetValue = True End If Catch ex As Exception oSetValue = True End Try End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oSetValue = True Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrMsgMissingInput = "Error while indexing textbox as VEKTOR - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then Dim result() As String ReDim Preserve result(0) result(0) = oMyInput If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing Textbox - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then Dim oMyLogString = Return_LOGString(oMyInput, oSourceValue, oIndexName) WMIndexVectofield(oMyLogString, PROFIL_LOGINDEX) 'Else 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oMyLogString) End If End If End If End If End If Catch ex As Exception oErrMsgMissingInput = "Unexpected error in Check_UpdateIndexe TextBox '" & oControl.Name & "' - Check the log" LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) LOGGER.Warn("Unexpected error in Check_UpdateIndexe TextBox :" & ex.Message, True) Return False End Try Case "System.Windows.Forms.ComboBox" Try LOGGER.Debug($"Working on Combobox...") Dim cmb As ComboBox = oControl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If cmb.SelectedIndex = -1 And oIsRequired = True Then oMissing = True oErrMsgMissingInput = "Please Choose an entry out of ComboBox '" & cmb.Name & "'" LOGGER.Warn(oErrMsgMissingInput) Exit For 'ElseIf cmb.SelectedIndex <> -1 Then Else 'Änderung 28.08.2018: Ein leerer Wert in der Combobox wird in den Index geschrieben oMyInput = cmb.Text LOGGER.Debug($"inputvalue Combobox: {cmb.Text}") Dim oValue 'den aktuellen Wert in windream auslesen If oIndexName.StartsWith("[%VKT") Then oValue = ReturnVektor_IndexValue(oIndexName) Else oValue = GetVariableValuefromSource(oIndexName, oIDBTyp) End If If IsNothing(oValue) Then LOGGER.Debug($"oValue is nothing...Value EmptyString will be used") oValue = String.Empty End If Dim oIndexType As String = "Index" Try If oValue.ToString = "System.Object[]" Then oIndexType = "Vector" End If Catch ex As Exception LOGGER.Debug($"Exception while oValue.ToString = System.Object[]...") End Try If oIndexType = "Vector" Then LOGGER.Debug($"Control with ID{oControlId} is a vectorfield...") If oValue.Length = 1 Then oValue = oValue(0).ToString Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oValue = oValue(0).ToString End If Else LOGGER.Debug($"oValue is a regular item...") Dim oitsadifference As Boolean = False Try If oValue.ToString <> oMyInput.ToString Then oitsadifference = True End If Catch ex As Exception LOGGER.Warn($"Could not convert the oValue of Control with ID{oControlId}...") LOGGER.Error(ex.Message) oitsadifference = True End Try 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oitsadifference = True Then LOGGER.Debug($"Index with ID{oControlId} will now be indexed...") 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrMsgMissingInput = "Error while indexing Combobox as VEKTOR - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then Dim result() As String ReDim Preserve result(0) result(0) = oMyInput If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then cmb.DroppedDown = True oMissing = True oErrMsgMissingInput = "Error while indexing Combobox - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then cmb.DroppedDown = True oMissing = True oErrMsgMissingInput = "Error indexing combobox idb" LOGGER.Warn(oErrMsgMissingInput) Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then Dim ologStr = Return_LOGString(oMyInput, oValue, oIndexName) WMIndexVectofield(ologStr, PROFIL_LOGINDEX) 'Else 'IDBData.SetVariableValue(PROFIL_LOGINDEX, ologStr) End If End If 'Nun das Logging End If Else LOGGER.Debug($"oitsadifference = False...Index with ID {oControlId} will not be indexed...") 'Wenn der Wert in ein Vektorfeld geschrieben wird End If End If End If Catch ex As Exception LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId} " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Error:") LOGGER.Info($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId}" & ex.Message) Return False End Try Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = oControl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And dtp.Value.ToString = String.Empty Then oMissing = True oErrMsgMissingInput = "Please Choose DateValue for field'" & dtp.Name & "'" LOGGER.Warn(oErrMsgMissingInput) Exit For ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then oMyInput = CDate(dtp.Value) 'den aktuellen Wert in windream auslesen ' Dim wertWD As String = CURRENT_WMFILE.GetVariableValue(_IDXName) Dim oObjectValue If oIndexName.StartsWith("[%VKT") Then oObjectValue = ReturnVektor_IndexValue(oIndexName) Else oObjectValue = GetVariableValuefromSource(oIndexName, oIDBTyp) End If If IsNothing(oObjectValue) Then oObjectValue = CDate("01.01.1900") End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oObjectValue <> oMyInput Then 'Wenn der WErt in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then 'Input = die String komponente as String oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrMsgMissingInput = "Error while indexing DatePicker as VEKTOR - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then Dim result() ReDim Preserve result(0) result(0) = CDate(oMyInput) If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing DatePicker- ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDBData.SetVariableValue(oIndexName, oObjectValue) = False Then oMissing = True oErrMsgMissingInput = "Error indexing datepicker idb" LOGGER.Warn(oErrMsgMissingInput) Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then Dim oLogstr = Return_LOGString(oMyInput, oObjectValue, oIndexName) WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) 'Else 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) End If End If End If Else LOGGER.Debug("Value WD ('" & oObjectValue.ToString & "') = Input-value ('" & oMyInput.ToString & "')") End If Else LOGGER.Debug("DateValue is 01.01.0001 00:00:00") End If Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = oControl oMyInput = chk.Checked.ToString 'If chk.Checked = False And oIsRequired = True Then ' oMissing = True ' oErrorMessage = "Option '" & chk.Name & "' is required." ' Exit For 'End If 'den aktuellen Wert in windream auslesen Dim WertWD As String Dim oBoolValue As Boolean If oIndexName.StartsWith("[%VKT") Then WertWD = ReturnVektor_IndexValue(oIndexName) If WertWD = "" Then oBoolValue = False Else oBoolValue = CBool(WertWD) End If Else Dim _Value Dim oObjectCheck = GetVariableValuefromSource(oIndexName, oIDBTyp) If IsNothing(oObjectCheck) Or IsDBNull(oObjectCheck) Then oBoolValue = False Else If oObjectCheck.ToString = "System.Object[]" Then If oObjectCheck.Length = 1 Then _Value = oObjectCheck(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") _Value = oObjectCheck(0) End If Else _Value = oObjectCheck End If oBoolValue = CBool(_Value) End If End If ' Dim Bool_WD = CBool(CURRENT_WMFILE.GetVariableValue(_IDXName)) 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oBoolValue <> chk.Checked Then Dim result() As String ReDim Preserve result(0) If chk.Checked Then result(0) = 1 Else result(0) = 0 End If If oIndexName.StartsWith("[%VKT") Then 'Input = die String komponente mit Boolean as String oMyInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexName) 'Hier muss nun separat as Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrMsgMissingInput = "Error while indexing Checkbox as VEKTOR - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing Checkbox - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else If IDBData.SetVariableValue(oIndexName, chk.Checked.ToString) Then oErrMsgMissingInput = "error indexing checkboxidb" Exit For End If End If If IDB_ACTIVE = False Then If PROFIL_LOGINDEX <> "" Then Dim oLogstr = Return_LOGString(CBool(result(0)).ToString, WertWD, oIndexName) WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) 'Else 'IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) End If End If End If End If Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = oControl Dim Zeilen As Integer = 0 For Each row As DataGridViewRow In dgv.Rows Dim exists = False ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then Zeilen += 1 End If Next 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And Zeilen = 0 Then oMissing = True oErrMsgMissingInput = "Fehlende Eingabe in Vektorfeld '" & dgv.Name & "'" LOGGER.Warn(oErrMsgMissingInput) Exit For ElseIf Zeilen > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each row As DataGridViewRow In dgv.Rows Dim exists = False Select Case oControlType Case "TABLE" ' MsgBox(row.Cells(0).Value.GetType.ToString) Dim str As String If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) For i = 0 To row.Cells.Count - 1 Select Case i Case 0 str = row.Cells(i).Value Case Else str = str & PMDelimiter & row.Cells(i).Value End Select Next 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = str ZeilenGrid += 1 End If Case Else ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = row.Cells(0).Value.ToString ZeilenGrid += 1 End If End Select Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrMsgMissingInput = "Error while indexing Vektorfeld - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else Dim oDT As DataTable = DT_FOR_ARRAY(myVektorArr) If oDT.Rows.Count > 0 Then If IDBData.SetVariableValue(oIndexName, oDT, True) = False Then oMissing = True oErrMsgMissingInput = "Error indexing Datagridview idb" LOGGER.Warn(oErrMsgMissingInput) Exit For End If End If End If 'Jetzt die Datei indexieren End If Case "DevExpress.XtraGrid.GridControl" Dim dgv As GridControl = oControl Dim oRowCount As Integer = dgv.DataSource.Rows.Count 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And oRowCount = 0 Then oMissing = True oErrMsgMissingInput = "Fehlende Eingabe in Tabelle '" & dgv.Name & "'" oControl.BackColor = Color.Red LOGGER.Warn(oErrMsgMissingInput) Exit For ElseIf oRowCount > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each row As DataRow In dgv.DataSource.Rows Dim exists = False Select Case oControlType Case "TABLE" Dim oRowValue = row.Item(0) If IsNothing(oRowValue) Then oRowValue = String.Empty ElseIf IsDBNull(oRowValue) Then oRowValue = String.Empty End If ' MsgBox(row.Cells(0).Value.GetType.ToString) Dim str As String = String.Empty 'If oRowValue <> String.Empty Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) Dim oValueList As New List(Of String) For Each item In row.ItemArray item = NotNull(item, String.Empty) If TypeOf item IsNot String Then item.ToString() oValueList.Add(item) Next str = String.Join(PMDelimiter, oValueList.ToArray) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = str ZeilenGrid += 1 'End If Case Else ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Item(0) Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = row.Item(0).Value.ToString ZeilenGrid += 1 End If End Select Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrMsgMissingInput = $"Error while indexing table (1) {dgv.Name} - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else Dim oMyDT = DT_FOR_ARRAY(myVektorArr) If oMyDT.Rows.Count > 0 Then If IDBData.SetVariableValue(oIndexName, oMyDT, True, oIDBTyp) = False Then oMissing = True oErrMsgMissingInput = $"Error while indexing table IDB (1) {dgv.Name} - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If End If End If Else Dim oValue As New List(Of Object) From {String.Empty} If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, oValue.ToArray) = False Then oMissing = True 'oErrorMessage = "Error while indexing der Tabelle - ERROR: " & idxerr_message oErrMsgMissingInput = $"Error while indexing table (2) {dgv.Name} - ERROR: " & idxerr_message LOGGER.Warn(oErrMsgMissingInput) Exit For End If Else Dim oOldAttributeResult = IDBData.GetVariableValue(oIndexName, oIDBTyp) Dim oTypeOldResult = oOldAttributeResult.GetType.ToString If oTypeOldResult = "System.Data.DataTable" Then Dim oDT As DataTable = IDBData.GetVariableValue(oIndexName, oIDBTyp) If oDT.Rows.Count > 0 Then LOGGER.Debug("User cleared the grid, so data needs to be erased!") IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) End If Else LOGGER.Debug("(String) User cleared the grid, so data needs to be erased!") IDBData.Delete_AttributeData(CURRENT_DOC_ID, oIndexName) End If End If End If End Select End If 'End If für Control und ReadOnly = False Next ' If Error happened in inner For, exit the outer as well If oMissing = True Then LOGGER.Info("oMissing = True...Exiting") Exit For End If Next If oMissing = True Then LOGGER.Warn("Check_UpdateIndexe: ERROR or Missing Indexing - returning False") Return False Else LOGGER.Debug("Check_UpdateIndexe: Everything OK - returning True") Return True End If Catch ex As Exception LOGGER.Warn($"Unexpected error in Check_UpdateIndexe - ControlID: {oControlId},{oControlName}") LOGGER.Error(ex) Dim st As New StackTrace(ex, True) MsgBox($"Unexpected error in Check_UpdateIndexe ControlID,Name: {oControlId},{oControlName}" & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:") LOGGER.Info("Unexpected error in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) Return False End Try End Function Private Function Indexiere_File(_dok As WINDREAMLib.WMObject, idxxname As String, idxvalue As Object) As Boolean Dim File_indexiert As Boolean = False idxerr_message = "" Try 'Die Arrays vorbereiten Dim arrIndex() As String = Nothing Dim arrValue() As String = Nothing arrIndex = Nothing arrValue = Nothing 'Den Indexnamen übergeben ReDim Preserve arrIndex(0) arrIndex(0) = idxxname 'Das Array der Idnexwerte überprüfen If idxvalue Is Nothing = False Then If idxvalue.Length() > 1 Then LOGGER.Debug("Indexing Index '" & idxxname & "' with Arrayvalue") Dim anzahl As Integer = 0 For Each indexvalue As String In idxvalue ReDim Preserve arrValue(anzahl) arrValue(anzahl) = indexvalue anzahl += 1 Next Else LOGGER.Debug("Indexing Index '" & idxxname & "' with value '" & idxvalue(0) & "'") ReDim Preserve arrValue(0) arrValue(0) = idxvalue(0).ToString End If 'Jetzt das eigentliche Indexieren der Datei 'File_indexiert = Me._windreamPM.RunIndexing(_dok, arrIndex, arrValue) File_indexiert = WINDREAM.RunIndexing(_dok, arrIndex, arrValue) Return File_indexiert End If Catch ex As Exception LOGGER.Error(ex) allgFunk.Insert_LogEntry($"ERROR Indexiere_File Validator >> {ex.Message}") idxerr_message = "Unexpected error in Indexiere_File: " & ex.Message.ToString LOGGER.Info("Unexpected error in Indexiere_File: " & ex.Message.ToString, True) Return False End Try End Function Private Sub btnfinal_Click(sender As System.Object, e As System.EventArgs) Finish_WFStep() End Sub Private Sub btnNavigatorfirst_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "first" End If End Sub Private Sub btnNavigatorprevious_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "previous" End If End Sub Private Sub btnNavigatornext_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "next" End If End Sub Private Sub btnNavigatorlast_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "last" End If End Sub Private Sub frmValidation_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown If e.Button = Windows.Forms.MouseButtons.Left Then navStep = Nothing End If End Sub Sub Datei_ueberspringen() Try LOGGER.Debug("Dokument überspringen") 'Das Dokument freigeben Free_File() Dim oSQL = $"EXECUTE PRPM_FILES_NOT_INDEXED '{USER_USERNAME}',{CURRENT_ProfilGUID},'{WMDocPathWindows}',{CURRENT_DOC_GUID}" ClassDatabase.Execute_non_Query(oSQL) LOGGER.Debug($"Skipped DocGUID {CURRENT_DOC_GUID}") Load_Next_Document(False) Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Überspringen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function Free_File() Try Dim sql = $"UPDATE TBPM_PROFILE_FILES SET EDIT = 0, IN_WORK = 0, IN_WORK_WHEN = NULL, WORK_USER = NULL WHERE GUID = {CURRENT_DOC_GUID}" Return ClassDatabase.Execute_non_Query(sql) Catch ex As Exception allgFunk.Insert_LogEntry($"ERROR Free_File >> {ex.Message}") LOGGER.Error(ex) Return False End Try End Function Private Sub delete_active_File() Try Dim result As MsgBoxResult result = MessageBox.Show("Sind Sie sicher dass Sie dieses Dokument unwiderruflich löschen wollen?" & vbNewLine & "Danach wird die nächste Datei angezeigt!", "Bestätigung erforderlich:", MessageBoxButtons.YesNo, MessageBoxIcon.Question) If result = MsgBoxResult.Yes Then Try DocumentViewerValidator.CloseDocument() DocumentViewerValidator.Done() Catch ex As Exception LOGGER.Warn($"Unexpected error in delete_active_File DocumentViewerValidator.Done: {ex.Message}") End Try Thread.Sleep(500) Application.DoEvents() FreeFile() 'Aus der Tabelle löschen Dim oDelete = $"DELETE FROM TBPM_PROFILE_FILES WHERE (GUID = {CURRENT_DOC_GUID})" If ClassDatabase.Execute_non_Query(oDelete) = True Then Dim oDeleteResult As Boolean = False If IDB_ACTIVE = False Then oDeleteResult = Delete_WMFile() End If If oDeleteResult = True Then Load_Next_Document(False) End If End If End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Löschen windream-Datei:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function Delete_WMFile() Try If CURRENT_WMFILE Is Nothing = False Then 'Close_document_viewer() 'Me.PdfViewer1.DocumentFilePath = "" Try If CURRENT_WMFILE.aLocked Then ' unlock the windream object CURRENT_WMFILE.unlock() LOGGER.Debug("## Delete_WMFile WMFile unlocked! ##") End If Try CURRENT_WMFILE.Delete() LOGGER.Info("Manual deleting of file [" & CURRENT_WMFILE.aName & "] successfull!") Return True Catch ex As Exception LOGGER.Warn($"Could not delete via windream-function - ERROR: [{ex.Message}] {vbNewLine} Trying system.io...") Try Try CURRENT_WMFILE.unlock() Catch exul As Exception LOGGER.Warn($"Could not unlock WMFile - ERROR: [{exul.Message}] - now teh system.io.Delete...") End Try WMDocPathWindows = "" CURRENT_DOC_PATH = "" CURRENT_WMFILE = Nothing File.Delete(WMDocPathWindows) LOGGER.Info("Deleting of file via system.io [" & WMDocPathWindows & "] successfull!") Return True Catch ex1 As Exception LOGGER.Warn($"Could not delete via System.IO - ERROR: [{ex1.Message}] {vbNewLine} Trying system.io...") Return False End Try End Try Catch ex As Exception LOGGER.Error(ex) MsgBox("Das windream-Objekt konnte nicht gelöscht werden!" & vbNewLine & vbNewLine & "Fehlermeldung:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Info(" windream-Objekt konnte nicht gelöscht werden - Fehlermeldung: " & ex.Message, True) Return False End Try End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Fehler bei Delete_File") LOGGER.Info(">> Fehlermeldung: " & ex.Message) Return False End Try End Function Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Private Const SEE_MASK_FLAG_NO_UI = &H400 Public Const SW_SHOW As Short = 5 Public Shared Function ShellExecuteEx(ByRef lpExecInfo As SHELLEXECUTEINFO) As Boolean End Function Public Structure SHELLEXECUTEINFO Public cbSize As Integer Public fMask As Integer Public hwnd As IntPtr Public lpVerb As String Public lpFile As String Public lpParameters As String Public lpDirectory As String Dim nShow As Integer Dim hInstApp As IntPtr Dim lpIDList As IntPtr Public lpClass As String Public hkeyClass As IntPtr Public dwHotKey As Integer Public hIcon As IntPtr Public hProcess As IntPtr End Structure Private Sub frmValidation_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd If WMDocPathWindows Is Nothing = False Then My.Settings.frmValidatorSize = Me.Size My.Settings.Save() End If End Sub Private Sub Splitter1_LocationChanged(sender As Object, e As EventArgs) My.Settings.Save() End Sub Private Sub frmValidator_KeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp If e.KeyCode = Keys.F4 Then Datei_ueberspringen() ElseIf e.KeyCode = Keys.F2 Then btnSave.Enabled = False Finish_WFStep() btnSave.Enabled = True End If End Sub Private Sub frmValidator_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing End Sub Private Sub frmValidator_Resize(sender As Object, e As EventArgs) Handles Me.Resize If FormLoaded = False Then Exit Sub End If If WindowState = FormWindowState.Maximized Then My.Settings.frmValidatorWindowState = "Maximized" ElseIf WindowState = FormWindowState.Normal Then My.Settings.frmValidatorWindowState = "Normal" End If My.Settings.Save() End Sub Private Sub btnSave_MouseHover(sender As Object, e As EventArgs) Handles btnSave.MouseHover Dim oMsg = "F2 für Speichern" If USER_LANGUAGE <> "de-DE" Then oMsg = "F2 for saving" End If ToolTip1.Show(oMsg, btnSave) End Sub Private Sub frmValidator_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown End Sub Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) End Sub Sub Reload_Controls(SingleAttribute As String) If IDB_ACTIVE = True Then Load_IDB_DOC_DATA() End If FillIndexValues(False) End Sub Sub SetStatusLabel(infotext As String, Optional pColor As String = "") bsiInformation.Caption = infotext & " " & Now.ToString If pColor <> String.Empty Then bsiInformation.ItemAppearance.Normal.BackColor = Color.FromName(pColor) Else bsiInformation.ItemAppearance.Normal.BackColor = Color.Transparent End If End Sub Private Sub BarButtonItem2_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItemFileView.ItemClick Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(WMDocPathWindows) Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() LOGGER.Info(" - Datei wurde geöffnet!") Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Datei öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Info("Fehler bei Datei öffnen: " & ex.Message, True) End Try End Sub Private Sub BarButtonItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem3.ItemClick frmFileInfo.ShowDialog() End Sub Private Sub BarButtonItem4_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem4.ItemClick If WMDocPathWindows <> "" Then Try Cursor = Cursors.WaitCursor Dim oShellExecuteInfo As New SHELLEXECUTEINFO oShellExecuteInfo.cbSize = Marshal.SizeOf(oShellExecuteInfo) oShellExecuteInfo.lpVerb = "properties" oShellExecuteInfo.lpFile = WMDocPathWindows oShellExecuteInfo.nShow = SW_SHOW oShellExecuteInfo.fMask = SEE_MASK_INVOKEIDLIST If Not ShellExecuteEx(oShellExecuteInfo) Then Dim ex As New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error()) MsgBox("error in Datei-Eigenschaften öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If Catch ex As Exception End Try Cursor = Cursors.Default End If End Sub Private Sub BarButtonItem6_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniRefreshSearches.ItemClick Click_Additional_Searches() End Sub Sub Click_Additional_Searches() Try _frmValidatorSearch?.Close() _frmValidatorSearch = New frmValidatorSearch Catch ex As Exception LOGGER.Error(ex) End Try Load_Additional_Searches() End Sub Private Sub bbtniRefresh_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniRefresh.ItemClick Reload_Controls("") Try btnSave.Text = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton") Catch ex As Exception End Try listChangedLookup.Clear() SetStatusLabel("All Data refreshed", "Yellow") End Sub Private Sub bbtniNext_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniNext.ItemClick If ForceGridValidation() = True Then Datei_ueberspringen() End If End Sub Private Sub bbtniDelete_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniDelete.ItemClick If ForceGridValidation() = True Then delete_active_File() End If End Sub Private Sub bbtniAnnotation_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtniAnnotation.ItemClick Application.DoEvents() frmAnnotations.ShowDialog() load_viewer() End Sub Private Sub BbtnItm_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BbtnItm.ItemClick If ForceGridValidation() = True Then Dim oRESULT As String If USER_LANGUAGE = "de-DE" Then oRESULT = "Eingaben gespeichert" Else oRESULT = "Eingaben gespeichert" End If If Check_UpdateIndexe() = True Then SetStatusLabel($"Data saved", "LimeGreen") Else SetStatusLabel($"Error while saving data!", "Red") End If End If End Sub Private Sub SaveDevExpressGridControl_Layout(pProfilID As Integer, pControlID As Integer, pGridView As DevExpress.XtraGrid.Views.Grid.GridView) Try Dim xml As String = GetXML_OverviewLayoutName(pProfilID, pControlID) pGridView.SaveLayoutToXml(xml) Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Error while saving GridLayout: " & ex.Message) End Try End Sub Private Sub RestoreDevExpressGridControl_Layout(pProfilID As Integer, pControlID As Integer, pGridView As DevExpress.XtraGrid.Views.Grid.GridView) Try Dim oXml As String = GetXML_OverviewLayoutName(pProfilID, pControlID) If File.Exists(oXml) Then pGridView.RestoreLayoutFromXml(oXml) End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Error while restoring layout: " & ex.Message) End Try End Sub Private Function GetXML_OverviewLayoutName(pProfilID As Integer, pControlID As Integer) Dim Filename As String = String.Format($"DevExpressValidatorGridControl_{pProfilID}-{pControlID}.xml") Return System.IO.Path.Combine(CONFIG.UserConfigPath.Replace("UserConfig.xml", ""), Filename) End Function Private Function Conversation_init() Try Dim oResult = ChatControl1.Init(LOGCONFIG, CONNECTION_STRING_IDB, IIf(CONV_IDENTIFICATION = "Email", USER_EMAIL, USER_USERNAME), USER_ID, USER_USERNAME, USER_LANGUAGE, ConversationQUDT_Delete, DTDYNAMIC_RIGHTS) If oResult = True Then Conversations_Init_Rights() Conversations_load() AddHandler ChatControl1.Conversation_Ended, AddressOf onConversationEnded AddHandler ChatControl1.Conversation_UsersAdded_Success, AddressOf ConversationUsersAdded End If Return oResult Catch ex As Exception Return False End Try End Function Private Sub bbtnitem_ConversationNew_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles bbtnitem_ConversationNew.ItemClick Dim oDTUSER As DataTable For Each oRow As DataRow In DTDYNAMIC_RIGHTS.Rows If oRow.Item("CONF_TITLE") = "NEW_CONVERSATION_USER_SELECT" Then Dim oSQL = oRow.Item("CONF_VALUE") oDTUSER = ClassDatabase.Return_Datatable(oSQL) End If Next If Not IsNothing(oDTUSER) Then CURRENT_CONVERSATION_NEW = 0 Dim oForm As New frmChat_NewConversation(oDTUSER, Nothing) Dim oResult = oForm.ShowDialog() If CURRENT_CONVERSATION_NEW <> 0 Then If Not Conversation_initialized Then Conversation_init() End If Conversations_Init_Rights() Conversations_load() End If End If End Sub Private Sub bbtnitem_ConversationEnd_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnitemConversationEnd.ItemClick If ChatControl1.CurrentConversationID <> 0 Then Dim oQuestion As DataTable = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.Conversation_Delete") If Not IsNothing(oQuestion) Then If oQuestion.Rows.Count = 1 Then Dim result As MsgBoxResult result = MessageBox.Show(oQuestion.Rows(0).Item("STRING1").ToString, oQuestion.Rows(0).Item("STRING2").ToString, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation) If result = MsgBoxResult.Yes Then Dim oSQL = $"EXEC PRIDB_END_CONVERSATION {ChatControl1.CurrentConversationID}, '{USER_USERNAME}', '{USER_LANGUAGE}'" If ClassDatabase.Execute_non_Query_ConStr(oSQL, CONNECTION_STRING_IDB_WRITE, "EXEC PRIDB_END_CONVERSATION") = True Then btnitemConversationEnd.Enabled = False SplitContainer2_DV_Chat.Collapsed = True btnitemConversationEnd.Enabled = True Else MsgBox("Unexpected error in PRIDB_END_CONVERSATION - Check Your log!", MsgBoxStyle.Exclamation) End If End If End If End If End If End Sub Private Sub BarEditItem3_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarEditItem3.ItemClick Dim o = BarEditItem3.EditValue End Sub Private Sub RepositoryItemComboBox3_SelectedIndexChanged(sender As Object, e As EventArgs) Handles RepositoryItemComboBox3.SelectedIndexChanged Try Dim cBox As DevExpress.XtraEditors.ComboBoxEdit = sender Dim item = cBox.EditValue Dim oSplit() = item.ToString.Split("|") Dim oConvID = oSplit(0) ChatControl1.LoadConversation(oConvID) btnitemConversationEnd.Enabled = False If SplitContainer2_DV_Chat.IsPanelCollapsed Then SplitContainer2_DV_Chat.Collapsed = False If SplitContainer2_DV_Chat.Panel2.Visible = False Then SplitContainer2_DV_Chat.Panel2.Visible = True End If End If Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Exclamation, ADDITIONAL_TITLE) End Try End Sub Private Sub BarButtonItem5_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnitemConversation_reload.ItemClick Conversations_Init_Rights() Conversations_load() End Sub Sub onConversationEnded() Conversations_load() btnitemConversationEnd.Enabled = False SplitContainer2_DV_Chat.Collapsed = True btnitemConversation_reload.Enabled = False End Sub Sub ConversationUsersAdded() Conversations_load() End Sub Private Sub BarButtonItem5_ItemClick_1(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItem5.ItemClick MsgBox("Versioning not configured! (Reasons: RightManagement, Displaying)", MsgBoxStyle.Information) End Sub Private Sub BarButtonItem6_ItemClick_1(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarButtonItemAttmt.ItemClick Click_Additional_Searches() End Sub End Class