AppStd/TaskFlow
8
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
TaskFlow/app/DD_PM_WINDREAM/frmValidator.vb

5711 lines
310 KiB
VB.net
Raw Blame History

Imports WINDREAMLib
Imports System.Threading
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.ComponentModel
Imports DigitalData.Controls.LookupGrid
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DigitalData.Modules.Language.Utils
Imports DigitalData.Modules.EDMI.API.DatabaseWithFallback
Imports DigitalData.Modules.EDMI.API.Constants
Public Class frmValidator
''' <summary>
''' Contains all controls for the current profile
''' </summary>
Private Property DT_CONTROLS As DataTable
''' <summary>
''' Contains all grid columns for the current profile
''' </summary>
Private Property DT_COLUMNS_GRID As DataTable
''' <summary>
''' Contains all grid columns for the current profile which have an sql but don't have a reference to a control
''' </summary>
Private Property DT_COLUMNS_GRID_WITH_SQL As DataTable
''' <summary>
''' Contains all grid columns for the current profile which have an sql and have a reference to a control
''' </summary>
Private Property DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER As DataTable
Private Property PROFIL_sortbynewest As Boolean
Private Property PROFIL_VEKTORINDEX
Private Property PROFIL_FINISH_SQL
Private Property PROFIL_LOGINDEX
Private Property oErrMsgMissingInput
Private Property PMDelimiter As String
Private Property WD_Search As String
Private Property finalProfile As Boolean
Private Property Move2Folder As String
'Private Property DataASorDB As ClassDataASorDB
Private Property allgFunk As New ClassAllgemeineFunktionen
'speichert die DocumentDaten
Private Property navStep As String = Nothing
Public Shared Property WMDocPathWindows As String
Private Property WMDocFileString As String
Private Property DocPathWindows As String
Private Property OLD_Document_Path As String = ""
Private Property ValueDTP As Date
Private Property docCounter As Integer = 1
'Anzahl der Validierungsdokumente
Private Property Amount_Docs2Validate As Integer
Private Property me_closing As Boolean = False
Private Property first_control As Control
Private Property last_control As Control
Private Property _Indexe_Loaded As Boolean = False
Public Shared Property idxerr_message As String = ""
Private _CURRENT_INDEX_ARRAY(100, 250) As String
Private Property _frmValidatorSearch As frmValidatorSearch 'You need a reference to Form1
Private Property _dependingControl_in_action As Boolean = False
Private Property _dependingColumn_in_action As Boolean = False
Private Property _SetControlValue_in_action As Boolean = False
Private Property DTConversations As DataTable
Private Property DTDYNAMIC_RIGHTS As DataTable
Private Property DT_AdditionalSearches_Resultset_Docs As DataTable
Private Property Right_Conversation_Add As Boolean = False
Private Property Right_Conversation_Stop As Boolean = False
Private Property Right_Conversation_Message As Boolean = False
Private Property Conversation_User_Active As Boolean = False
Private Property ConversationQUDT_Delete As DataTable
Private Property Conversation_initialized As Boolean = False
Public Property FormLoaded As Boolean = False
Private Property ItemWorked As Boolean = False
Private Property Override As Boolean = False
Private Property OverrideAll As Boolean = False
Private Property Override_SQLCommand As String = ""
Private Property listChangedLookup As New List(Of String)
Private Property 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
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
BarButtonItemAttmt.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
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
Else
Try
LOGGER.Debug($"!! Invalid PositionData X({My.Settings.frmValidatorPosition.X}), Y({My.Settings.frmValidatorPosition.Y})")
Catch ex As Exception
End Try
End If
End If
If My.Settings.frmValidatorSize.IsEmpty = False Then
If My.Settings.frmValidatorSize.Width > 0 And My.Settings.frmValidatorSize.Height > 0 Then
If My.Settings.frmValidatorWindowState = "Normal" Then
Size = My.Settings.frmValidatorSize
Else
Me.WindowState = FormWindowState.Maximized
End If
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
Amount_Docs2Validate = 1
Else
Amount_Docs2Validate = 0
End If
Next
If DEBUG = 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 = Database.GetDatatableIDB(oSQL) ', CONNECTION_STRING_IDB, "FNIDB_OBJECT_DYNAMIC_CONFIG")
RibbonPageGroupConv1.Enabled = False
Dim oView As DataView = New DataView(DTDYNAMIC_RIGHTS)
oView.RowFilter = "CONF_TITLE like '%CONVERSATION_RIGHT%'"
Console.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("FormClosing")
Catch ex As Exception
LOGGER.Error(ex)
End Try
Try
Dim oDel = $"DELETE FROM TBPM_DOCWALKOVER WHERE UserID = {USER_ID}"
Database.ExecuteNonQueryECM(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
CURRENT_DOC_ID = 0
CURRENT_DOC_GUID = 0
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, PanelValidatorControl, True)
'oDatatableDataResult = ClassDatabase.Return_Datatable_ConId(oDataResultCommand, oConID, "Load_Additional_Searches1")
oDatatableDataResult = Database.GetDatatable(New GetDatatableOptions(oDataResultCommand, DatabaseType.ECM) With {
.ConnectionId = oConID
})
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, PanelValidatorControl, True)
'oDatatableDocResult = ClassDatabase.Return_Datatable_ConId(oDocResultCommand, oConID, "Load_Additional_Searches2")
oDatatableDocResult = Database.GetDatatable(New GetDatatableOptions(oDocResultCommand, DatabaseType.ECM) With {
.ConnectionId = oConID
})
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
DT_AdditionalSearches_Resultset_Docs = oDatatableDocResult
End If
End If
End If
If oDataResultsExist = True Or oDocResultsExist = True Then
bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
If RibbonPageCustItm1 <> "" Then
BarButtonItemAttmt.Caption = RibbonPageCustItm1
BarButtonItemAttmt.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
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, PanelValidatorControl, 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, PanelValidatorControl, 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.Debug("Not loading AdditionalSearches 1...!")
bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Never
End If
Else
LOGGER.Debug("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
End If
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")
Dim oReadOnly As Boolean = row.Item("READ_ONLY")
'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 oReadOnly = True Then
LOGGER.Debug("Control for Index [{0}] is read-only. Continuing.")
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
End If
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, PanelValidatorControl, 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}")
Dim oDTContent As DataTable = Database.GetDatatable(New GetDatatableOptions(oSQLStatement, DatabaseType.ECM) With {
.ConnectionId = oConnectionId
})
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
PanelValidatorControl.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"
'DT_CONTROLS = DataASorDB.GetDatatable("DD_ECM", oSQL, "TBPM_PROFILE_CONTROLS_LANGUAGE", $"LANGUAGE = '{USER_LANGUAGE}' AND PROFIL_ID = {CURRENT_ProfilGUID}", "Y_LOC, X_LOC")
DT_CONTROLS = Database.GetDatatable("TBPM_PROFILE_CONTROLS_LANGUAGE", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"LANGUAGE = '{USER_LANGUAGE}' AND PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "Y_LOC, X_LOC"
})
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"
DT_COLUMNS_GRID = Database.GetDatatable("TBPM_CONTROL_TABLE", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "SEQUENCE"
})
oSQL = "SELECT T1.GUID As CONTROL_ID, T1.PROFIL_ID, T.CONNECTION_ID, T.SQL_COMMAND, T.SPALTENNAME,T.FORMATTYPE,T.FORMATSTRING, T.ADVANCED_LOOKUP 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 ORDER BY T.SEQUENCE"
'DT_COLUMNS_GRID_WITH_SQL = DataASorDB.GetDatatable("DD_ECM", oSQL, "DTGRID_SQL_DEFINITION", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE")
DT_COLUMNS_GRID_WITH_SQL = Database.GetDatatable("DTGRID_SQL_DEFINITION", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "SEQUENCE"
})
oSQL = "
SELECT
T1.GUID As CONTROL_ID,
T1.PROFIL_ID,
T.CONNECTION_ID,
T.SQL_COMMAND,
T.SPALTENNAME,
T.FORMATTYPE,
T.FORMATSTRING,
T.ADVANCED_LOOKUP
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.SQL_COMMAND LIKE '%{#CTRL%'
ORDER BY T.SEQUENCE"
'DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER = DataASorDB.GetDatatable("DD_ECM", oSQL, "DTGRID_SQL_DEFINITION", $"PROFIL_ID = {CURRENT_ProfilGUID}", "SEQUENCE")
DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER = Database.GetDatatable("DTGRID_SQL_DEFINITION", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "SEQUENCE"
})
Dim oTabIndexCounter As Integer = 0
ClassControlCreator.Logger = LOGCONFIG.GetLoggerFor("ControlCreator")
For Each oControlRow As DataRow In DT_CONTROLS.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 ClassControlCreator.PREFIX_TEXTBOX
Try
oControlInfo = ClassControlCreator.PREFIX_TEXTBOX & "#" & 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
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, PanelValidatorControl, True)
'Dim oDT As DataTable = ClassDatabase.Return_Datatable_ConId(oSQL, oCONID, $"CreateControls - oControlID: {oControlID}")
Dim oDT As DataTable = Database.GetDatatable(New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.ConnectionId = oCONID
})
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
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 = DT_CONTROLS.Clone()
Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oMyControl.Name}%'"
DT_CONTROLS.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}%'"
DT_CONTROLS.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 = DT_CONTROLS.Clone()
oExpression = $"GUID = {oControlRow.Item("GUID")} and Len(SET_CONTROL_DATA) > 0"
DT_CONTROLS.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 = DT_CONTROLS.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
Case "TABLE"
oControlInfo = "TABLE#" & oControlInfo
Dim oFilteredDatatable As DataTable = DT_COLUMNS_GRID.Clone()
Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}"
DT_COLUMNS_GRID.Select(oExpression, "SEQUENCE").CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
If oFilteredDatatable.Rows.Count >= 1 Then
LOGGER.Debug("We got a DTGRID_COLUMNS definition for [{0}] ", oControlInfo)
Else
LOGGER.Debug("DTGRID_COLUMNS definition for control [{0}] does not contain any rows!", oControlInfo)
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 = oTabIndexCounter
End If
' oMyControl.Tag = CInt(oControlRow.Item("GUID"))
PanelValidatorControl.Controls.Add(oMyControl)
oTabIndexCounter += 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 DEBUG = False Then MsgBox(omsg, MsgBoxStyle.Critical, "Attention:")
End Try
Next
LOGGER.Debug("Create_Controls finished!")
Catch ex As Exception
LOGGER.Error(ex)
If DEBUG = 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
LOGGER.Error(ex)
End Try
End Sub
Sub Clear_all_Input()
For Each inctrl As Control In Me.PanelValidatorControl.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
SetControlValues_FromControl(oTextbox)
ClassControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
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 oTextBox As TextBox = sender
If oTextBox.Text <> String.Empty And me_closing = False And _Indexe_Loaded = True And oTextBox.Height < 25 Then
If (e.KeyCode = Keys.Return) Or (e.KeyCode = Keys.Tab) Or (e.KeyCode = Keys.Enter) Then
Try
Dim CONTROL_ID = DirectCast(oTextBox.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, oTextBox.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 '%{oTextBox.Name}%'")
DTCONTROLS_UEBP = Database.GetDatatable("TBPM_PROFILE_CONTROLS_SQL_UEP", New GetDatatableOptions(oSql, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID} AND SQL_UEBERPRUEFUNG LIKE '%{oTextBox.Name}%'"
})
If Not IsNothing(DTCONTROLS_UEBP) AndAlso DTCONTROLS_UEBP.Rows.Count > 0 Then
For Each oRow As DataRow In DTCONTROLS_UEBP.Rows
Try
Dim oControlName = oRow.Item("NAME").ToString
Dim oSqlStatement = oRow.Item("SQL_UEBERPRUEFUNG")
Dim oConnectionId = oRow.Item("CONNECTION_ID")
If Not IsDBNull(oSqlStatement) And Not IsDBNull(oConnectionId) Then
oSqlStatement = clsPatterns.ReplaceAllValues(oSqlStatement, PanelValidatorControl, True)
_dependingControl_in_action = True
Depending_Control_Set_Result(oControlName, oSqlStatement, oConnectionId)
_dependingControl_in_action = False
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Unexpected Error in Display SQL result for control: " & oRow.Item("NAME") & " - ERROR: " & ex.Message)
End Try
Next
End If
ClassControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message)
End Try
If oTextBox.Name <> last_control.Name Then
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(DT_CONTROLS, 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(DT_CONTROLS, oControlID, "SQL2")
If IsNothing(Override_SQLCommand) Then
Override_SQLCommand = ""
End If
oSQL = clsPatterns.ReplaceAllValues(oSQL, PanelValidatorControl, True)
Override_SQLCommand = clsPatterns.ReplaceAllValues(Override_SQLCommand, PanelValidatorControl, True)
Dim oDT_ACTIONS As DataTable = Database.GetDatatableECM(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 = Database.ExecuteNonQueryECM(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 = Database.ExecuteNonQueryECM(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 = Database.GetDatatable("TBPM_PROFILE_CONTROLS", New GetDatatableOptions(sql, DatabaseType.ECM) With {
.FilterExpression = String.Format("CONTROL_ACTIVE = 1 AND PROFIL_ID = {0} And SQL_UEBERPRUEFUNG Like '%{1}%'", CURRENT_ProfilGUID, dgv.Name)
})
If Not IsNothing(DT) And DT.Rows.Count > 0 Then
For Each ROW As DataRow In DT.Rows
Try
Dim displayboxname = ROW.Item("NAME").ToString
If Not IsDBNull(ROW.Item("CONNECTION_ID")) And Not IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")) Then
Dim sql_Statement = ROW.Item("SQL_UEBERPRUEFUNG")
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}]")
Dim resultDT As DataTable = Database.GetDatatable(New GetDatatableOptions(sql_Statement, DatabaseType.ECM) With {
.ConnectionId = ROW.Item("CONNECTION_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
PanelValidatorControl.Controls(displayboxname).Text = result.ToString
Exit For
Else
PanelValidatorControl.Controls(displayboxname).Text = "RESULT = NOTHING"
Exit For
End If
Next
Else
PanelValidatorControl.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
Try
Dim oLookup As RepositoryItemLookupControl3 = sender
listChangedLookup.Add(oLookup.Name)
ClassControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
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)
SetControlValues_FromControl(oCheckbox)
ClassControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
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
SetControlValues_FromControl(oLookup)
End Sub
Private Sub SetControlValues_FromControl(pControl As Control)
Dim oControlName = pControl.Name
Dim oControlMeta = DirectCast(pControl.Tag, ClassControlCreator.ControlMetadata)
Dim oControlID = oControlMeta.Guid
If _SetControlValue_in_action = True Then
LOGGER.Debug("SetControlValue in action. Exiting.")
Exit Sub
End If
Dim oFilteredDatatable As DataTable = DT_CONTROLS.Clone()
DT_CONTROLS.
Select($"GUID = {oControlID} and LEN(SET_CONTROL_DATA) > 0").
CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
If oFilteredDatatable.Rows.Count < 1 Then
LOGGER.Debug("SET_CONTROL_DATA is empty for control [{0}]. Exiting.", oControlName)
Exit Sub
End If
Dim oRow As DataRow = oFilteredDatatable.Rows.Item(0)
Dim oControlGUID2Set = oControlID
Dim oControlname2Set = oRow.Item("NAME")
LOGGER.Debug($"Workin on SetControLValue for {oControlname2Set} ...")
Dim oConnectionId = NotNull(oRow.Item("CONNECTION_ID"), 0)
Dim oControlDataSql = NotNull(oRow.Item("SET_CONTROL_DATA"), String.Empty)
If oConnectionId = 0 Or oControlDataSql = String.Empty Then
LOGGER.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!")
Exit Sub
End If
Dim oSqlCommand = NotNull(oRow.Item("SET_CONTROL_DATA"), String.Empty)
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, True)
'Dim oControlDataResult As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oConnectionId, $"SetControlValues - CTRLID {oControlID}")
Dim oControlDataResult As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oConnectionId
})
If oControlDataResult Is Nothing Then
Exit Sub
End If
For Each oResultRow As DataRow In oControlDataResult.Rows
Try
_SetControlValue_in_action = True
Dim oControl2Set = oResultRow.Item("Control2Set")
If oControl2Set.ToString.ToUpper = "BTN_FINISH".ToUpper Then
Try
Dim btntext = oResultRow.Item("Caption")
btnSave.Text = btntext & " (F2)"
Catch ex As Exception
LOGGER.Error(ex)
End Try
Try
Dim oColor1 = Color.FromName(oResultRow.Item("BackgroundColor"))
btnSave.BackColor = oColor1
Catch ex As Exception
LOGGER.Error(ex)
btnSave.BackColor = Color.Transparent
End Try
Try
Dim oColor2 = Color.FromName(oResultRow.Item("FontColor"))
btnSave.ForeColor = oColor2
Catch ex As Exception
LOGGER.Error(ex)
btnSave.ForeColor = Color.Black
End Try
_SetControlValue_in_action = False
Continue For
End If
Dim oFound As Boolean = False
Dim oControlId2Set As Integer
If Not Integer.TryParse(oControl2Set, oControlId2Set) Then
LOGGER.Warn("Careful: the oControl2Set contains no CONTROL_GUID")
Exit Sub
End If
For Each oControl As Control In PanelValidatorControl.Controls
Dim oMeta As ClassControlCreator.ControlMetadata = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata)
If oMeta.Guid = oControlId2Set Then
LOGGER.Debug($"Got the Control22Set: {oControlId2Set}..Setting the values..")
Dim oCaption As Object = oResultRow.Item("Caption")
Dim oTextOption = Nothing
Try
oTextOption = oResultRow.Item("TextOption")
Catch ex As Exception
LOGGER.Debug("Column [TextOption] not found. Using Default of [Replace]")
oTextOption = "Replace"
End Try
Select Case oControl.GetType()
Case GetType(TextBox)
If oTextOption = "Replace" Then
oControl.Text = oCaption
Else
oControl.Text &= oCaption
End If
Dim oBackColor
Try
oBackColor = Color.FromName(oResultRow.Item("BackgroundColor"))
oControl.BackColor = oBackColor
Catch ex As Exception
LOGGER.Debug("Column [BackgroundColor] not found. Using Default of [White]")
oControl.BackColor = Color.White
End Try
Dim oForeColor As Color
Try
oForeColor = Color.FromName(oResultRow.Item("FontColor"))
oControl.ForeColor = oForeColor
Catch ex As Exception
LOGGER.Debug("Column [FontColor] not found. Using Default of [Black]")
oControl.ForeColor = Color.Black
End Try
Case GetType(LookupControl3)
Dim oDependingLookup As LookupControl3 = oControl
If oDependingLookup.Properties.MultiSelect = True Then
If oTextOption = "Replace" Then
oDependingLookup.Properties.SelectedValues = New List(Of String) From {oCaption}
Else
oDependingLookup.Properties.SelectedValues.Add(oCaption)
End If
Else
oDependingLookup.Properties.SelectedValues = New List(Of String) From {oCaption}
End If
Case Else
LOGGER.Warn("SetControlData used on unsupported control")
End Select
oFound = True
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.Error(ex)
LOGGER.Warn($"Error while Control2Set for [{oControlname2Set}]: " & ex.Message)
Finally
_SetControlValue_in_action = False
End Try
Next
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 = DT_CONTROLS.Clone()
Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oLOOKUPName}%'"
DT_CONTROLS.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, PanelValidatorControl, True)
_dependingControl_in_action = True
'Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oRowDependingControl.Item("CONNECTION_ID"), $"LookupControl_DependingControls - oControlID: {oControlID}")
Dim oDTDEPENDING_RESULT As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oRowDependingControl.Item("CONNECTION_ID")
})
Try
Dim oFound As Boolean = False
For Each oControl As Control In PanelValidatorControl.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 = DT_CONTROLS.Clone()
Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oCheckboxname}%'"
DT_CONTROLS.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, PanelValidatorControl, True)
_dependingControl_in_action = True
'Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oRowDependingControl.Item("CONNECTION_ID"), $"CheckBox_DependingControls - oControlID: {oControlID}")
Dim oDTDEPENDING_RESULT As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oRowDependingControl.Item("CONNECTION_ID")
})
Try
Dim oFound As Boolean = False
'Dim oDependingLookup As LookupControl3 = pnldesigner.Controls.Find(oDEPENDING_CtrlName, False).FirstOrDefault()
For Each oControl As Control In PanelValidatorControl.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 = DT_COLUMNS_GRID_WITH_SQL.Clone()
Dim oExpression = $"SQL_COMMAND like '%#CTRL#{LookupControl.Name}%'"
DT_COLUMNS_GRID_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 = oRow.Item("CONTROL_ID")
Dim oCONNID = oRow.Item("CONNECTION_ID")
Dim oDEPENDING_COLUMN = oRow.Item("SPALTENNAME")
Dim oSqlCommand = oRow.Item("SQL_COMMAND")
Dim oAdvancedLookup = oRow.Item("ADVANCED_LOOKUP")
If _dependingColumn_in_action = True Then
Exit Sub
End If
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, 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}")
Dim oDTDEPENDING_RESULT As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oCONNID
})
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 PanelValidatorControl.Controls
Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
If oControlId = oDEPENDING_CONTROL_ID Then
ClassControlCreator.GridTables_CacheDatatableForColumn(oControlId, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
_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 = DT_COLUMNS_GRID_WITH_SQL.Clone()
Dim oExpression = $"SQL_COMMAND like '%#CTRL#{pCheckbox.Name}%'"
DT_COLUMNS_GRID_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 = oRow.Item("CONTROL_ID")
Dim oCONNID = oRow.Item("CONNECTION_ID")
Dim oDEPENDING_COLUMN = oRow.Item("SPALTENNAME")
Dim oSqlCommand = oRow.Item("SQL_COMMAND")
Dim oAdvancedLookup = oRow.Item("ADVANCED_LOOKUP")
If _dependingColumn_in_action = True Then
Exit Sub
End If
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, 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}")
Dim oDTDEPENDING_RESULT As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oCONNID
})
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 PanelValidatorControl.Controls
Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_CONTROL_ID Then
ClassControlCreator.GridTables_CacheDatatableForColumn(oControlId, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
_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 = Database.GetDatatable("TBPM_PROFILE_CONTROLS", New GetDatatableOptions(sql, DatabaseType.ECM) With {
.FilterExpression = String.Format("CONTROL_ACTIVE = 1 AND PROFIL_ID = {0} And SQL_UEBERPRUEFUNG Like '%{1}%'", CURRENT_ProfilGUID, oCombobox.Name)
})
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, PanelValidatorControl, 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
ClassControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Controls2beEnabled(oCombobox.Name)
SetControlValues_FromControl(oCombobox)
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
' 18.10.2021: ENABLE_SQL nicht beim Form Load verarbeiten
If FormLoaded = False Then
Exit Sub
End If
Dim oFilteredDatatable As DataTable = DT_CONTROLS.Clone()
Dim oExpression = $"SQL_ENABLE like '%#CTRL#{pControlName}%'"
DT_CONTROLS.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, PanelValidatorControl, True)
_dependingControl_in_action = True
Dim oConnectionId As Integer = oRowEnablingControl.Item("CONNECTION_ID")
Dim oResult = _Client.GetScalarValueFromIDB(oSqlCommand, oConnectionId)
Dim oENABLERESULT As Boolean = False
If oResult.OK Then
oENABLERESULT = oResult.Scalar
End If
'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 PanelValidatorControl.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 = DT_CONTROLS.Clone()
Dim oExpression = $"LEN(SQL_ENABLE) > 0"
DT_CONTROLS.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 PanelValidatorControl.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 = DT_CONTROLS.Clone()
Dim oExpression = $"LEN(SQL_ENABLE_ON_LOAD) > 0"
DT_CONTROLS.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 PanelValidatorControl.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, PanelValidatorControl, True)
Dim oConnectionId As Integer = oRowEnablingControl.Item("CONNECTION_ID")
Dim oResult = _Client.GetScalarValueFromIDB(oSqlCommand, oConnectionId)
Dim oENABLERESULT As Boolean = False
If oResult.OK Then
oENABLERESULT = oResult.Scalar
End If
'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
LOGGER.Debug("Setting Values for Control [{0}]", displayboxname)
'Dim oResultTable As DataTable = ClassDatabase.Return_Datatable_ConId(sqlCommand, sqlConnection)
Dim oResultTable As DataTable = Database.GetDatatable(New GetDatatableOptions(sqlCommand, DatabaseType.ECM) With {
.ConnectionId = sqlConnection
})
If Not IsNothing(oResultTable) Then
LOGGER.Debug("Result Table has [{0}] rows", oResultTable.Rows.Count)
LOGGER.Debug("Result Table has [{0}] columns", oResultTable.Columns.Count)
'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
LOGGER.Debug("Control is Multivalue")
If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Then
LOGGER.Debug("Filling Combobox with Results")
Dim oCombobox As ComboBox = PanelValidatorControl.Controls(displayboxname)
If IsNothing(oCombobox) Then
Exit Sub
End If
LOGGER.Debug("Control exists, setting results.")
oCombobox.DataSource = Nothing
oCombobox.DataSource = oResultTable
oCombobox.DisplayMember = oResultTable.Columns(0).ColumnName
oCombobox.ValueMember = oResultTable.Columns(0).ColumnName
ElseIf displayboxname.StartsWith(ClassControlCreator.PREFIX_LOOKUP) Then
LOGGER.Debug("Filling Lookup Control with Results")
Dim oLookup As LookupControl3 = PanelValidatorControl.Controls(displayboxname)
If IsNothing(oLookup) Then
Exit Sub
End If
LOGGER.Debug("Control exists, setting results.")
oLookup.Properties.DataSource = Nothing
oLookup.Properties.DataSource = oResultTable
Else
'not implemented
LOGGER.Warn("Depending_Control_Set_Result for [{0}] NOT IMPLEMENTED", displayboxname)
End If
Else
If oResultTable.Rows.Count = 1 Then
PanelValidatorControl.Controls(displayboxname).Text = oResultTable.Rows(0).Item(0).ToString
Else
PanelValidatorControl.Controls(displayboxname).Text = "RESULT = resultDT.Rows.Count <> 1"
LOGGER.Info(">> Datatable-SQL: " & sqlCommand)
End If
End If
Else
LOGGER.Warn("Result Table is nothing!")
End If
Catch ex As Exception
LOGGER.Info("Unexpected Ersror in Depending_Control_Set_Result - ERROR: " & ex.Message)
MsgBox("Unexpected error in Depending_Control_Set_Result: " & ex.Message, MsgBoxStyle.Critical)
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 = Database_ECM.Get_ConnectionStringforID(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 = $"EXEC PRPM_GET_NEXT_DOC_INFO {CURRENT_ProfilGUID},{CURRENT_DOC_ID},{USER_ID}"
'Dim oSQL = $"SELECT * from [dbo].[FNPM_GET_NEXT_DOC_INFO] ({CURRENT_ProfilGUID},{oBIT},{CURRENT_DOC_GUID},'{USER_USERNAME}')"
Dim oDT As DataTable = Database.GetDatatableECM(oSQL)
If oDT.Rows.Count > 0 Then
oNewGUID = oDT.Rows(0).Item(0)
CURRENT_DOC_ID = oDT.Rows(0).Item(1)
Try
Amount_Docs2Validate = oDT.Rows(0).Item(2)
Catch ex As Exception
LOGGER.Warn("Amount_Docs2Validate Error: " & ex.Message)
End Try
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 = Database.GetScalarValueECM(oSQL)
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 = Database.GetScalarValueECM(oSQL)
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 = Database.GetDatatableECM(oSQl)
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}"
Database.ExecuteNonQueryECM(sql)
' ############ Infos eintragen #################
' txtDateipfad.Text = Document_Path
Dim omsg = $"Verbleibende Belege: {Amount_Docs2Validate}"
If USER_LANGUAGE <> "de-DE" Then
omsg = $"Remaining documents: {omsg}"
End If
bsiInformation.Caption = omsg
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 PanelValidatorControl.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.PanelValidatorControl.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.PanelValidatorControl.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 = DT_COLUMNS_GRID.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}"
DT_COLUMNS_GRID.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.CheckState = CheckState.Indeterminate
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
Dim oDataTable As DataTable = DT_COLUMNS_GRID_WITH_SQL.Clone()
DT_COLUMNS_GRID_WITH_SQL.Select($"SQL_COMMAND not like '%#CTRL#%'").CopyToDataTable(oDataTable, LoadOption.PreserveChanges)
For Each oRow As DataRow In oDataTable.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")
Dim oAdvancedLookup = oRow.Item("ADVANCED_LOOKUP")
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, True)
Try
'Dim oDTRESULT_FOR_COLUMN As DataTable = ClassDatabase.Return_Datatable_ConId(oSqlCommand, oCONNID, $"oDEPENDING_CTRL_ID: {oDEPENDING_CTRL_ID}")
Dim oDTRESULT_FOR_COLUMN As DataTable = Database.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oCONNID
})
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 PanelValidatorControl.Controls
Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
If oControlId = oDEPENDING_CTRL_ID Then
ClassControlCreator.GridTables_CacheDatatableForColumn(oControlId, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
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 = Database.GetDatatableIDB(oSQL)
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
' 18.10.2021: Brauchen Sie das Überhaupt??
'Controls2beDisabled()
BringToFront()
If bbtniRefreshSearches.Visibility = DevExpress.XtraBars.BarItemVisibility.Always Then
_frmValidatorSearch?.BringToFront()
End If
FormLoaded = True
Try
If USER_GHOST_MODE_ACTIVE Then
BbtnitmSave.Enabled = False
btnSave.Enabled = False
Else
BbtnitmSave.Enabled = True
btnSave.Enabled = True
End If
Catch ex As Exception
End Try
Try
If RibbonPageCustTitle <> "" Then
RibbonPageCust.Text = RibbonPageCustTitle
RibbonPageCust.Visible = True
Else
RibbonPageCust.Visible = False
End If
If Not IsNothing(WMDocPathWindows) Then
If ButtonExport2Folder_Caption <> "" And WMDocPathWindows <> "" Then
If File.Exists(WMDocPathWindows) Then
barbtnitmExport.Caption = ButtonExport2Folder_Caption
barbtnitmExport.Visibility = DevExpress.XtraBars.BarItemVisibility.Always
Try
If ButtonExport2Folder_RootFolder <> "" Then
If Directory.Exists(ButtonExport2Folder_RootFolder) Then
If CONFIG.Config.LastExportPath <> String.Empty Then
FolderBrowserDialog1.SelectedPath = CONFIG.Config.LastExportPath
Else
FolderBrowserDialog1.SelectedPath = ButtonExport2Folder_RootFolder
End If
Else
LOGGER.Warn($"### Dis/Enabale Export2Path - RootFolder {ButtonExport2Folder_RootFolder} not existing or accessible!###")
End If
End If
Catch ex As Exception
LOGGER.Warn($"### Error Dis/Enabale Export2Path: {ex.Message} !###")
End Try
End If
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
End Try
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 PanelValidatorControl.Controls
Where TypeOf oControl Is GridControl
Select oControl).ToList()
LOGGER.Debug("Forcing grid Validation")
For Each oGrid As GridControl In oGrids
LOGGER.Debug("Validating Grid [{0}]", oGrid.Name)
Dim oView As GridView = oGrid.MainView
If oView.RowCount = 0 Then
Continue For
End If
If oView.UpdateCurrentRow() = False Then
oValidation = False
End If
LOGGER.Debug("Validation of Grid [{0}] ended with Result: [{1}]", oGrid.Name, oValidation)
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, PanelValidatorControl, True)
Dim oDT_ACTIONS As DataTable = Database.GetDatatableECM(oSQL)
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")
oDTFinalIndexing = Database.GetDatatable("TBPM_PROFILE_FINAL_INDEXING", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "PROFILE_ID,TAB_INDEX"
})
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, PanelValidatorControl, 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 oDBResult = _Client.GetScalarValueFromIDB(oSQLCommand, oConnectionID)
Dim oResultfromSQL As Object = ""
If oDBResult.OK Then
oResultfromSQL = oDBResult.Scalar
End If
'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
Database.ExecuteNonQueryECM(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.PanelValidatorControl.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)
Database.ExecuteNonQueryECM(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 = Database.GetDatatableECM(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 = Database.GetDatatableECM(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 Database.ExecuteNonQueryECM(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
LOGGER.Debug("Validation of document ended successfully!")
Dim oPROCSQL = $"EXEC PRPM_CHECK_NEXT_WF {CURRENT_DOC_GUID}"
Database.ExecuteNonQueryECM(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.PanelValidatorControl.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 oDBControlName = oControlRow.Item("CTRL_NAME").ToString
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"))
If oIsReadOnly = True Then
Continue For
End If
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 oDBControlName = oControl.Name And oIndexName <> "DD PM-ONLY FOR DISPLAY" Then ' 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"
Try
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
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case "System.Windows.Forms.CheckBox"
Try
Dim chk As CheckBox = oControl
oMyInput = chk.Checked.ToString
If chk.CheckState = CheckState.Indeterminate And oIsRequired = True Then
oMissing = True
oErrMsgMissingInput = "Please set Checkbox value for field '" & chk.Name & "'"
LOGGER.Warn(oErrMsgMissingInput)
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
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case "System.Windows.Forms.DataGridView"
Try
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
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case "DevExpress.XtraGrid.GridControl"
Try
Dim dgv As GridControl = oControl
Dim oRowCount As Integer = dgv.DataSource.Rows.Count
LOGGER.Debug("Grid Row Count: [{0}]", oRowCount)
'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)
' 22.10.2021 Attempt at fixing empty lines appearing in indexes
LOGGER.Debug("Grid Value before saving: [{0}]", str)
If str.Trim.Length = 0 Or str.Trim.Replace(PMDelimiter, "").Length = 0 Then
LOGGER.Debug("Empty line in Grid [{0}]. Skipping.", oControlName)
Continue For
End If
'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
LOGGER.Debug("Required = False And RowCount > 0")
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
Catch ex As Exception
LOGGER.Error(ex)
End Try
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, pIndexName As String, pIndexValues 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) = pIndexName
'Das Array der Idnexwerte überprüfen
If pIndexValues Is Nothing = False Then
If pIndexValues.Length() > 1 Then
LOGGER.Debug("Indexing Index '" & pIndexName & "' with Arrayvalue")
For Each oValue In pIndexValues
Try
LOGGER.Debug("Current Index Value for [{0}] is [{1}]", pIndexName, oValue)
Catch ex As Exception
LOGGER.Debug("Current Index Value for [{0}] could not be read!", pIndexName)
End Try
Next
Dim anzahl As Integer = 0
For Each indexvalue As String In pIndexValues
ReDim Preserve arrValue(anzahl)
arrValue(anzahl) = indexvalue
anzahl += 1
Next
Else
LOGGER.Debug("Indexing Index '" & pIndexName & "' with value '" & pIndexValues(0) & "'")
ReDim Preserve arrValue(0)
arrValue(0) = pIndexValues(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}"
Database.ExecuteNonQueryECM(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 Database.ExecuteNonQueryECM(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 Database.ExecuteNonQueryECM(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
<DllImport("Shell32", CharSet:=CharSet.Auto, SetLastError:=True)>
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
<MarshalAs(UnmanagedType.LPTStr)> Public lpVerb As String
<MarshalAs(UnmanagedType.LPTStr)> Public lpFile As String
<MarshalAs(UnmanagedType.LPTStr)> Public lpParameters As String
<MarshalAs(UnmanagedType.LPTStr)> Public lpDirectory As String
Dim nShow As Integer
Dim hInstApp As IntPtr
Dim lpIDList As IntPtr
<MarshalAs(UnmanagedType.LPTStr)> 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
If USER_GHOST_MODE_ACTIVE Then
Exit Sub
End If
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
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()
Try
btnSave.Text = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton")
Catch ex As Exception
End Try
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 BbtnitmSave.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")
LOGGER.Info("Workflowdata saved manually!")
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, "Manual Save via button")
Database.ExecuteNonQueryECM(ins)
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 = Database.GetDatatableIDB(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 Database.ExecuteNonQueryIDB(oSQL) = 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
Private Sub barbtnitmExport_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles barbtnitmExport.ItemClick
If File.Exists(WMDocPathWindows) Then
Try
Dim oFilenameOnly As String
Dim oExtension As String
Dim oTargetPath As String
If FolderBrowserDialog1.ShowDialog = DialogResult.OK Then
Dim oCount As Integer = 0
oFilenameOnly = Path.GetFileName(WMDocPathWindows)
oExtension = Path.GetExtension(WMDocPathWindows)
Dim oSQLGetFilename As String
oSQLGetFilename = $"DECLARE @Filename Varchar(512) " & vbNewLine &
$"EXEC dbo.PRPM_GETFILENAME_EXPORT {CURRENT_DOC_ID}, 1, @Outputfilename = @Filename OUTPUT;" & vbNewLine &
"SELECT @Filename"
Dim oExportFilename = Database.GetScalarValueECM(oSQLGetFilename)
oTargetPath = FolderBrowserDialog1.SelectedPath & "\" & oExportFilename & oExtension
File.Copy(WMDocPathWindows, oTargetPath)
oCount += 1
Dim oFileCount As Integer = 1
If Not IsNothing(DT_AdditionalSearches_Resultset_Docs) Then
For Each oFileRecord As DataRow In DT_AdditionalSearches_Resultset_Docs.Rows
Dim oFromFilename = oFileRecord.Item("FULL_FILENAME")
Dim oDocID = oFileRecord.Item("DocID")
If File.Exists(oFromFilename) Then
oFileCount += 1
oSQLGetFilename = $"DECLARE @Filename Varchar(512) " & vbNewLine &
$"EXEC dbo.PRPM_GETFILENAME_EXPORT {oDocID}, {oFileCount}, @Outputfilename = @Filename OUTPUT;" & vbNewLine &
"SELECT @Filename"
oExportFilename = Database.GetScalarValueECM(oSQLGetFilename)
oExtension = Path.GetExtension(oFromFilename)
'oFilenameOnly = Path.GetFileName(oFromFilename)
oTargetPath = FolderBrowserDialog1.SelectedPath & "\" & oExportFilename & oExtension
File.Copy(oFromFilename, oTargetPath)
oCount += 1
End If
Next
End If
CONFIG.Config.LastExportPath = FolderBrowserDialog1.SelectedPath
CONFIG.Save()
MsgBox($"[{oCount}] file/s successfully exported to target [{FolderBrowserDialog1.SelectedPath}]!", MsgBoxStyle.Information, ADDITIONAL_TITLE)
End If
Catch ex As Exception
LOGGER.Error(ex)
MsgBox("Could not move file to target: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE)
End Try
Else
MsgBox("Workflow-Document seems not to exist. Check Your log.", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE)
End If
End Sub
End Class
Reference in New Issue View Git Blame Copy Permalink