Files
TaskFlow/app/TaskFlow/frmValidator.vb
2026-03-03 12:55:01 +01:00

7837 lines
425 KiB
VB.net
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data.Entity.Core.Common.CommandTrees
'Imports System.Data.SqlClient
Imports System.Globalization
Imports System.IO
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Text.RegularExpressions
Imports System.Threading
Imports DevExpress.Data
Imports DevExpress.DataAccess.Native.Sql
Imports DevExpress.DataProcessing.InMemoryDataProcessor
Imports DevExpress.Utils
Imports DevExpress.Utils.Automation
Imports DevExpress.XtraBars
Imports DevExpress.XtraEditors
Imports DevExpress.XtraEditors.Mask
Imports DevExpress.XtraEditors.Repository
Imports DevExpress.XtraExport.Helpers
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Columns
Imports DevExpress.XtraGrid.Views.Base
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraSplashScreen
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.GUIs.Common
Imports DigitalData.GUIs.Common.DocumentResultList
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.EDMI.API.Constants
Imports DigitalData.Modules.EDMI.API.DatabaseWithFallback
Imports DigitalData.Modules.Interfaces
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.ZooFlow
Imports DigitalData.Modules.ZooFlow.Constants
'Imports System.Windows.Forms.VisualStyles.VisualStyleElement
'Imports System.Windows.Forms.VisualStyles.VisualStyleElement.TextBox
Imports WINDREAMLib
Public Class frmValidator
Public Event CustomColumnDisplayText As CustomColumnDisplayTextEventHandler
Private Property Current_Document As DocumentResultList.Document = Nothing
''' <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
Private Property GIT_TEST As Boolean = False
''' <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 DTInfoDoc As DataTable
Private Property PROFIL_sortbynewest As Boolean
Private Property PROFIL_VEKTORINDEX
Private Property PROFIL_FINISH_SQL
Private Property PROFIL_LOGINDEX
Private Property PROFIL_CURRENCY_ATTRIBUTE
Private Property PROFIL_REJECT_ACTIONS_ATTRIBUTE As String = ""
Private Property PROFIL_REJECT_COMMENT_ATTRIBUTE As String = ""
Private Property PROFIL_NOT_RESP_COMMENT_ATTR As String = ""
Private Property REJECTION_ACTIVE As Boolean = False
Private Property oErrMsgMissingInput
Private Const PMDelimiter As String = "~"
Private Property finalProfile As Boolean
Private Property Move2Folder As String
'Private Property DataASorDB As ClassDataASorDB
Private Property allgFunk As New ClassAllgemeineFunktionen
Private CountAction As Int16 = 0
Public Shared Property WMDocPathWindows As String
Private Property DocPathWindows As String
Private Property DocCurrency As String = "EUR"
'Anzahl der Validierungsdokumente
Private Property Amount_Docs2Validate As Integer
Private Property first_control As Control
Private Property last_control As Control
Public Shared Property idxerr_message As String = ""
Private Property _frmValidatorSearch As frmValidatorSearch
Private Property DT_AdditionalSearches_Resultset_Docs As DataTable
Private Property _Indexe_Loaded As Boolean = False
Private Property _DependingControl_In_Action As Boolean = False
Private Property _DependingColumn_In_Action As Boolean = False
Private Property _SetControlValue_In_Action As Boolean = False
Public Property _FormLoaded As Boolean = False
Private Property _FormClosing As Boolean = False
Private Property _ControlHandleStarted 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 DD_Documentloader As Loader
Private ControlCreator As ClassControlCreator
Private PerformanceLogger As Logger
Private Validator As Validator
Private Const LOG_PERF = False
Private ReadOnly MyValidationLogger As Logger
Private Property OperationMode As OperationMode
Private ReadOnly Environment As Environment
Private AdditionalDocResultsExist As Boolean = False
Private AdditionalDataResultsExist As Boolean = False
Private oProfileFinalText As String = ""
Private oProfileRejectionText As String = ""
Private oProfileNotResponsibleText As String = ""
Private oProfileNotResponsibleQuestion As String = ""
Private oProfile_REJECT_SQL_REASONS As String
Private oProfile_NOT_RESP_SQL As String
Private listofControls As New List(Of String)
Private frmMessages As frmValidator_Messages
Private ReadOnly _CachedSqlDataCache As New Dictionary(Of String, DataTable)(StringComparer.OrdinalIgnoreCase)
Private ReadOnly _CachedSqlScalarCache As New Dictionary(Of String, Object)(StringComparer.OrdinalIgnoreCase)
Private _CachedSqlControlsByGuid As Dictionary(Of Integer, List(Of DataRow))
Private _CachedLookupControlsByRepository As Dictionary(Of RepositoryItemLookupControl3, LookupControl3)
Private _CachedControlsBySetControlData As Dictionary(Of Integer, DataRow)
Private _CachedFinalIndexing As DataTable = Nothing
Private _CachedControlsByGuid As Dictionary(Of Integer, Control)
Private _isUpdatingLookup As Boolean = False
Private _suppressLookupEvents As Boolean = False
Private _overlayActive As Boolean = False
Private _isShowingErrorDialog As Boolean = False ' ← NEU: Klassenvariable oben hinzufügen
Private _overlayHandle As Object = Nothing ' ← NEU: Klassenvariable
Private Class Translation_Strings
Inherits My.Resources.frmValidator_Strings
End Class
Public Sub New(pEnvironment As Environment)
PerformanceLogger = LOGCONFIG.GetLoggerFor("PERF")
If LOG_PERF Then PerformanceLogger.Info("New")
MyValidationLogger = LOGCONFIG.GetLogger()
'MyBase.New
MyValidationLogger.Debug("Initialize Components...")
InitializeComponent()
Environment = pEnvironment
Try
MyValidationLogger.Debug("Initialize _frmValidatorSearch...")
_frmValidatorSearch = New frmValidatorSearch(Me, Environment)
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Private Function GetOperationMode() As OperationMode
Dim oOperationMode As OperationMode
If Environment.Service.Client Is Nothing And OPERATION_MODE_FS <> ClassConstants.OpModeFS_ZF Then
Return OperationMode.NoAppServer
End If
If Not IsNothing(Environment.Service.Client) Then
If Environment.Service.Client.IsOnline AndAlso Environment.Service.Client.ServerAddress <> String.Empty And IDB_USES_WMFILESTORE = False Then
oOperationMode = OperationMode.WithAppServer
Else
oOperationMode = OperationMode.NoAppServer
End If
End If
If OPERATION_MODE_FS = ClassConstants.OpModeFS_ZF Then
oOperationMode = OperationMode.ZooFlow
End If
Return oOperationMode
End Function
Private Function IsPositionVisible(position As Point) As Boolean
For Each scr As Screen In Screen.AllScreens
If scr.WorkingArea.Contains(position) Then
Return True ' Punkt ist sichtbar
End If
Next
Return False ' Punkt ist außerhalb aller sichtbaren Bereiche
End Function
Private Sub frmValidation_Load(sender As Object, e As System.EventArgs) Handles Me.Load
' === MESSPUNKT 1: Start ===
Dim perfStart As DateTime = If(LOG_HOTSPOTS, DateTime.Now, Nothing)
Dim perfLastCheck As DateTime = perfStart
If LOG_HOTSPOTS Then MyValidationLogger.Info($"[PERF frmValidation_Load] START")
Try
MyValidationLogger.Debug("###frmValidation_Load###")
MyValidationLogger.Debug("Current User Language: [{0}]", USER_LANGUAGE)
OperationMode = GetOperationMode()
DD_Documentloader = New Loader(LOGCONFIG, OperationMode, Environment.Service.Client, Environment.User)
ControlCreator = New ClassControlCreator(LOGCONFIG)
Validator = New Validator(LOGCONFIG)
Override = False
SplitContainer1.Panel2Collapsed = True
first_control = Nothing
_FormClosing = False
_FormLoaded = False
' In Load_Next_Document (einmalig):
If _CachedFinalIndexing Is Nothing AndAlso DTTBPM_PROFILE_FINAL_INDEXING IsNot Nothing Then
Dim rows = DTTBPM_PROFILE_FINAL_INDEXING.Select($"PROFIL_ID = {CURRENT_ProfilGUID} AND ACTIVE = 1", "SEQUENCE")
If rows.Length > 0 Then
_CachedFinalIndexing = rows.CopyToDataTable()
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Initialisierung: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error in frmValidation_load1: {ex.Message}")
End Try
Try
' === MESSPUNKT 3: Form-Position wiederherstellen ===
If My.Settings.frmValidatorPosition.IsEmpty = False Then
If IsPositionVisible(My.Settings.frmValidatorPosition) Then
Try
ScreenEx.RestoreFormPosition(Me, My.Settings.frmValidatorPosition)
Catch ex As Exception
Me.StartPosition = FormStartPosition.CenterScreen
End Try
If My.Settings.frmValidatorPosition.X > 0 And My.Settings.frmValidatorPosition.Y > 0 Then
Location = My.Settings.frmValidatorPosition
Else
Try
MyValidationLogger.Debug($"!! Invalid PositionData X({My.Settings.frmValidatorPosition.X}), Y({My.Settings.frmValidatorPosition.Y})")
Catch ex As Exception
End Try
End If
Else
Me.StartPosition = FormStartPosition.CenterScreen
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
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Position/Size: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Catch ex As Exception
MyValidationLogger.Info($"Error loading position: {ex.Message}")
End Try
Dim _step = 0
Try
' === MESSPUNKT 4: DocumentViewer Init ===
Dim oDVSettings As New DigitalData.Controls.DocumentViewer.DocumentViewer.ToolbarSettings() With {
.ShowPrintButton = True,
.ShowRotateButton = True,
.ShowFlipButton = True,
.ShowSettingButton = True
}
DocumentViewer1.Init(LOGCONFIG, GDPICTURE_LICENSE, oDVSettings)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach DocumentViewer.Init: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
Try
_step = 1
_step = 2
' === MESSPUNKT 5: Profile Data laden (KRITISCH) ===
DTVWCONTROL_INDEX.Clear()
Dim oExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}"
DTVWCONTROLS_INDEX.Select(oExpression, "Y_LOC, X_LOC").CopyToDataTable(DTVWCONTROL_INDEX, LoadOption.PreserveChanges)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach DTVWCONTROL_INDEX laden ({DTVWCONTROL_INDEX.Rows.Count} Rows): {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
_step = 3
MyValidationLogger.Debug("Profile Data loaded")
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Error LOADING profile-data(" & _step.ToString & "):" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
MyValidationLogger.Info(">> Error in LOADING profile-data: " & ex.Message, True)
Me.Close()
End Try
MyValidationLogger.Debug("frmValidation_Load finished till Step 3!")
Try
If CURRENT_DT_PROFILE.Rows.Count = 0 Then
MyValidationLogger.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
MyValidationLogger.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
MyValidationLogger.Debug("Step 5")
If CURRENT_DT_PROFILE.Rows.Count = 1 Then
_step = 6
MyValidationLogger.Debug("Step 6")
Dim profileLangAll = CURRENT_DT_PROFILE_LANGUAGE.AsEnumerable().
GroupBy(Function(r) r.Field(Of String)("TITLE")).
ToDictionary(Function(g) g.Key, Function(g) g.First())
Dim profileLangUser = CURRENT_DT_PROFILE_LANGUAGE.AsEnumerable().
Where(Function(r) r.Field(Of String)("LANGUAGE") = USER_LANGUAGE).
GroupBy(Function(r) r.Field(Of String)("TITLE")).
ToDictionary(Function(g) g.Key, Function(g) g.First())
' === MESSPUNKT 6: Profile-Properties verarbeiten ===
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_CURRENCY_ATTRIBUTE = oProfileRow.Item("CURRENCY_ATTRIBUTE")
PROFILE_NOT_RESP_COMMENT = oProfileRow.Item("NOT_RESP_COMMENT")
PROFIL_REJECT_ACTIONS_ATTRIBUTE = oProfileRow.Item("REJECT_ACTIONS_ATTRIBUTE")
PROFIL_REJECT_COMMENT_ATTRIBUTE = oProfileRow.Item("REJECT_COMMENT_ATTRIBUTE")
PROFIL_NOT_RESP_COMMENT_ATTR = oProfileRow.Item("NOT_RESP_COMMENT_ATTRIBUTE")
REJECTION_ACTIVE = False
PROFIL_LOGINDEX = oProfileRow.Item("LOG_INDEX")
CURRENT_PROFILE_LOG_INDEX = PROFIL_LOGINDEX
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Profile-Properties: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' === MESSPUNKT 7: Language-Strings laden (optimiert) ===
Dim oProfileTitle As String = ""
Dim oProfileDescription As String = ""
Dim titleKey = $"PROFILE_TITLE{CURRENT_ProfilGUID}"
Dim descKey = $"PROFILE_DESCRIPTION{CURRENT_ProfilGUID}"
Dim finalKey = $"PROFILE_FINAL_TEXT{CURRENT_ProfilGUID}"
Dim rejectKey = $"PROFILE_REJECTION_CAPT{CURRENT_ProfilGUID}"
Dim notRespKey = $"PROFILE_NOT_RESPONSIBLE_CAPT{CURRENT_ProfilGUID}"
Dim notRespQKey = $"PROFILE_NOT_RESPONSIBLE_QUEST{CURRENT_ProfilGUID}"
Dim row As DataRow = Nothing
If profileLangAll.TryGetValue(titleKey, row) Then oProfileTitle = row.Item("STRING1")
If profileLangAll.TryGetValue(descKey, row) Then oProfileDescription = row.Item("STRING1")
If profileLangAll.TryGetValue(rejectKey, row) Then oProfileRejectionText = row.Item("STRING1")
If profileLangUser.TryGetValue(finalKey, row) Then
If row.Item("STRING1").ToString <> "" Then oProfileFinalText = row.Item("STRING1")
End If
If profileLangUser.TryGetValue(notRespKey, row) Then oProfileNotResponsibleText = row.Item("STRING1")
If profileLangUser.TryGetValue(notRespQKey, row) Then oProfileNotResponsibleQuestion = row.Item("STRING1")
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Language-Loop ({CURRENT_DT_PROFILE_LANGUAGE.Rows.Count} Rows): {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If oProfileTitle = "" Then
oProfileTitle = oProfileRow.Item("TITLE")
End If
Me.Text = ADDITIONAL_TITLE & " - " & oProfileTitle
If oProfileDescription = "" Then
IIf(IsDBNull(oProfileRow.Item("DESCRIPTION")), "", oProfileRow.Item("DESCRIPTION"))
End If
TITLELabel1.Text = oProfileTitle
Dim opnlPoint As New Point(8, 132)
If oProfileDescription <> String.Empty Then
DESCRIPTIONLabel.Text = oProfileDescription
Else
DESCRIPTIONLabel.Visible = False
opnlPoint = New Point(5, 35)
Dim oSize As New Size(PanelValidatorControl.Size.Width, SplitContainerButtons.Location.Y - 40)
PanelValidatorControl.Location = opnlPoint
PanelValidatorControl.Size = oSize
End If
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
finalProfile = oProfileRow.Item("FINAL_PROFILE")
Move2Folder = IIf(IsDBNull(oProfileRow.Item("MOVE2Folder")), "", oProfileRow.Item("MOVE2Folder"))
' === MESSPUNKT 8: Button-Texte setzen ===
Try
If finalProfile = True Then
If oProfileFinalText = "" Then
oProfileFinalText = IIf(IsDBNull(oProfileRow.Item("FINAL_TEXT")), "", oProfileRow.Item("FINAL_TEXT") & (" (F2)"))
Else
oProfileFinalText = $"{oProfileFinalText} (F2)"
End If
btnSave.Text = oProfileFinalText
Else
oProfileFinalText = IIf(IsDBNull(oProfileRow.Item("FINAL_TEXT")), "", oProfileRow.Item("FINAL_TEXT") & (" (F2)"))
If oProfileFinalText = String.Empty Then
oProfileFinalText = ClassAllgemeineFunktionen.GUI_LANGUAGE_INFO("frmValidator.ValidationButton")
End If
btnSave.Text = oProfileFinalText
End If
MyValidationLogger.Debug("Buttontext validation loaded")
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Button-Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Error loading final profile text:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
MyValidationLogger.Info(">> Error loading final profile text: " & ex.Message, True)
End Try
' === MESSPUNKT 9: Rejection/NotResponsible-Buttons konfigurieren ===
Dim PROF_BTN_RE_CAPT = oProfileRow.Item("BTN_REJECT_CAPTION")
Dim PROF_SQL_BTN_REJECT = oProfileRow.Item("SQL_BTN_REJECT")
oProfile_REJECT_SQL_REASONS = oProfileRow.Item("REJECT_SQL_REASONS")
oProfile_NOT_RESP_SQL = oProfileRow.Item("NOT_RESP_SQL")
If oProfileRejectionText = String.Empty Then
oProfileRejectionText = PROF_BTN_RE_CAPT
End If
MyValidationLogger.Debug($"oProfileRejectionText: " + oProfileRejectionText)
MyValidationLogger.Debug($"oProfile_REJECT_SQL_REASONS: " + oProfile_REJECT_SQL_REASONS)
MyValidationLogger.Debug($"oProfileNotResponsibleText: " + oProfileNotResponsibleText)
MyValidationLogger.Debug($"oProfile_NOT_RESP_SQL: " + oProfile_NOT_RESP_SQL)
Dim functBtnReject As Boolean = False
Dim functBtnNR As Boolean = False
If oProfileRejectionText <> String.Empty And oProfile_REJECT_SQL_REASONS <> String.Empty Then
functBtnReject = True
End If
If (oProfileNotResponsibleQuestion <> String.Empty Or oProfileNotResponsibleText <> String.Empty) And oProfile_NOT_RESP_SQL <> String.Empty Then
If IDB_ACTIVE = True Then
functBtnNR = True
End If
End If
If functBtnReject = False And functBtnNR = False Then
MyValidationLogger.Debug($"!Keine Ablehnung und Nicht zuständig Funktion konfiguriert!")
SplitContainerReject_NotResp.Visible = False
SplitContainerButtons.CollapsePanel = SplitCollapsePanel.None
SplitContainerButtons.PanelVisibility = SplitPanelVisibility.Panel2
Else
SplitContainerButtons.CollapsePanel = SplitCollapsePanel.Panel1
SplitContainerReject_NotResp.Visible = True
If functBtnReject = True And functBtnNR = True Then
MyValidationLogger.Debug($"Nicht zuständig und Ablehnungs-Buttons werden eingeblendet!")
SplitContainerReject_NotResp.CollapsePanel = SplitCollapsePanel.None
SplitContainerButtons.PanelVisibility = SplitPanelVisibility.Both
btnReject.Text = oProfileRejectionText
btnNotResponsible.Text = oProfileNotResponsibleText
If USER_GHOST_MODE_ACTIVE Then
btnReject.Enabled = False
btnNotResponsible.Enabled = False
Else
btnReject.Enabled = True
btnNotResponsible.Enabled = True
End If
Else
If functBtnNR = True Then
MyValidationLogger.Debug($"Nicht zuständig Button wird eingeblendet!")
SplitContainerReject_NotResp.CollapsePanel = SplitCollapsePanel.Panel1
SplitContainerReject_NotResp.PanelVisibility = SplitPanelVisibility.Panel2
btnReject.Visible = False
SplitContainerReject_NotResp.Collapsed = True
btnNotResponsible.Text = oProfileNotResponsibleText
If USER_GHOST_MODE_ACTIVE Then
btnNotResponsible.Enabled = False
Else
btnNotResponsible.Enabled = True
End If
Else
SplitContainerReject_NotResp.CollapsePanel = SplitCollapsePanel.Panel2
SplitContainerReject_NotResp.PanelVisibility = SplitPanelVisibility.Panel1
SplitContainerReject_NotResp.Collapsed = True
btnNotResponsible.Visible = False
btnReject.Text = oProfileRejectionText
If USER_GHOST_MODE_ACTIVE Then
btnReject.Enabled = False
Else
btnReject.Enabled = True
End If
End If
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Rejection/NR-Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
bbtniNext.Visibility = BarItemVisibility.Never
If CURRENT_JUMP_DOC_GUID <> 0 Then
Amount_Docs2Validate = 1
Else
Amount_Docs2Validate = 0
End If
Next
MyValidationLogger.Debug(" >> profiledata saved:")
MyValidationLogger.Debug(" >> finalProfile: " & finalProfile)
MyValidationLogger.Debug(" >> Move2Folder: " & Move2Folder)
MyValidationLogger.Debug(" >> Right_Delete: " & USER_RIGHT_FILE_DELETE)
PROFIL_sortbynewest = CURRENT_DT_PROFILE.Rows(0).Item("SORT_BY_LATEST")
MyValidationLogger.Debug("PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString)
If USER_RIGHT_FILE_DELETE = True Then
bbtniDelete.Visibility = BarItemVisibility.Always
Else
bbtniDelete.Visibility = BarItemVisibility.Never
End If
If CBool(CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then
bbtniAnnotation.Visibility = BarItemVisibility.Always
Else
bbtniAnnotation.Visibility = BarItemVisibility.Never
End If
MyValidationLogger.Debug("Right_Delete: " & USER_RIGHT_FILE_DELETE.ToString)
' === MESSPUNKT 10: Create_Controls (KRITISCH - wahrscheinlich größter Hotspot) ===
If LOG_HOTSPOTS Then MyValidationLogger.Info($"[PERF frmValidation_Load] Vor Create_Controls")
Create_Controls()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] Nach Create_Controls: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
End If
End If
MyValidationLogger.Debug("frmValidation_Load finished!")
' === MESSPUNKT 11: Gesamt-Zeit ===
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_Load] GESAMT frmValidation_Load: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Error LOADING Profile-Data1:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
MyValidationLogger.Info("Unexpected error in LOADING Profile-Data1: " & ex.Message)
End Try
End Sub
Private _isClosingGuard As Boolean = False
Private Sub DetachAllGridEvents(parent As Control)
For Each ctrl As Control In parent.Controls
If TypeOf ctrl Is GridControl Then
Dim gc = DirectCast(ctrl, GridControl)
Try
For Each view In gc.Views
If TypeOf view Is GridView Then
Dim gv = DirectCast(view, GridView)
RemoveHandler gv.CellValueChanged, AddressOf GridView_CellValueChanged
RemoveHandler gv.KeyDown, AddressOf GridView_KeyDown
RemoveHandler gv.RowDeleting, AddressOf GridView_RowDeleting
' DataSource-Events ebenfalls trennen
If TypeOf gv.DataController.DataSource Is DataTable Then
Dim dt = DirectCast(gv.DataController.DataSource, DataTable)
RemoveHandler dt.RowDeleted, AddressOf GridDataSource_RowDeleted
End If
End If
Next
Catch ex As Exception
MyValidationLogger.Warn($"[DetachAllGridEvents] Grid [{ctrl.Name}]: {ex.Message}")
End Try
End If
If ctrl.Controls.Count > 0 Then
DetachAllGridEvents(ctrl)
End If
Next
End Sub
Private Sub frmValidation_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
' Guard: Re-Entry und Post-Dispose-Aufrufe verhindern
If _isClosingGuard Then
MyValidationLogger.Warn("[FormClosing] Guard aktiv Exit")
Return
End If
_isClosingGuard = True
_FormClosing = True
' ===== FIX: Grid-Events SOFORT deregistrieren =====
' Der GridControl-Lambda läuft noch asynchron weiter und greift sonst
' nach DocumentViewer.Done() auf bereits freigegebene UI-Objekte zu.
Try
DetachAllGridEvents(Me)
Catch ex As Exception
MyValidationLogger.Warn($"[FormClosing] DetachAllGridEvents: {ex.Message}")
End Try
' ===== ENDE FIX =====
Try
If LOG_HOTSPOTS Then
' ========== DIAGNOSE: Wer schließt die Form? ==========
MyValidationLogger.Debug($"frmValidator_FormClosing aufgerufen!")
MyValidationLogger.Debug($"CloseReason: {e.CloseReason}")
MyValidationLogger.Debug($"Cancel: {e.Cancel}")
' *** KORREKTUR: StackTrace richtig erstellen ***
Dim st As New StackTrace(True)
MyValidationLogger.Debug($"StackTrace: {st.ToString()}")
' Zusätzliche Diagnostik
MyValidationLogger.Debug($"_FormClosing-Flag: {_FormClosing}")
MyValidationLogger.Debug($"CURRENT_DOC_GUID: {CURRENT_DOC_GUID}")
MyValidationLogger.Debug($"CURRENT_ProfilGUID: {CURRENT_ProfilGUID}")
' ========== ENDE DIAGNOSE ==========
End If
Dim perfStart As DateTime = DateTime.MinValue
Dim perfLastCheck As DateTime = DateTime.MinValue
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
perfLastCheck = perfStart
MyValidationLogger.Info("[PERF frmValidation_FormClosing] START")
End If
_FormClosing = True
' ========== FIX 5: Sichere Prüfung für frmMessages ==========
If Not Me.IsDisposed AndAlso Application.OpenForms().OfType(Of frmValidator_Messages).Any Then
If Not IsNothing(frmMessages) AndAlso Not frmMessages.IsDisposed Then
Try
frmMessages.Close()
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [FormClosing] frmMessages.Close() failed: {ex.Message}")
End Try
End If
End If
' ========== ENDE FIX 5 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach Messages-Close: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' ========== FIX 6: Settings nur bei nicht-disposed Form ==========
If Not Me.IsDisposed Then
Try
' Position und Größe speichern
My.Settings.frmValidatorSize = Me.Size
My.Settings.frmValidatorPosition = Me.Location
My.Settings.frmValidatorWindowState = If(Me.WindowState = FormWindowState.Maximized, "Maximized", "Normal")
My.Settings.Save()
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [FormClosing] Settings.Save() failed: {ex.Message}")
MyValidationLogger.Error(ex)
End Try
End If
' ========== ENDE FIX 6 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach Settings.Save: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' ========== FIX 7: Inactivity Timer ==========
If INACTIVITY_DURATION <> 0 Then
Try
frmMain.Timer_Inactivity_Reset_Disable("FormClosing")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [FormClosing] Timer_Inactivity failed: {ex.Message}")
End Try
End If
' ========== ENDE FIX 7 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach Timer-Reset: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' ========== FIX 8: DB Cleanup ==========
Try
Dim oSQL As String
If CURRENT_DOC_GUID <> 0 Then
Dim oPRoc = String.Format("EXEC PRTF_PROFILE_FILES_WORK {0},{1},{2},'FreeFile';", CURRENT_DOC_ID, CURRENT_ProfilGUID, USER_ID)
oSQL = $"DELETE FROM TBPM_DOCWALKOVER WHERE UserID = {USER_ID};" & vbCrLf & oPRoc
Else
oSQL = $"DELETE FROM TBPM_DOCWALKOVER WHERE UserID = {USER_ID};"
End If
DatabaseFallback.ExecuteNonQueryECM(oSQL)
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Error in delete jumped files:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
End Try
' ========== ENDE FIX 8 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach DB-Cleanup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Reset_CurrentReferences()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach Reset_CurrentReferences: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' ========== FIX 9: DocumentViewer cleanup ==========
Try
If Not IsNothing(DocumentViewer1) AndAlso Not DocumentViewer1.IsDisposed Then
DocumentViewer1.CloseDocument()
DocumentViewer1.Done()
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in DocumentViewerValidator.Done: {ex.Message}")
End Try
' ========== ENDE FIX 9 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach DocumentViewer.Done: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
' ========== FIX 10: ValidatorSearch cleanup ==========
Try
If _frmValidatorSearch IsNot Nothing AndAlso Not _frmValidatorSearch.IsDisposed Then
_frmValidatorSearch.Close()
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
' ========== ENDE FIX 10 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] nach ValidatorSearch.Close: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF frmValidation_FormClosing] GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
Finally
' WICHTIG: Guard wird NICHT zurückgesetzt, da die Form nun wirklich schließt.
' Ein Reset würde den erneuten BeginInvoke-Close wieder durchlassen.
' _isClosingGuard = False ← absichtlich NICHT zurückgesetzt
End Try
End Sub
Sub Reset_CurrentReferences()
If Not IsNothing(DT_AdditionalSearches_Resultset_Docs) Then
DT_AdditionalSearches_Resultset_Docs.Clear()
End If
End Sub
Public Function Test_Additional_Data_Searches_Exist() As Boolean
If BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Then
Dim oDataResultCommand As String
Dim oDatatableDataResult As DataTable = Nothing
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 = DatabaseFallback.GetDatatableWithConnection(oDataResultCommand, oConID)
End If
Dim oDataResultsExist 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
Return oDataResultsExist
Else
Return False
End If
End Function
Public Function Test_Additional_Doc_Searches_Exist() As Boolean
If DT_FILTERED_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then
Dim oDocResultCommand As String
Dim oDatatableDocResult As DataTable = Nothing
'Check whether DocData is there
Dim oConID = DT_FILTERED_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID")
oDocResultCommand = DT_FILTERED_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND")
oDocResultCommand = clsPatterns.ReplaceAllValues(oDocResultCommand, PanelValidatorControl, True)
oDatatableDocResult = DatabaseFallback.GetDatatableWithConnection(oDocResultCommand, oConID)
Dim oDocResultsExist As Boolean = False
If Not IsNothing(oDatatableDocResult) Then
If oDatatableDocResult.Rows.Count > 0 Then
oDocResultsExist = True
DT_AdditionalSearches_Resultset_Docs = oDatatableDocResult
End If
End If
Return oDocResultsExist
Else
Return False
End If
End Function
Public Sub Load_Additional_Searches(Preload As Boolean)
Try
AdditionalDocResultsExist = Test_Additional_Doc_Searches_Exist()
AdditionalDataResultsExist = Test_Additional_Data_Searches_Exist()
'If Test_Additional_Searches_Exist() Then
If AdditionalDataResultsExist = True Or AdditionalDocResultsExist = True Then
Try
If RibbonPageCustItm1 <> "" Then
Attmt_bbtnitmShow.Caption = RibbonPageCustItm1
End If
rbnPgGroupAttmt.Visible = True
Attmnt_bbtnitm_LoadonClick.Checked = CONFIG.Config.ADDITIONAL_SEARCHES_LOAD_ONCLICK
Dim oConID As Int16
Dim oCommand As String
If Preload = True Then
_frmValidatorSearch.TabPreload(BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows.Count, DT_FILTERED_PROFILE_SEARCHES_DOC.Rows.Count,
BASEDATA_DT_PROFILE_SEARCHES_SQL, DT_FILTERED_PROFILE_SEARCHES_DOC)
If AdditionalDocResultsExist Then
_frmValidatorSearch._DTDocSearches = DT_FILTERED_PROFILE_SEARCHES_DOC
oConID = DT_FILTERED_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID")
oCommand = DT_FILTERED_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND")
oCommand = clsPatterns.ReplaceAllValues(oCommand, PanelValidatorControl, True)
_frmValidatorSearch.RefreshTabDoc(oConID, oCommand, 0, DT_FILTERED_PROFILE_SEARCHES_DOC.Rows(0).Item("TAB_TITLE"))
End If
If AdditionalDataResultsExist Then
_frmValidatorSearch._DTSQLSearches = BASEDATA_DT_PROFILE_SEARCHES_SQL
oConID = BASEDATA_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("CONN_ID")
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
Else
MyValidationLogger.Info("There are additional searches configured, but PRELOAD is false. So they won't be load!")
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
bbtniRefreshSearches.Visibility = BarItemVisibility.Always
Else
MyValidationLogger.Debug("AdditionalData/Docresults = false!")
bbtniRefreshSearches.Visibility = BarItemVisibility.Never
rbnPgGroupAttmt.Visible = False
End If
'Else
' Logger.Debug("Not loading AdditionalSearches 2...!")
' bbtniRefreshSearches.Visibility = BarItemVisibility.Never
'End If
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE)
End Try
End Sub
Private Sub EnsureSqlControlLookup()
If _CachedSqlControlsByGuid IsNot Nothing Then
Return
End If
_CachedSqlControlsByGuid = New Dictionary(Of Integer, List(Of DataRow))()
If DTCONTROLS_WITH_SQL Is Nothing OrElse DTCONTROLS_WITH_SQL.Rows.Count = 0 Then
Return
End If
For Each row As DataRow In DTCONTROLS_WITH_SQL.Rows
If row.ItemEx("PROFIL_ID", 0) <> CURRENT_ProfilGUID Then
Continue For
End If
Dim controlId As Integer
If Not Integer.TryParse(row.Item("GUID").ToString(), controlId) Then
Continue For
End If
Dim list As List(Of DataRow) = Nothing
If Not _CachedSqlControlsByGuid.TryGetValue(controlId, list) Then
list = New List(Of DataRow)()
_CachedSqlControlsByGuid(controlId) = list
End If
list.Add(row)
Next
End Sub
Sub LoadSQLData(control As Control, pControlId As Integer)
Try
If TypeOf control Is Label Then
Exit Sub
End If
MyValidationLogger.Debug($"in LoadSQLData for ControlID [{pControlId}]...")
EnsureSqlControlLookup()
Dim rows As List(Of DataRow) = Nothing
If _CachedSqlControlsByGuid Is Nothing OrElse Not _CachedSqlControlsByGuid.TryGetValue(pControlId, rows) Then
Exit Sub
End If
For Each row As DataRow In rows
Dim name As String = row.Item("NAME")
Dim oGUID As String = row.Item("GUID")
Dim oReadOnly As Boolean = row.Item("READ_ONLY")
MyValidationLogger.Debug($"LoadSQLData for Control [{name}] with GUID [{oGUID}] ...")
If oReadOnly = True Then
MyValidationLogger.Debug("Control for Index [{0}] is read-only. Continuing.")
Continue For
End If
If IsDBNull(row.Item("CONNECTION_ID")) Then
MyValidationLogger.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 String.IsNullOrWhiteSpace(oSQLStatement) Then
Continue For
End If
oSQLStatement = clsPatterns.ReplaceAllValues(oSQLStatement, PanelValidatorControl, True)
If String.IsNullOrWhiteSpace(oSQLStatement) Then
Continue For
End If
If clsPatterns.HasComplexPatterns(oSQLStatement) Then
MyValidationLogger.Warn($"⚠️ Unexpected error LoadSQLData2 - sql Statement still has complex patterns! [{oSQLStatement}]")
Continue For
End If
Dim oDTContent As DataTable = GetCachedDatatable(oSQLStatement, oConnectionId)
If oDTContent Is Nothing OrElse oDTContent.Rows.Count = 0 Then
Continue For
End If
Dim oValue
If TypeOf control Is LookupControl3 Then
Try
Dim lookup As LookupControl3 = control
MyValidationLogger.Debug($"[LoadSQLData DEBUG] Lookup [{name}] konfiguriert:")
MyValidationLogger.Debug($" DataSource-Typ: {lookup.Properties.DataSource?.GetType()}")
MyValidationLogger.Debug($" ValueMember: [{lookup.Properties.ValueMember}]")
MyValidationLogger.Debug($" DisplayMember: [{lookup.Properties.DisplayMember}]")
Dim originalValueMember = lookup.Properties.ValueMember
Dim originalDisplayMember = lookup.Properties.DisplayMember
Dim previousSelectedValues As List(Of String) = Nothing
If lookup.Properties.SelectedValues IsNot Nothing AndAlso lookup.Properties.SelectedValues.Count > 0 Then
previousSelectedValues = New List(Of String)(lookup.Properties.SelectedValues)
MyValidationLogger.Debug($"[LoadSQLData BUGFIX] Alte SelectedValues gesichert: [{String.Join(",", previousSelectedValues)}]")
End If
lookup.Properties.BeginUpdate()
Try
lookup.Properties.DataSource = oDTContent
Dim valueMember As String = originalValueMember
If String.IsNullOrWhiteSpace(valueMember) OrElse Not oDTContent.Columns.Contains(valueMember) Then
valueMember = oDTContent.Columns(0).ColumnName
End If
Dim displayMember As String = originalDisplayMember
If String.IsNullOrWhiteSpace(displayMember) OrElse Not oDTContent.Columns.Contains(displayMember) Then
displayMember = valueMember
End If
lookup.Properties.ValueMember = valueMember
lookup.Properties.DisplayMember = displayMember
If previousSelectedValues IsNot Nothing AndAlso previousSelectedValues.Count > 0 Then
Dim validValues As New List(Of String)
For Each oldValue As String In previousSelectedValues
Dim exists = oDTContent.AsEnumerable().
Any(Function(r) r.Item(valueMember).ToString = oldValue)
If exists Then
validValues.Add(oldValue)
MyValidationLogger.Debug($"[LoadSQLData BUGFIX] Wert [{oldValue}] existiert im neuen DataSource ✓")
Else
MyValidationLogger.Warn($"⚠️ [LoadSQLData BUGFIX] Wert [{oldValue}] existiert NICHT im neuen DataSource ✗")
End If
Next
If validValues.Count > 0 Then
lookup.Properties.SelectedValues = validValues
MyValidationLogger.Debug($"[LoadSQLData BUGFIX] SelectedValues wiederhergestellt: [{String.Join(",", validValues)}]")
End If
End If
Finally
lookup.Properties.EndUpdate()
End Try
Catch ex As Exception
MyValidationLogger.Warn("⚠️ Error in LookUpLoadSQLData: " & ex.Message)
End Try
ElseIf TypeOf control Is DevExpress.XtraEditors.TextEdit Or TypeOf control Is MemoEdit Then
Try
Dim firstRow As DataRow = oDTContent.Rows(0)
Dim value = firstRow.Item(0)
DirectCast(control, BaseEdit).EditValue = value
oValue = value
Catch ex As Exception
MyValidationLogger.Warn("⚠️ Error in TextBoxLoadSQLData: " & ex.Message)
End Try
ElseIf TypeOf control Is Windows.Forms.ComboBox Then
Try
Dim oMyComboBox As Windows.Forms.ComboBox = control
' Aktuellen TEXT sichern (nicht Index der kann nach Refresh an anderer Position sein)
Dim previousText As String = oMyComboBox.Text
Dim oselectedIndex = oMyComboBox.SelectedIndex
MyValidationLogger.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
MyValidationLogger.Warn("⚠️ Error in ComboBoxLoadSQLData: " & 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 Then
oDataSource = oDTContent.Clone()
End If
If oDataSource.Rows.Count = 0 Then
For Each oColumn As DataColumn In oDTContent.Columns
If oDataSource.Columns(oColumn.ColumnName) Is Nothing Then
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
MyValidationLogger.Warn("⚠️ Error in GridControlSQLData: " & ex.Message)
End Try
End If
Next
Catch ex As Exception
MyValidationLogger.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()
If LOG_PERF Then PerformanceLogger.Info("Create_Controls")
Dim oControlInfo As String
Try
_CachedControlsByGuid = Nothing ' Cache invalidieren
PanelValidatorControl.Controls.Clear()
_CachedLookupControlsByRepository = New Dictionary(Of RepositoryItemLookupControl3, LookupControl3)()
Dim oSQL As String
Dim oFilter As String = $"LANGUAGE = '{USER_LANGUAGE}' AND PROFIL_ID = {CURRENT_ProfilGUID}"
DT_CONTROLS = GetControlMetaBySql(oFilter, "Y_LOC, X_LOC")
' ========== NEU: Einmalige Gruppierung für SetControlValues_FromControl ==========
If DT_CONTROLS IsNot Nothing AndAlso DT_CONTROLS.Rows.Count > 0 Then
_CachedControlsBySetControlData = New Dictionary(Of Integer, DataRow)()
For Each row As DataRow In DT_CONTROLS.AsEnumerable().Where(Function(r) Not String.IsNullOrWhiteSpace(r.ItemEx("SET_CONTROL_DATA", String.Empty)))
Dim controlId As Integer = row.Item("GUID")
_CachedControlsBySetControlData(controlId) = row
Next
End If
' ========== ENDE ==========
oSQL = $"SELECT IIF(LANG.CAPTION IS NULL,T.SPALTEN_HEADER,LANG.CAPTION) SPALTEN_HEADER_LANG, T.* from TBPM_CONTROL_TABLE T INNER JOIN TBPM_PROFILE_CONTROLS T1 ON T.CONTROL_ID = T1.GUID
LEFT JOIN (SELECT * FROM TBPM_CONTOL_TABLE_LANG WHERE LANG_CODE = '{USER_LANGUAGE}') LANG ON T.GUID = LANG.COL_ID WHERE T1.CONTROL_ACTIVE = 1 AND T.CONTROL_ID = T1.GUID AND T1.PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY T.SEQUENCE"
DT_COLUMNS_GRID = DatabaseFallback.GetDatatable("TBPM_CONTROL_TABLE", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID} AND LANG_CODE = '{USER_LANGUAGE}' ",
.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 = DatabaseFallback.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 = DatabaseFallback.GetDatatable("DTGRID_SQL_DEFINITION", New GetDatatableOptions(oSQL, DatabaseType.ECM) With {
.FilterExpression = $"PROFIL_ID = {CURRENT_ProfilGUID}",
.SortByColumn = "SEQUENCE"
})
Dim oTabIndexCounter As Integer = 0
For Each oControlRow As DataRow In DT_CONTROLS.Rows
Dim oMyControl As Control
Dim oIndexName = oControlRow.Item("INDEX_NAME")
Dim oControlID = oControlRow.Item("GUID")
oControlInfo = $"CtrlID: {oControlID} - CtrlName: {oControlRow.Item("NAME")} - CtrlIndex: {oControlRow.Item("INDEX_NAME")}"
Try
If LOG_PERF Then PerformanceLogger.Info(oControlInfo + "")
Select Case oControlRow.Item("CTRL_TYPE").ToString.ToUpper
Case ClassControlCreator.PREFIX_TEXTBOX
If LOG_PERF Then PerformanceLogger.Info("Create_Controls/Textbox")
Try
oControlInfo = ClassControlCreator.PREFIX_TEXTBOX & "#" & oControlInfo
MyValidationLogger.Debug($"[{oControlInfo}] - TXT Try to create control...")
Dim txt As BaseEdit = ControlCreator.CreateExistingTextbox(oControlRow, False)
If oIndexName = "@@DISPLAY_ONLY" Then
txt.ReadOnly = True
End If
AddHandler txt.GotFocus, AddressOf OnTextBoxFocus
AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp
AddHandler txt.KeyDown, AddressOf OnTextBoxKeyDown
AddHandler txt.EditValueChanged, AddressOf OnTextBoxEditValueChanged
oMyControl = txt
MyValidationLogger.Debug($"[{oControlInfo}] - TXT Created!!")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Create_Controls TXT [{oControlInfo}]: {ex.Message}")
End Try
Case "LBL"
oControlInfo = "LBL#" & oControlInfo
oMyControl = ControlCreator.CreateExistingLabel(oControlRow, False)
Case "CMB"
If LOG_PERF Then PerformanceLogger.Info("Create_Controls/ComboBox")
oControlInfo = "CMB#" & oControlInfo
MyValidationLogger.Debug($"[{oControlInfo}] - CMB Try to create control...")
If oControlRow.Item("READ_ONLY") Then
Dim cmbReadonly = ControlCreator.CreateExistingTextbox(oControlRow, False)
oMyControl = cmbReadonly
Else
Dim oComboBox = ControlCreator.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
MyValidationLogger.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
MyValidationLogger.Debug("ConID <> String.Empty")
If oCommandSQL_UBPF <> String.Empty Then
MyValidationLogger.Debug("ConID > 0 And commandsql <> String.Empty")
Try
oSQL = PreventNulletc(oControlRow.Item("SQL_UEBERPRUEFUNG"), "String")
If clsPatterns.HasOnlySimplePatterns(oSQL) Then
MyValidationLogger.Debug("SQL HasOnlySimplePatterns!")
oSQL = clsPatterns.ReplaceInternalValues(oSQL)
oSQL = clsPatterns.ReplaceControlValues(oSQL, PanelValidatorControl, True)
Dim oDT As DataTable = GetCachedDatatable(oSQL, oCONID)
oComboBox.BeginUpdate()
oComboBox.DataSource = Nothing
If Not IsNothing(oDT) AndAlso oDT.Rows.Count > 0 Then
Dim list As New List(Of String)
For Each oRow As DataRow In oDT.Rows
list.Add(oRow.Item(0))
Next
oComboBox.DataSource = list
End If
oComboBox.SelectedIndex = -1
oComboBox.EndUpdate()
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in CMB GetValues SQL - Error: {ex.Message}")
End Try
Else
MyValidationLogger.Debug("Else Row 571")
End If
Else
MyValidationLogger.Debug("AListe Handling")
Dim AListe As String = oControlRow.Item("CHOICE_LIST")
MyValidationLogger.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
MyValidationLogger.Debug($"[{oControlInfo}] - CMB CONTROL created")
Case "DTP"
oControlInfo = "DTP#" & oControlInfo
oMyControl = ControlCreator.CreateExistingDatepicker(oControlRow, False)
Case "DGV"
Dim dgv = ControlCreator.CreateExistingDataGridView(oControlRow, False)
AddHandler dgv.RowValidating, AddressOf onDGVRowValidating
oMyControl = dgv
Case "LOOKUP"
If LOG_PERF Then PerformanceLogger.Info("Create_Controls/Lookup")
oControlInfo = "LOOKUP#" & oControlInfo
Dim oMultiselect = CBool(oControlRow.Item("MULTISELECT"))
Dim oReadonly = oControlRow.Item("READ_ONLY")
If oMultiselect = False And oReadonly = True Then
Dim lookupReadonly = ControlCreator.CreateExistingTextbox(oControlRow, False)
oMyControl = lookupReadonly
Else
Dim MyLookupControl As LookupControl3 = ControlCreator.CreateExistingLookupControl(oControlRow, False)
MyLookupControl.Properties.PreventDuplicates = oControlRow.Item("VKT_PREVENT_MULTIPLE_VALUES")
'MyLookupControl.Properties.AllowAddNewValues = oControlRow.Item("VKT_ADD_ITEM")
MyLookupControl.Properties.MultiSelect = oMultiselect
Dim oCommandSQL_UBPF
Try
oCommandSQL_UBPF = oControlRow.Item("SQL_UEBERPRUEFUNG")
oCommandSQL_UBPF = oControlRow.Item("SQL_UEBERPRUEFUNG")
Catch ex As Exception
oCommandSQL_UBPF = ""
End Try
If oCommandSQL_UBPF <> String.Empty Then
Try
oSQL = PreventNulletc(oControlRow.Item("SQL_UEBERPRUEFUNG"), "String")
If clsPatterns.HasOnlySimplePatterns(oSQL) Then
oSQL = clsPatterns.ReplaceInternalValues(oSQL)
oSQL = clsPatterns.ReplaceControlValues(oSQL, PanelValidatorControl, True)
Dim oDT As DataTable = GetCachedDatatable(oSQL, 1)
MyLookupControl.Properties.DataSource = Nothing
If Not IsNothing(oDT) AndAlso oDT.Rows.Count > 0 Then
MyLookupControl.Properties.DataSource = oDT
MyLookupControl.Properties.ValueMember = oDT.Columns.Item(0).ColumnName
MyLookupControl.Properties.DisplayMember = oDT.Columns.Item(0).ColumnName
End If
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in LOOKUP GetValues SQL - Error: {ex.Message}")
End Try
End If
If ObjectEx.NotNull(oControlRow.Item("DEFAULT_VALUE"), "") <> "" Then
MyLookupControl.Properties.SelectedValues = New List(Of String) From {oControlRow.Item("DEFAULT_VALUE")}
End If
oMyControl = MyLookupControl
_CachedLookupControlsByRepository(MyLookupControl.Properties) = MyLookupControl
AddHandler MyLookupControl.Properties.SelectedValuesChanged, AddressOf LookupListChanged
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
MyValidationLogger.Debug($"createControlsLU - Found {oFilteredData.Rows.Count} Controls which are depending on {oMyControl.Name}")
AddHandler MyLookupControl.Properties.SelectedValuesChanged, AddressOf onLookUpselectedValue
End If
oFilteredData = DT_CONTROLS.Clone()
oExpression = $"SQL_ENABLE like '%#CTRL#{oMyControl.Name}%'"
DT_CONTROLS.Select(oExpression).CopyToDataTable(oFilteredData, LoadOption.PreserveChanges)
If oFilteredData.Rows.Count >= 1 Then
MyValidationLogger.Debug($"createControlsLU - Found {oFilteredData.Rows.Count} Controls which' enable state is depending on {oMyControl.Name}")
AddHandler MyLookupControl.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 MyLookupControl.Properties.SelectedValuesChanged, AddressOf onLookUpselectedValue_Control2Set
End If
oFilteredData = DT_CONTROLS.Clone()
AddHandler MyLookupControl.GotFocus, Sub(sender As Control, e As EventArgs)
If DirectCast(MyLookupControl.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then
MyLookupControl.BackColor = Color.LightSteelBlue
End If
End Sub
AddHandler MyLookupControl.LostFocus, Sub(sender As Control, e As EventArgs)
If DirectCast(MyLookupControl.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then
MyLookupControl.BackColor = Color.White
End If
End Sub
End If
Case "CHK"
oControlInfo = "CHK#" & oControlInfo
oMyControl = ControlCreator.CreateExisingCheckbox(oControlRow, False)
Dim mycheckbox As CheckBox = oMyControl
AddHandler mycheckbox.CheckedChanged, AddressOf onCheckBox_CheckedChange
Case "TABLE"
If LOG_PERF Then PerformanceLogger.Info("Create_Controls/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
MyValidationLogger.Debug("We got a DTGRID_COLUMNS definition for [{0}] ", oControlInfo)
Else
MyValidationLogger.Debug("DTGRID_COLUMNS definition for control [{0}] does not contain any rows!", oControlInfo)
Continue For
End If
Dim oGrid = ControlCreator.CreateExistingGridControl(oControlRow, oFilteredDatatable, False, DocCurrency)
oMyControl = oGrid
' NEU: GridView Event registrieren
AddHandler DirectCast(oGrid.MainView, GridView).CellValueChanged, AddressOf GridView_CellValueChanged
AddHandler DirectCast(oGrid.DataSource, DataTable).RowDeleted, AddressOf GridDataSource_RowDeleted
AddHandler DirectCast(oGrid.MainView, GridView).KeyDown, AddressOf GridView_KeyDown
AddHandler DirectCast(oGrid.MainView, GridView).RowDeleting, AddressOf GridView_RowDeleting
Case "LINE"
oMyControl = ControlCreator.CreateExistingLine(oControlRow, False)
Case "BUTTON"
Dim obutton = ControlCreator.CreateExistingButton(oControlRow, False)
AddHandler obutton.Click, AddressOf onCustomButtonClick
oMyControl = obutton
End Select
MyValidationLogger.Debug($"[{oControlInfo}]: End of Select...")
If TypeOf oMyControl IsNot Label Then
listofControls.Add(oMyControl.Name)
If first_control Is Nothing Then
' If Not (oMyControl.GetType = GetType(LookupControl3) Or oMyControl.GetType = GetType(Button)) Then
first_control = oMyControl
'End If
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}"
MyValidationLogger.Warn(omsg)
If DEBUG = False Then MsgBox(omsg, MsgBoxStyle.Critical, "Attention:")
End Try
Next
MyValidationLogger.Debug("Create_Controls finished!")
Catch ex As Exception
MyValidationLogger.Error(ex)
If DEBUG = False Then MsgBox("Error CreateControls: " & ex.Message, MsgBoxStyle.Critical, "Attention:")
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
MyValidationLogger.Error(ex)
End Try
End Sub
Sub Clear_all_Input()
For Each inctrl As Control In Me.PanelValidatorControl.Controls
Dim Type As Type = inctrl.GetType
Select Case True
Case Type = GetType(DevExpress.XtraEditors.TextEdit) Or Type = GetType(MemoEdit)
'inctrl.Text = ""
DirectCast(inctrl, BaseEdit).EditValue = Nothing
Case Type = GetType(Windows.Forms.ComboBox)
Dim cmb As Windows.Forms.ComboBox = inctrl
cmb.SelectedIndex = -1
Case Type = GetType(DataGridView)
Dim dgv As DataGridView = inctrl
If dgv.Rows.Count > 0 Then
dgv.Rows.Clear()
End If
End Select
Next
Focus_FirstControl()
End Sub
Public Sub OnTextBoxFocus(sender As Object, e As EventArgs)
CountAction += 1
Dim oTextbox As BaseEdit = sender
Dim oMeta As ClassControlCreator.ControlMetadata = oTextbox.Tag
Console.WriteLine($"[{CountAction}] OnFocus {oMeta.Name}")
If oMeta.ReadOnly = False Then
oTextbox.BackColor = Color.LightSteelBlue
oTextbox.ForeColor = GraphicsEx.GetContrastedColor(Color.LightSteelBlue)
oTextbox.SelectAll()
End If
End Sub
Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs)
CountAction += 1
Dim oTextbox As BaseEdit = TryCast(sender, BaseEdit)
' ========== 1. NULL-Guards ==========
If oTextbox Is Nothing Then
Exit Sub
End If
Dim oMeta As ClassControlCreator.ControlMetadata = TryCast(oTextbox.Tag, ClassControlCreator.ControlMetadata)
If oMeta Is Nothing Then
Exit Sub
End If
' ========== 2. Form-Closing Guard ==========
If _FormClosing OrElse Me.IsDisposed Then
Exit Sub
End If
' ========== 3. Name-Guard für Cache ==========
If String.IsNullOrEmpty(oMeta.Name) Then
MyValidationLogger.Warn($"⚠️ [{CountAction}] oMeta.Name ist leer!")
Exit Sub
End If
' ========== ENDE Guards ==========
Dim oeditvalue = oTextbox.EditValue
Dim odisplayvalue = oTextbox.Text
Console.WriteLine($"[{CountAction}] LostFocus - {oMeta.Name}")
If oMeta.ReadOnly = False Then
oTextbox.BackColor = oMeta.BackColor
oTextbox.ForeColor = GraphicsEx.GetContrastedColor(oMeta.BackColor)
End If
If Not oMeta.IsDirty Then
oMeta.IsDirty = True
MyValidationLogger.Debug($"Control [{oMeta.Name}] marked as dirty")
End If
' *** Cache aktualisieren (mit Try-Catch) ***
Try
clsPatterns.UpdateControlInCache(oMeta.Name, oTextbox.EditValue)
Catch ex As Exception
MyValidationLogger.Error($"Cache-Update failed: {ex.Message}")
End Try
SetControlValues_FromControl(oTextbox)
Controls2beEnabled(oTextbox.Name)
ControlCreator.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
Private Sub OnTextBoxEditValueChanged(sender As Object, e As EventArgs)
If _FormLoaded = False Or _Indexe_Loaded = False Then
Exit Sub
End If
Dim oTextbox As BaseEdit = TryCast(sender, BaseEdit)
If oTextbox Is Nothing Then
Exit Sub
End If
Dim oMeta As ClassControlCreator.ControlMetadata = TryCast(oTextbox.Tag, ClassControlCreator.ControlMetadata)
If oMeta Is Nothing OrElse oMeta.IsDirty Then
Exit Sub
End If
oMeta.IsDirty = True
MyValidationLogger.Debug($"TextBox [{oMeta.Name}] marked as dirty")
End Sub
Private Sub OnTextBoxKeyDown(sender As Object, e As KeyEventArgs)
Dim oTextBox As BaseEdit = TryCast(sender, BaseEdit)
If oTextBox Is Nothing Then
Exit Sub
End If
If oTextBox.ReadOnly AndAlso e.Control AndAlso e.KeyCode = Keys.X Then
e.Handled = True
e.SuppressKeyPress = True
End If
End Sub
Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs)
If _ControlHandleStarted = True Then
_ControlHandleStarted = False
Exit Sub
End If
Dim oTextBox As BaseEdit = sender
If oTextBox.Text <> String.Empty And _FormClosing = 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 oFilter = $"PROFIL_ID = {CURRENT_ProfilGUID} AND SQL_UEBERPRUEFUNG LIKE '%{oTextBox.Name}%'"
Dim DTCONTROLS_UEBP As DataTable = GetControlMetaBySql(oFilter)
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
MyValidationLogger.Error(ex)
MyValidationLogger.Info("Unexpected Error in Display SQL result for control: " & oRow.Item("NAME") & " - ERROR: " & ex.Message)
End Try
Next
End If
ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message)
End Try
If oTextBox.Name <> last_control.Name Then
Me.SelectNextControl(oTextBox, True, True, True, True)
End If
End If
End If
End Sub
Private Sub onCustomButtonClick(sender As System.Object, e As System.EventArgs)
Try
Cursor = Cursors.WaitCursor
Dim oButton As Windows.Forms.Button = sender
Dim oControlID = DirectCast(oButton.Tag, ClassControlCreator.ControlMetadata).Guid
Dim oSQL = ControlCreator.GET_CONTROL_PROPERTY(DT_CONTROLS, oControlID, "SQL_UEBERPRUEFUNG")
If IsNothing(oSQL) Then
MyValidationLogger.Warn("⚠️ onCustomButtonClick - SQL_UEBERPRUEFUNG IS NOTHING")
Exit Sub
End If
If Check_UpdateIndexe() = False Then
MyValidationLogger.Warn("⚠️ onCustomButtonClick - Check_UpdateIndexe = False >> Exit Click")
Exit Sub
End If
Override_SQLCommand = ControlCreator.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 = DatabaseFallback.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
Dim oIncludeFI As Boolean = False
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
oIncludeFI = oDT_ACTIONS?.Rows(0).Item("IncludeFI")
Catch ex As Exception
End Try
Try
OverrideAll = oDT_ACTIONS?.Rows(0).Item("OverrideAll")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Could not set OverrideAll {ex.Message}")
OverrideAll = False
End Try
If OverrideAll = True Then
MyValidationLogger.Info($"CURRENT_DOC_ID: {CURRENT_DOC_ID} - OverrideAll will be in Action!")
End If
MyValidationLogger.Debug($"ActionType [{oAction}]")
Select Case oAction.ToString.ToUpper
Case "SetButton".ToUpper
btnSave.Text = oCaption & " (F2)"
btnSave.Appearance.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(oIncludeFI)
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 = DatabaseFallback.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 = DatabaseFallback.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(oIncludeFI)
End If
Case "Override incFinal".ToUpper
If Check_UpdateIndexe() = True Then
Finish_WFStep(False)
End If
Case "MsgboxResult".ToUpper
MessageBox.Show(oQuestion, oTitle, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Case Else
MsgBox($"No configured action provided for onCustomButtonClick [{oAction}]", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE)
MyValidationLogger.Warn($"⚠️ No configured action provided for onCustomButtonClick [{oAction}]")
End Select
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
Cursor = Cursors.Default
End Sub
Public Sub onDGVRowValidating(ByVal sender As Object, ByVal e As DataGridViewCellCancelEventArgs)
Dim dgv As DataGridView = sender
Try
Dim oFilter = String.Format("PROFIL_ID = {0} And SQL_UEBERPRUEFUNG Like '%{1}%'", CURRENT_ProfilGUID, dgv.Name)
Dim DTFilteredRows As DataTable = GetControlMetaBySql(oFilter)
If Not IsNothing(DTFilteredRows) And DTFilteredRows.Rows.Count > 0 Then
For Each ROW As DataRow In DTFilteredRows.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 = GetCachedDatatable(sql_Statement, ROW.Item("CONNECTION_ID"))
If resultDT.Rows.Count >= 1 Then
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
MyValidationLogger.Error(ex)
MyValidationLogger.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
MyValidationLogger.Error(ex)
MyValidationLogger.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))
Try
MyValidationLogger.Debug("onLookUpselectedValue")
' *** GLOBALER GUARD: Bei Refresh KOMPLETT blockieren ***
If _FormLoaded = False Or _suppressLookupEvents Then
MyValidationLogger.Debug("onLookUpselectedValue suppressed (global guard active)")
Exit Sub
End If
If SelectedValues Is Nothing OrElse SelectedValues.Count < 1 Then
MyValidationLogger.Debug("Attention: onLookUpselectedValue: SelectedValues.Count <> 1 ")
Exit Sub
End If
' *** WICHTIG: Auch hier globalen Guard setzen ***
_suppressLookupEvents = True
Try
Dim oRepositoryItem As RepositoryItemLookupControl3 = sender
Dim oLookup As LookupControl3 = Nothing
If _CachedLookupControlsByRepository IsNot Nothing Then
_CachedLookupControlsByRepository.TryGetValue(oRepositoryItem, oLookup)
End If
If oLookup Is Nothing Then
oLookup = TryCast(oRepositoryItem.OwnerEdit, LookupControl3)
End If
If oLookup Is Nothing Then
MyValidationLogger.Warn("⚠️ onLookUpselectedValue: LookupControl not found for RepositoryItem")
Exit Sub
End If
LookupControl_DependingControls(oLookup, SelectedValues)
LookupControl_EnablingControls(oLookup, SelectedValues)
LookupControl_DependingColumn(oLookup, SelectedValues)
Finally
_suppressLookupEvents = False
End Try
Catch ex As Exception
MyValidationLogger.Warn("⚠️ Unexpected error in onLookUpselectedValue - " + ex.Message)
MyValidationLogger.Error(ex)
_suppressLookupEvents = False ' Sicherheits-Reset
End Try
End Sub
Private _lookupUpdateDepth As Integer = 0
Private Const MAX_LOOKUP_DEPTH As Integer = 5
Public Sub LookupListChanged(sender As Object, SelectedValues As List(Of String))
If _FormLoaded = False Or PanelValidatorControl.Enabled = False Then
Exit Sub
End If
' *** GLOBALER GUARD: Blockiert ALLE Lookup-Updates während Verarbeitung ***
If _suppressLookupEvents Then
MyValidationLogger.Debug("LookupListChanged suppressed (global guard active)")
Exit Sub
End If
' *** DEPTH-GUARD: Verhindert extrem tiefe Rekursionen ***
If _lookupUpdateDepth >= MAX_LOOKUP_DEPTH Then
MyValidationLogger.Warn($"⚠️ Lookup recursion depth exceeded ({_lookupUpdateDepth}). Aborting.")
Exit Sub
End If
Try
_suppressLookupEvents = True ' <-- Globaler Guard aktivieren
_lookupUpdateDepth += 1
Dim oLookup As RepositoryItemLookupControl3 = sender
Dim oLookupControl As LookupControl3 = Nothing
If _CachedLookupControlsByRepository IsNot Nothing Then
_CachedLookupControlsByRepository.TryGetValue(oLookup, oLookupControl)
End If
If oLookupControl Is Nothing Then
For Each oControl In PanelValidatorControl.Controls
If TypeOf oControl Is LookupControl3 Then
Dim tmp As LookupControl3 = DirectCast(oControl, LookupControl3)
If tmp.Properties Is oLookup Then
oLookupControl = tmp
Exit For
End If
End If
Next
End If
If oLookupControl IsNot Nothing Then
Dim oMeta As ClassControlCreator.ControlMetadata = oLookupControl.Tag
oMeta.IsDirty = True
MyValidationLogger.Debug($"LookupControl [{oMeta.Name}] marked as dirty")
listChangedLookup.Add(oLookupControl.Name)
' *** Cache aktualisieren ***
clsPatterns.UpdateControlInCache(oLookupControl.Name, SelectedValues)
Else
listChangedLookup.Add(oLookup.Name)
clsPatterns.UpdateControlInCache(oLookup.Name, SelectedValues)
End If
ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Dim oFound As Boolean = False
For Each oString As String In listofControls
If oString = oLookup.Name And oFound = False Then
oFound = True
ElseIf oFound = True Then
For Each oControl As Control In PanelValidatorControl.Controls
If oControl.Name = oString Then
oControl.Focus()
Exit For
End If
Next
Exit For
End If
Next
Catch ex As Exception
MyValidationLogger.Error(ex)
Finally
_lookupUpdateDepth -= 1
_suppressLookupEvents = False ' <-- Globaler Guard deaktivieren
End Try
End Sub
Private Sub GridView_CellValueChanged(sender As Object, e As DevExpress.XtraGrid.Views.Base.CellValueChangedEventArgs)
Dim oView As GridView = sender
Dim oGrid As GridControl = oView.GridControl
Dim oMeta As ClassControlCreator.ControlMetadata = oGrid.Tag
oMeta.IsDirty = True
MyValidationLogger.Debug($"GridControl [{oMeta.Name}] marked as dirty (Row {e.RowHandle}, Col {e.Column.FieldName})")
End Sub
Private Sub GridDataSource_RowDeleted(sender As Object, e As DataRowChangeEventArgs)
If Me.IsDisposed OrElse _FormClosing Then Exit Sub
Try
' DataSource → GridControl finden
Dim oDataTable As DataTable = DirectCast(sender, DataTable)
For Each oControl As Control In PanelValidatorControl.Controls
If TypeOf oControl Is GridControl Then
Dim oGrid As GridControl = DirectCast(oControl, GridControl)
If oGrid.DataSource Is oDataTable Then
Dim oMeta As ClassControlCreator.ControlMetadata = TryCast(oGrid.Tag, ClassControlCreator.ControlMetadata)
If oMeta IsNot Nothing Then
oMeta.IsDirty = True
MyValidationLogger.Debug($"GridControl [{oMeta.Name}] marked as dirty (RowDeleted via DataSource)")
End If
Exit For
End If
End If
Next
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ GridDataSource_RowDeleted: {ex.Message}")
End Try
End Sub
' ========== NEU: Cleanup-Methode für gelöschte Zeilen ==========
''' <summary>
''' Entfernt physisch alle Zeilen mit RowState = Deleted aus dem DataTable.
''' WICHTIG: Muss VOR der Validierung aufgerufen werden!
''' </summary>
Private Sub CleanupDeletedRows(pGrid As GridControl)
Try
MyValidationLogger.Debug($"[6] CleanupDeletedRows START für Grid: [{pGrid.Name}]")
Dim oDataSource As DataTable = TryCast(pGrid.DataSource, DataTable)
If oDataSource Is Nothing Then Return
' Alle gelöschten Zeilen sammeln
Dim deletedRows = oDataSource.Rows.Cast(Of DataRow)().
Where(Function(r) r.RowState = DataRowState.Deleted).
ToList()
If deletedRows.Count > 0 Then
MyValidationLogger.Debug($"Grid [{pGrid.Name}]: Entferne {deletedRows.Count} gelöschte Zeilen aus DataSource")
' Zeilen PHYSISCH entfernen (nicht nur markieren!)
For Each row In deletedRows
oDataSource.Rows.Remove(row)
Next
' AcceptChanges → alle RowState-Flags zurücksetzen
oDataSource.AcceptChanges()
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ CleanupDeletedRows: {ex.Message}")
End Try
End Sub
' ========== ENDE NEU ==========
Private Sub GridView_KeyDown(sender As Object, e As KeyEventArgs)
If Me.IsDisposed OrElse _FormClosing Then Exit Sub
If e.KeyCode <> Keys.Delete Then Exit Sub
MyValidationLogger.Debug($"[GridView_KeyDown] DEL-Taste gedrückt!")
Try
Dim oView As GridView = DirectCast(sender, GridView)
' Nur löschen wenn eine gültige Zeile fokussiert ist
If oView.FocusedRowHandle < 0 Then Exit Sub
' Nicht löschen wenn eine Zelle gerade bearbeitet wird
If oView.ActiveEditor IsNot Nothing Then Exit Sub
Dim oGrid As GridControl = oView.GridControl
Dim oMeta As ClassControlCreator.ControlMetadata = TryCast(oGrid.Tag, ClassControlCreator.ControlMetadata)
If oMeta IsNot Nothing AndAlso oMeta.ReadOnly Then
MyValidationLogger.Debug($"[GridView_KeyDown] Grid [{oMeta.Name}] ist ReadOnly → Löschen blockiert")
e.Handled = True
e.SuppressKeyPress = True
Exit Sub
End If
If oMeta IsNot Nothing Then
oMeta.IsDirty = True
MyValidationLogger.Debug($"[GridView_KeyDown] Grid [{oMeta.Name}] marked as dirty")
End If
Dim oDataSource As DataTable = TryCast(oGrid.DataSource, DataTable)
If oDataSource Is Nothing Then Exit Sub
' Mehrsprachige Texte abhängig von USER_LANGUAGE
Dim oQuestion As String
Dim oTitle As String
Select Case USER_LANGUAGE
Case "de-DE"
oQuestion = "Möchten Sie die markierte Zeile wirklich löschen?"
oTitle = "Zeile löschen"
Case "fr-FR"
oQuestion = "Voulez-vous vraiment supprimer la ligne sélectionnée?"
oTitle = "Supprimer la ligne"
Case Else ' en-US, en-GB, etc.
oQuestion = "Do you really want to delete the selected row?"
oTitle = "Delete row"
End Select
Dim oResult = MessageBox.Show(
oQuestion,
oTitle,
MessageBoxButtons.YesNo,
MessageBoxIcon.Question)
If oResult = DialogResult.Yes Then
Dim oDataSource1 As DataTable = TryCast(oGrid.DataSource, DataTable)
If oDataSource1 IsNot Nothing Then
Dim oRowIndex = oView.GetDataSourceRowIndex(oView.FocusedRowHandle)
If oRowIndex >= 0 AndAlso oRowIndex < oDataSource.Rows.Count Then
' ========== KRITISCHE ÄNDERUNG ==========
oDataSource.Rows(oRowIndex).Delete() ' ← Statt RemoveAt()
' ========== ENDE ÄNDERUNG ==========
MyValidationLogger.Debug($"GridControl [{oGrid.Name}] - Row {oRowIndex} marked as DELETED (RowState)")
End If
End If
End If
e.Handled = True
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ GridView_KeyDown (Delete): {ex.Message}")
End Try
End Sub
Private Sub GridView_RowDeleting(sender As Object, e As RowDeletingEventArgs)
If Me.IsDisposed OrElse _FormClosing Then Exit Sub
' Guard: Nur gültige Zeilen verarbeiten
If e.RowHandle < 0 Then Exit Sub
Try
Dim oView As GridView = DirectCast(sender, GridView)
Dim oGrid As GridControl = oView.GridControl
Dim oMeta As ClassControlCreator.ControlMetadata = TryCast(oGrid.Tag, ClassControlCreator.ControlMetadata)
If oMeta IsNot Nothing Then
oMeta.IsDirty = True
MyValidationLogger.Debug($"[GridView_RowDeleting] Grid [{oMeta.Name}] marked as dirty")
End If
Dim oDataSource As DataTable = TryCast(oGrid.DataSource, DataTable)
If oDataSource Is Nothing Then Exit Sub
Dim oRowIndex = oView.GetDataSourceRowIndex(e.RowHandle)
If oRowIndex >= 0 AndAlso oRowIndex < oDataSource.Rows.Count Then
Dim oRow As DataRow = oDataSource.Rows(oRowIndex)
' Guard: Nur löschen wenn noch nicht als Deleted markiert
If oRow.RowState = DataRowState.Deleted Then
MyValidationLogger.Debug($"[GridView_RowDeleting] Row {oRowIndex} bereits als DELETED markiert - übersprungen")
e.Cancel = True
Return
End If
oRow.Delete()
MyValidationLogger.Debug($"[GridView_RowDeleting] Grid [{oGrid.Name}] - Row {oRowIndex} marked as DELETED (RowState)")
End If
e.Cancel = True
oView.RefreshData()
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ GridView_RowDeleting: {ex.Message}")
End Try
End Sub
Public Sub onCheckBox_CheckedChange(sender As Object, e As EventArgs)
MyValidationLogger.Debug("onCheckBox_CheckedChange")
If _FormLoaded = False Then
Exit Sub
End If
Dim oCheckbox As CheckBox = sender
' Dirty-Flag setzen
Dim oMeta As ClassControlCreator.ControlMetadata = oCheckbox.Tag
oMeta.IsDirty = True
MyValidationLogger.Debug($"CheckBox [{oMeta.Name}] marked as dirty")
' *** NEU: Cache aktualisieren ***
clsPatterns.UpdateControlInCache(oCheckbox.Name, oCheckbox.Checked)
Try
CheckBox_DependingControls(oCheckbox)
Checkbox_EnablingControls(oCheckbox)
CheckBox_DependingColumn(oCheckbox)
SetControlValues_FromControl(oCheckbox)
ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Public Sub onLookUpselectedValue_Control2Set(sender As Object, SelectedValues As List(Of String))
If _FormLoaded = False Or PanelValidatorControl.Enabled = False Then
Exit Sub
End If
MyValidationLogger.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)
' *** KRITISCH: Während FillIndexValues BLOCKIEREN! ***
If _suppressLookupEvents Then
MyValidationLogger.Debug("SetControlValues_FromControl -> BLOCKED by _suppressLookupEvents (FillIndexValues läuft)")
Exit Sub
End If
' Prevent re-entry
If _SetControlValue_In_Action Then
MyValidationLogger.Debug("SetControlValues_FromControl -> SetControlValue in action. Exiting.")
Exit Sub
End If
Dim oControlName = pControl.Name
Dim oControlMeta = DirectCast(pControl.Tag, ClassControlCreator.ControlMetadata)
Dim oControlID = oControlMeta.Guid
If _SetControlValue_In_Action Then
MyValidationLogger.Debug("SetControlValue in action. Exiting.")
Exit Sub
End If
' ========== OPTIMIERUNG: Dictionary-Lookup statt Select() ==========
Dim oRow As DataRow = Nothing
If _CachedControlsBySetControlData Is Nothing OrElse Not _CachedControlsBySetControlData.TryGetValue(oControlID, oRow) Then
MyValidationLogger.Debug("SET_CONTROL_DATA is empty for control [{0}]. Exiting.", oControlName)
Exit Sub
End If
' ========== ENDE OPTIMIERUNG ==========
Dim oControlname2Set = oRow.Item("NAME")
MyValidationLogger.Debug($"Working on SetControlValue for {oControlname2Set} ...")
Dim oConnectionId = oRow.ItemEx("CONNECTION_ID", 0)
Dim oControlDataSql = oRow.ItemEx("SET_CONTROL_DATA", String.Empty)
If oConnectionId = -1 Or oControlDataSql = String.Empty Then
MyValidationLogger.Debug("Error: Check CONN ID and SQL on NULL VALUES!")
Exit Sub
End If
oControlDataSql = clsPatterns.ReplaceAllValues(oControlDataSql, PanelValidatorControl, True)
Dim oControlDataResult As DataTable = GetCachedDatatable(oControlDataSql, oConnectionId)
If oControlDataResult Is Nothing Then
Exit Sub
End If
Dim oButtonFinishSet As Boolean = False
For Each oResultRow As DataRow In oControlDataResult.Rows
Try
_SetControlValue_In_Action = True
Dim oControl2Set = oResultRow.ItemEx("Control2Set", String.Empty)
Dim oControlCaption = oResultRow.ItemEx("Caption", String.Empty)
Dim oControlBackColor = Color.FromName(oResultRow.ItemEx("BackgroundColor", "Transparent"))
Dim oControlFontColor = Color.FromName(oResultRow.ItemEx("FontColor", "Black"))
Dim oControlTextOption = oResultRow.ItemEx("TextOption", "Replace")
If oControl2Set.ToString.ToUpper = "BTN_FINISH".ToUpper Then
btnSave.Text = oControlCaption & " (F2)"
btnSave.Appearance.BackColor = oControlBackColor
btnSave.Appearance.ForeColor = oControlFontColor
oButtonFinishSet = True
_SetControlValue_In_Action = False
Continue For
End If
' ========== OPTIMIERUNG: FirstOrDefault statt Loop ==========
Dim oControlObject2Set = PanelValidatorControl.Controls.Cast(Of Control).
Where(Function(c)
Dim meta = DirectCast(c.Tag, ClassControlCreator.ControlMetadata)
Return oControl2Set = meta.Guid OrElse oControl2Set = meta.Name
End Function).FirstOrDefault()
If oControlObject2Set Is Nothing Then
MyValidationLogger.Debug($"Could not find the Control2Set with ID {oControl2Set} on panel!!!")
Continue For
End If
' ========== ENDE OPTIMIERUNG ==========
Dim oControl As Control = oControlObject2Set
' *** WICHTIG: Verwende LOKALE Variable statt erneuter Deklaration ***
Dim oMeta As ClassControlCreator.ControlMetadata = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata)
MyValidationLogger.Debug(String.Format("Got the Control2Set: {0}..Setting the values..", {oControl.Name}))
Select Case True
Case oControl.GetType() = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType() = GetType(MemoEdit)
Try
If oControlTextOption = "Replace" Then
oControl.Text = oControlCaption
Else
oControl.Text &= oControlCaption
End If
oControl.BackColor = oControlBackColor
oControl.ForeColor = oControlFontColor
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, DirectCast(oControl, BaseEdit).EditValue)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while Control2Set (TextEdit): {ex.Message}")
End Try
Case oControl.GetType() = GetType(LookupControl3)
Try
Dim oDependingLookup As LookupControl3 = oControl
If oDependingLookup.Properties.SelectedValues Is Nothing Then
oDependingLookup.Properties.SelectedValues = New List(Of String)()
End If
If oDependingLookup.Properties.MultiSelect = True Then
If oControlTextOption = "Replace" Then
oDependingLookup.Properties.SelectedValues = New List(Of String) From {oControlCaption}
Else
oDependingLookup.Properties.SelectedValues.Add(oControlCaption)
End If
Else
oDependingLookup.Properties.SelectedValues = New List(Of String) From {oControlCaption}
End If
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, oDependingLookup.Properties.SelectedValues)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while Control2Set (LookupControl3): {ex.Message}")
End Try
Case oControl.GetType() = GetType(Windows.Forms.ComboBox)
Try
Dim oDependingCombobox As Windows.Forms.ComboBox = oControl
Dim oIndex As Integer = oDependingCombobox.FindStringExact(oControlCaption)
If oIndex <> -1 Then
If oDependingCombobox.SelectedIndex <> oIndex Then
oDependingCombobox.SelectedIndex = oIndex
End If
Try
oDependingCombobox.BackColor = oControlBackColor
Catch ex As Exception
End Try
Try
oDependingCombobox.ForeColor = oControlFontColor
Catch ex As Exception
End Try
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, oDependingCombobox.Text)
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while Control2Set (Combobox): {ex.Message}")
End Try
Case oControl.GetType() = GetType(DevExpress.XtraEditors.DateEdit)
Try
Dim oDateEdit As DevExpress.XtraEditors.DateEdit = DirectCast(oControl, DevExpress.XtraEditors.DateEdit)
Dim parsed As DateTime
If String.IsNullOrWhiteSpace(oControlCaption) Then
oDateEdit.EditValue = Nothing
ElseIf DateTime.TryParse(oControlCaption, parsed) Then
oDateEdit.EditValue = parsed
ElseIf DateTime.TryParse(oControlCaption, CultureInfo.CurrentCulture, DateTimeStyles.None, parsed) Then
oDateEdit.EditValue = parsed
ElseIf DateTime.TryParse(oControlCaption, CultureInfo.InvariantCulture, DateTimeStyles.None, parsed) Then
oDateEdit.EditValue = parsed
Else
oDateEdit.EditValue = Nothing
End If
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, oDateEdit.EditValue)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error While Control2Set (DateEdit): {ex.Message}")
End Try
Case oControl.GetType() = GetType(System.Windows.Forms.DateTimePicker)
Try
Dim dtp As System.Windows.Forms.DateTimePicker = DirectCast(oControl, System.Windows.Forms.DateTimePicker)
Dim parsed As DateTime
Dim hasValue = Not String.IsNullOrWhiteSpace(oControlCaption)
If hasValue AndAlso (DateTime.TryParse(oControlCaption, parsed) _
OrElse DateTime.TryParse(oControlCaption, CultureInfo.CurrentCulture, DateTimeStyles.None, parsed) _
OrElse DateTime.TryParse(oControlCaption, CultureInfo.InvariantCulture, DateTimeStyles.None, parsed)) Then
dtp.Value = parsed
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, dtp.Value)
Else
dtp.Value = DateTimePicker.MinimumDateTime
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error While Control2Set (DateTimePicker): {ex.Message}")
End Try
Case oControl.GetType() = GetType(Windows.Forms.CheckBox)
Try
Dim oBitValue As Boolean = CBool(oControlCaption)
Dim oDependingCheckbox As Windows.Forms.CheckBox = oControl
oDependingCheckbox.Checked = oBitValue
Try
oDependingCheckbox.BackColor = oControlBackColor
Catch ex As Exception
End Try
Try
oDependingCheckbox.ForeColor = oControlFontColor
Catch ex As Exception
End Try
oMeta.IsDirty = True
clsPatterns.UpdateControlInCache(oMeta.Name, oDependingCheckbox.Checked)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while Control2Set (Checkbox) {ex.Message}")
End Try
Case Else
MyValidationLogger.Warn("⚠️ SetControlData used on unsupported control")
End Select
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.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))
If SelectedValues Is Nothing OrElse SelectedValues.Count = 0 Then
MyValidationLogger.Debug("LookupControl_DependingControls: No values selected")
Exit Sub
End If
Dim oLOOKUPValue = SelectedValues.Item(0)
Dim oLOOKUPName = LookupControl.Name
MyValidationLogger.Debug($"oLOOKUPValue Is [{oLOOKUPValue}]!")
Dim oControlID = DirectCast(LookupControl.Tag, ClassControlCreator.ControlMetadata).Guid
' ========== OPTIMIERUNG 1: Dictionary für Controls erstellen (einmalig) ==========
If _CachedControlsByGuid Is Nothing Then
_CachedControlsByGuid = New Dictionary(Of Integer, Control)()
For Each ctrl As Control In PanelValidatorControl.Controls
Try
Dim meta = DirectCast(ctrl.Tag, ClassControlCreator.ControlMetadata)
_CachedControlsByGuid(meta.Guid) = ctrl
Catch
Continue For
End Try
Next
End If
' ========== ENDE OPTIMIERUNG 1 ==========
' ========== OPTIMIERUNG 2: Gefilterte Rows mit LINQ (statt .Select()) ==========
Dim dependingRows = DT_CONTROLS.AsEnumerable().
Where(Function(r) Not IsDBNull(r("SQL_UEBERPRUEFUNG")) AndAlso
r("SQL_UEBERPRUEFUNG").ToString().Contains($"#CTRL#{oLOOKUPName}")).
ToList()
If dependingRows.Count = 0 Then
MyValidationLogger.Debug($"Sorry NO depending controls for [{oLOOKUPName}]!")
Exit Sub
End If
MyValidationLogger.Debug($"We got {dependingRows.Count} depending controls!!")
' ========== ENDE OPTIMIERUNG 2 ==========
For Each oRowDependingControl As DataRow In dependingRows
Dim oDEPENDING_GUID = CInt(oRowDependingControl.Item("GUID"))
Dim oDEPENDING_CtrlName = oRowDependingControl.Item("NAME").ToString()
MyValidationLogger.Debug($"Control {oDEPENDING_CtrlName} is depending on lookUp {oLOOKUPName}..")
If _DependingControl_In_Action = True Then
MyValidationLogger.Info($"..but _dependingControl_in_action = True ==> Exit Sub!")
Exit Sub
End If
If IsDBNull(oRowDependingControl.Item("CONNECTION_ID")) OrElse IsDBNull(oRowDependingControl.Item("SQL_UEBERPRUEFUNG")) Then
MyValidationLogger.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!")
Continue For
End If
Dim oSqlCommand = oRowDependingControl.Item("SQL_UEBERPRUEFUNG").ToString()
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, True)
_DependingControl_In_Action = True
Dim oDTDEPENDING_RESULT As DataTable = GetCachedDatatable(oSqlCommand, oRowDependingControl.Item("CONNECTION_ID"))
If oDTDEPENDING_RESULT Is Nothing Then
MyValidationLogger.Warn($"⚠️ Datatable for Depending Controls was nothing! Check the SQL [{oSqlCommand}]")
_DependingControl_In_Action = False
Continue For
End If
' ========== OPTIMIERUNG 3: Dictionary-Lookup statt Loop ==========
Dim oControl As Control = Nothing
If Not _CachedControlsByGuid.TryGetValue(oDEPENDING_GUID, oControl) Then
MyValidationLogger.Debug($"Could not find the depending Control with ID {oDEPENDING_GUID} on panel!!!")
_DependingControl_In_Action = False
Continue For
End If
' ========== ENDE OPTIMIERUNG 3 ==========
MyValidationLogger.Debug($"Got the depending control ID:{oDEPENDING_GUID}..Setting the values..")
' *** WICHTIG: Während Suppress-Modus Updates durchführen ***
Dim wasSuppressed = _suppressLookupEvents
_suppressLookupEvents = True
Try
Select Case True
Case oControl.GetType() = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType() = GetType(MemoEdit)
Try
Dim oValue As Object = oDTDEPENDING_RESULT.Rows(0).Item(0)
MyValidationLogger.Debug(String.Format("Setting EditValue with value [{0}]", oValue))
oValue = ObjectEx.NotNull(Of Object)(oValue, Nothing)
DirectCast(oControl, DevExpress.XtraEditors.TextEdit).EditValue = oValue
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Checking oTEXT: {ex.Message}")
End Try
Try
Dim oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor"))
oControl.BackColor = oColor
Catch
oControl.BackColor = Color.White
End Try
Try
Dim btntext = oDTDEPENDING_RESULT.Rows(0).Item("btnFinishCaption")
btnSave.Text = btntext & " (F2)"
Catch
End Try
Try
Dim oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("btnFinishColor"))
btnSave.BackColor = oColor
Catch
btnSave.BackColor = Color.Transparent
End Try
Case oControl.GetType() = GetType(LookupControl3)
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 oControl.GetType() = GetType(GridControl)
' GridControl-Handling (unverändert)
Case oControl.GetType() = GetType(CheckBox)
Try
Dim oCheckState = CBool(oDTDEPENDING_RESULT.Rows(0).Item(0))
Dim oDependingChk As CheckBox = oControl
oDependingChk.CheckState = If(oCheckState, CheckState.Checked, CheckState.Unchecked)
Try
Dim oColor = System.Drawing.Color.FromName(oDTDEPENDING_RESULT.Rows(0).Item("BackgroundColor"))
oControl.BackColor = oColor
Catch
End Try
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Checking oCheckBoxDependingControlLOOKUP: {ex.Message}")
End Try
End Select
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while setting depending control-value for [{oDEPENDING_CtrlName}]: {ex.Message}")
Finally
_suppressLookupEvents = wasSuppressed
_DependingControl_In_Action = False
End Try
Next
End Sub
Private Sub CheckBox_DependingControls(pCheckbox As CheckBox)
Dim oCheckboxname = pCheckbox.Name
MyValidationLogger.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
MyValidationLogger.Debug($"We got {oFilteredDatatable.Rows.Count} depending controls!!")
Else
MyValidationLogger.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")
MyValidationLogger.Debug($"Control {oDEPENDING_CtrlName} is depending on lookUp {oCheckboxname}..")
If _DependingControl_In_Action = True Then
MyValidationLogger.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
MyValidationLogger.Debug($"_DependingControl_In_Action: Control {oDEPENDING_CtrlName} ...")
'Dim oDTDEPENDING_RESULT As DataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
' .ConnectionId = oRowDependingControl.Item("CONNECTION_ID")
'})
Dim oDTDEPENDING_RESULT As DataTable = GetCachedDatatable(oSqlCommand, 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
MyValidationLogger.Debug($"Got the depending control ID:{oDEPENDING_GUID}..Setting the values..")
Select Case True
Case oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType = GetType(MemoEdit)
Try
Dim oValue As Object = oDTDEPENDING_RESULT.Rows(0).Item(0)
oValue = ObjectEx.NotNull(Of Object)(oValue, Nothing)
Try
'oControl.Text = oValue
DirectCast(oControl, DevExpress.XtraEditors.TextEdit).EditValue = oValue
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Checking oTEXT: {ex.Message}")
End Try
Catch ex As Exception
MyValidationLogger.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 oControl.GetType = GetType(LookupControl3)
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 oControl.GetType = GetType(GridControl)
'ClassControlCreator.GridTables
Case oControl.GetType = GetType(CheckBox)
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
MyValidationLogger.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
MyValidationLogger.Debug($"Could not find the depending Control with ID {oDEPENDING_GUID} on panel!!!")
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while setting depending control-value for [{oDEPENDING_CtrlName}]: " & ex.Message)
_DependingControl_In_Action = False
End Try
Else
MyValidationLogger.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)
MyValidationLogger.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 = DatabaseFallback.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
' .ConnectionId = oCONNID
'})
Dim oDTDEPENDING_RESULT As DataTable = GetCachedDatatable(oSqlCommand, oCONNID)
If Not IsNothing(oDTDEPENDING_RESULT) Then
MyValidationLogger.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
ControlCreator.GridTables_CacheDatatableForColumn(oControlId, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
_DependingColumn_In_Action = False
Exit For
End If
Next
End If
Catch ex As Exception
MyValidationLogger.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 = DatabaseFallback.GetDatatable(New GetDatatableOptions(oSqlCommand, DatabaseType.ECM) With {
.ConnectionId = oCONNID
})
If Not IsNothing(oDTDEPENDING_RESULT) Then
MyValidationLogger.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
ControlCreator.GridTables_CacheDatatableForColumn(oControlId, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
_DependingColumn_In_Action = False
Exit For
End If
Next
End If
Catch ex As Exception
MyValidationLogger.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 Windows.Forms.ComboBox = sender
If oCombobox.SelectedIndex <> -1 And _Indexe_Loaded = True Then
Dim oMeta As ClassControlCreator.ControlMetadata = oCombobox.Tag
oMeta.IsDirty = True
' *** NEU: Cache aktualisieren ***
clsPatterns.UpdateControlInCache(oCombobox.Name, oCombobox.Text)
MyValidationLogger.Debug($"ComboBox [{oMeta.Name}] marked as dirty")
If oCombobox.Name = last_control.Name Then
'Abschluss()
Else
Try
Dim oFilter = String.Format("PROFIL_ID = {0} And SQL_UEBERPRUEFUNG Like '%{1}%'", CURRENT_ProfilGUID, oCombobox.Name)
Dim DT As DataTable = GetControlMetaBySql(oFilter)
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
MyValidationLogger.Error(ex)
MyValidationLogger.Info("Unexpected Error in Display SQL result (Combobox) for control: (" & _Step.ToString & ")" & ROW.Item(0).ToString & " - ERROR: " & ex.Message)
End Try
Next
End If
ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Controls2beEnabled(oCombobox.Name)
SetControlValues_FromControl(oCombobox)
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.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
If _FormLoaded = False Then
Exit Sub
End If
' Controls mit SQL_ENABLE-Definition ermitteln:
' 1. Controls, deren SQL_ENABLE den auslösenden Control-Namen referenziert (#CTRL#Name)
' 2. Controls, deren SQL_ENABLE keinen #CTRL#-Platzhalter hat (statische SQL, z.B. für Buttons)
Dim enablingRows = DT_CONTROLS.AsEnumerable().
Where(Function(r)
Dim sql = r.ItemEx("SQL_ENABLE", String.Empty).ToString()
If String.IsNullOrEmpty(sql) Then Return False
Return sql.Contains($"#CTRL#{pControlName}") OrElse Not sql.Contains("#CTRL#")
End Function).
ToList()
If enablingRows.Count = 0 Then
MyValidationLogger.Debug($"Sorry NO controls with enabling definition!!")
Return
End If
MyValidationLogger.Debug($"We got {enablingRows.Count} controls which got enable definitions!!")
' ========== OPTIMIERUNG: Dictionary-Lookup statt Panel-Loop ==========
If _CachedControlsByGuid Is Nothing Then
_CachedControlsByGuid = New Dictionary(Of Integer, Control)()
For Each ctrl As Control In PanelValidatorControl.Controls
Try
Dim meta = DirectCast(ctrl.Tag, ClassControlCreator.ControlMetadata)
_CachedControlsByGuid(meta.Guid) = ctrl
Catch
Continue For
End Try
Next
End If
' ========== ENDE OPTIMIERUNG ==========
For Each oRowEnablingControl As DataRow In enablingRows
If _DependingControl_In_Action Then
MyValidationLogger.Debug($"_dependingControl_in_action = True ==> Skip row!")
Continue For ' NEU: Continue statt Exit Sub restliche Rows weiterverarbeiten
End If
Dim oENABLE_GUID As Integer = CInt(oRowEnablingControl.Item("GUID"))
Dim oENABLE_CtrlName = oRowEnablingControl.Item("NAME")
MyValidationLogger.Debug($"Control {oENABLE_CtrlName} is depending on Control: {pControlName}..")
Dim oConnectionId As Integer = oRowEnablingControl.ItemEx("CONNECTION_ID", 0)
Dim oSqlCommand As String = oRowEnablingControl.ItemEx("SQL_ENABLE", String.Empty)
If oConnectionId = 0 OrElse String.IsNullOrEmpty(oSqlCommand) Then
MyValidationLogger.Debug($"Error: Check CoNN ID and SQL on NULL VALUES!")
Continue For
End If
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, True)
MyValidationLogger.Debug($"_DependingControl_In_Action: oENABLE_CtrlName {oENABLE_CtrlName} ...")
_DependingControl_In_Action = True
Try
Dim oENABLERESULT As Boolean = False
Dim oResult = GetCachedScalar(oSqlCommand, oConnectionId)
If oResult IsNot Nothing AndAlso Not IsDBNull(oResult) Then
oENABLERESULT = CBool(oResult)
End If
' ========== OPTIMIERUNG: Dictionary-Lookup statt Panel-Loop ==========
Dim oControl As Control = Nothing
If _CachedControlsByGuid.TryGetValue(oENABLE_GUID, oControl) Then
MyValidationLogger.Debug($"Got the depending control ID:{oENABLE_GUID}..Setting enabled/Disabled...")
oControl.Enabled = oENABLERESULT
Else
MyValidationLogger.Debug($"Could not find the enabling Control with ID {oENABLE_GUID} on panel!!!")
End If
' ========== ENDE OPTIMIERUNG ==========
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error while setting enabling control-value for [{oENABLE_CtrlName}]: " & ex.Message)
Finally
_DependingControl_In_Action = False
End Try
Next
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Private Sub Controls2B_EnDisabled()
If LOG_PERF Then PerformanceLogger.Info("Controls2B_EnDisabled")
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
MyValidationLogger.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
MyValidationLogger.Debug($"Found the Control on panel which needs to be checked [{oENABLE_GUID}]...")
Dim oConnectionId As Integer = oRowEnablingControl.ItemEx("CONNECTION_ID", 0)
Dim oSqlCommand = oRowEnablingControl.ItemEx("SQL_ENABLE_ON_LOAD", String.Empty)
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, PanelValidatorControl, True)
Dim oResult = GetCachedScalar(oSqlCommand, oConnectionId)
Try
MyValidationLogger.Debug($"Result of Enable SQL [{oResult}]...")
oControl.Enabled = CBool(oResult)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Could not convert value [oResult] to Boolean!")
MyValidationLogger.Warn($"⚠️ Error en/disabling control onLoad: [{ex.Message}]")
End Try
End If
Next
Next
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Private Sub Depending_Control_Set_Result(displayboxname As String, sqlCommand As String, sqlConnection As String)
Try
MyValidationLogger.Debug("Setting Values for Control [{0}]", displayboxname)
'Dim oResultTable As DataTable = ClassDatabase.Return_Datatable_ConId(sqlCommand, sqlConnection)
Dim oResultTable As DataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(sqlCommand, DatabaseType.ECM) With {
.ConnectionId = sqlConnection
})
If Not IsNothing(oResultTable) Then
MyValidationLogger.Debug("Result Table has [{0}] rows", oResultTable.Rows.Count)
MyValidationLogger.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
MyValidationLogger.Debug("Control is Multivalue")
If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Then
MyValidationLogger.Debug("Filling Combobox with Results")
Dim oCombobox As Windows.Forms.ComboBox = PanelValidatorControl.Controls(displayboxname)
If IsNothing(oCombobox) Then
Exit Sub
End If
MyValidationLogger.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
MyValidationLogger.Debug("Filling Lookup Control with Results")
Dim oLookup As LookupControl3 = PanelValidatorControl.Controls(displayboxname)
If IsNothing(oLookup) Then
Exit Sub
End If
MyValidationLogger.Debug("Control exists, setting results.")
oLookup.Properties.DataSource = Nothing
oLookup.Properties.DataSource = oResultTable
Else
'not implemented
MyValidationLogger.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"
MyValidationLogger.Info(">> Datatable-SQL: " & sqlCommand)
End If
End If
Else
MyValidationLogger.Warn("⚠️ Result Table is nothing!")
End If
Catch ex As Exception
MyValidationLogger.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
If dtp.Name = last_control.Name Then
' Abschluss()
Else
SendKeys.Send("{TAB}")
_ControlHandleStarted = True
End If
End If
End Sub
Private Function GetControlMetaBySql(filter As String, Optional SortBy As String = "") As DataTable
Dim dt As DataTable = Nothing
Dim cacheKey = $"META|{filter}|{SortBy}"
If _CachedSqlDataCache.TryGetValue(cacheKey, dt) Then
Return dt
End If
If BASEDATA_TBPM_PROFILE_CONTROLS IsNot Nothing Then
Try
Dim rows As DataRow()
If String.IsNullOrWhiteSpace(filter) Then
rows = BASEDATA_TBPM_PROFILE_CONTROLS.Select()
Else
rows = BASEDATA_TBPM_PROFILE_CONTROLS.Select(filter, SortBy)
End If
dt = BASEDATA_TBPM_PROFILE_CONTROLS.Clone()
If rows.Length > 0 Then
dt = rows.CopyToDataTable()
End If
_CachedSqlDataCache(cacheKey) = dt
Return dt
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ GetControlMetaBySql cache filter failed, fallback to DB: {ex.Message}")
End Try
End If
' Fallback zu SQL
Dim query As String
If String.IsNullOrWhiteSpace(filter) Then
query = "SELECT * FROM TBPM_PROFILE_CONTROLS"
Else
query = $"SELECT * FROM TBPM_PROFILE_CONTROLS WHERE {filter}"
End If
If Not String.IsNullOrWhiteSpace(SortBy) Then
query &= $" ORDER BY {SortBy}"
End If
dt = DatabaseFallback.GetDatatable("TBPM_PROFILE_CONTROLS", New GetDatatableOptions(query, DatabaseType.ECM))
If dt IsNot Nothing Then
_CachedSqlDataCache(cacheKey) = dt
End If
Return dt
End Function
Private Function GetCachedDatatable(sql As String, connectionId As Integer) As DataTable
Dim dt As DataTable = Nothing
Dim cacheKey = $"{connectionId}|{sql}"
If Not _CachedSqlDataCache.TryGetValue(cacheKey, dt) Then
dt = DatabaseFallback.GetDatatable(New GetDatatableOptions(sql, DatabaseType.ECM) With {
.ConnectionId = connectionId
})
If dt IsNot Nothing Then
_CachedSqlDataCache(cacheKey) = dt
End If
End If
Return dt
End Function
Private Function GetCachedScalar(sql As String, connectionId As Integer) As Object
Dim result As Object = Nothing
Dim cacheKey = $"SCALAR|{connectionId}|{sql}"
If Not _CachedSqlScalarCache.TryGetValue(cacheKey, result) Then
result = DatabaseFallback.GetScalarValueWithConnection(sql, connectionId)
_CachedSqlScalarCache(cacheKey) = result
End If
Return result
End Function
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
MyValidationLogger.Debug("SQL Check is not configured!")
Return True
End If
If check.ToString.Length > 0 And Not {"@@DISPLAY_ONLY", "DD PM-ONLY FOR DISPLAY"}.Contains(dr.Item("INDEX_NAME")) Then
Dim cs As String = DatabaseFallback.GetConnectionString(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
MyValidationLogger.Error(ex)
MyValidationLogger.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
MyValidationLogger.Debug("Get_Next_GUID...")
Dim oNewGUID As Integer
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 oDT As DataTable = DatabaseFallback.GetDatatableECM(oSQL)
CURRENT_DOC_ID = 0
CURRENT_DOC_GUID = 0
If oDT.Rows.Count > 0 Then
Try
oNewGUID = oDT.Rows(0).Item(0)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ >> Attention: in GetNextGUID - Could not get the next GUID - SQL [{oSQL}]")
MyValidationLogger.Warn($"⚠️ ERRORMESSAGE [{ex.Message}]")
End Try
Try
CURRENT_DOC_ID = oDT.Rows(0).Item(1)
MyValidationLogger.Debug($"Get_Next_GUID: CURRENT_DOC_ID [{CURRENT_DOC_ID}]...")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ >> Attention: in GetNextGUID - Could not get the next DocID - SQL [{oSQL}]")
MyValidationLogger.Warn($"⚠️ ERRORMESSAGE [{ex.Message}]")
End Try
Try
Amount_Docs2Validate = CInt(oDT.Rows(0).Item(2))
MyValidationLogger.Debug($"Get_Next_GUID: Amount_Docs2Validate [{Amount_Docs2Validate}]...")
Catch ex As Exception
Amount_Docs2Validate = 0
MyValidationLogger.Warn("⚠️ Amount_Docs2Validate Error: " & ex.Message)
End Try
Else
MyValidationLogger.Info($">> Attention: GetNextGUID - Could not get the next GUID - SQL [{oSQL}]")
If User.IsAdmin And LOGCONFIG.Debug = True Then
My.Computer.Clipboard.SetText(oSQL)
MsgBox($">> Attention: in GetNextGUID - Could not get a GUID(1)" & vbCrLf &
$"SQL kopiert: {oSQL.Substring(0, Math.Min(100, oSQL.Length))}...",
MsgBoxStyle.Exclamation)
End If
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
MyValidationLogger.Debug("newGUID: " & oNewGUID.ToString)
ElseIf oNewGUID <> 0 Then
MyValidationLogger.Info(" >> Attention: in GetNextGUID - Could not get a GUID(2)")
oNewGUID = 0
End If
Return oNewGUID
Catch ex As Exception
MyValidationLogger.Error(ex)
oErrMsgMissingInput = "Unexpected error in Get_Next_GUID: " & ex.Message
MyValidationLogger.Info(">> Unexpected error in Get_Next_GUID:: " & ex.Message, True)
Return 0
End Try
End Function
Private Function CreateWMObject() As String
MyValidationLogger.Debug($"in GetWMDocFileString...'")
Dim oWMOwnPath As String
If WM_AHWF_docPath <> String.Empty Then
oWMOwnPath = WM_AHWF_docPath
WMDocPathWindows = oWMOwnPath
Else
oWMOwnPath = WMDocPathWindows.Replace(WMSUFFIX, "")
End If
MyValidationLogger.Debug($"oWMOwnPath: {oWMOwnPath}")
Try
Dim oNormalizedPath = WINDREAM_MOD.GetNormalizedPath(oWMOwnPath, 1)
CURRENT_WMFILE = WINDREAM_MOD.Session.GetWMObjectByPath(WMEntity.WMEntityDocument, oNormalizedPath)
MyValidationLogger.Debug("CURRENT_WMFILE: [{0}]", CURRENT_WMFILE)
Return True
Catch ex As Exception
Dim _err1 As Boolean = False
MyValidationLogger.Error(ex)
MyValidationLogger.Info("Unexpected error creating WMObject(1) in GetWMDocFileString: " & ex.Message)
MyValidationLogger.Info("Error Number: " & Err.Number.ToString)
errormessage = $"Could not create a WMObject(1) for [{oWMOwnPath}]!"
frmError.ShowDialog()
Return False
End Try
End Function
Private Function GetDocPathWindows(_CheckStandard As Integer)
Try
If ActiveWorkflowType = ConstAHWorkflow_BlindFile Then
WMDocPathWindows = WM_AHWF_docPath
CURRENT_DOC_PATH = WM_AHWF_docPath
Return True
End If
Dim oResult As String
WMDocPathWindows = String.Empty
If OPERATION_MODE_FS <> ClassConstants.OpModeFS_ZF Then
Dim oSQL = $"SELECT dbo.FNPM_GET_FILEPATH({CURRENT_DOC_GUID},{_CheckStandard}) AS PATH0, dbo.FNPM_GET_FILEPATH({CURRENT_DOC_GUID},1) AS PATH1"
Dim oDT As DataTable = DatabaseFallback.GetDatatableECM(oSQL)
If oDT Is Nothing OrElse oDT.Rows.Count = 0 Then
MyValidationLogger.Warn("⚠️ GetDocPathWindows: No result for file paths!")
Return False
End If
Dim path0 = ObjectEx.NotNull(oDT.Rows(0).Item("PATH0"), String.Empty).ToString
Dim path1 = ObjectEx.NotNull(oDT.Rows(0).Item("PATH1"), String.Empty).ToString
MyValidationLogger.Debug($"First Checking file [{path0}] exists?...")
If path0 <> String.Empty AndAlso File.Exists(path0) Then
oResult = path0
Else
MyValidationLogger.Info($"Getting filepath with standard 1 ...")
MyValidationLogger.Debug($"Second Checking file [{path1}] exists?...")
If path1 <> String.Empty AndAlso File.Exists(path1) Then
oResult = path1
Else
MyValidationLogger.Info($"Second FileExists also returned false [{path1}]!")
DocPathWindows = path1
MyValidationLogger.Warn($"⚠️ GetDocPathWindows: File [{path1}] not existing!")
Return False
End If
End If
DocPathWindows = oResult
Else
oResult = ClassConstants.OpModeFS_ZF
MyValidationLogger.Debug($"GetDocPathWindows: Filestore is {ClassConstants.OpModeFS_ZF}")
End If
WMDocPathWindows = oResult
CURRENT_DOC_PATH = WMDocPathWindows
MyValidationLogger.Info($"GetWMDocPathWindows CURRENT_DOC_PATH: {CURRENT_DOC_PATH}")
Return True
Catch ex As Exception
WMDocPathWindows = ""
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)
MyValidationLogger.Debug($"Load_IDB_DOC_DATA SQL: {oSQl}")
IDB_DT_DOC_DATA = DatabaseFallback.GetDatatableECM(oSQl)
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Sub Load_Next_Document(first As Boolean)
If LOG_HOTSPOTS Then
' ========== DIAGNOSE START ==========
MyValidationLogger.Info($"[INFO] Load_Next_Document START - first: {first}")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" frmValidator.Visible: {Me.Visible}")
MyValidationLogger.Info($" _FormClosing: {_FormClosing}")
MyValidationLogger.Info($" CURRENT_DOC_GUID: {CURRENT_DOC_GUID}")
' ========== ENDE DIAGNOSE ==========
End If
Dim oMilliseconts As Double
clsPatterns.ClearControlCache() ' Cache-Invalidierung
Dim perfStart As DateTime = DateTime.MinValue
Dim perfLastCheck As DateTime = DateTime.MinValue
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
perfLastCheck = perfStart
MyValidationLogger.Info("[PERF LND] Load_Next_Document START")
End If
_CachedSqlDataCache.Clear()
_CachedSqlScalarCache.Clear()
_CachedSqlControlsByGuid = Nothing
CURRENT_WMFILE = Nothing
activate_controls(False)
oErrMsgMissingInput = ""
WMDocPathWindows = ""
Override = False
OverrideAll = False
_Indexe_Loaded = False
MyValidationLogger.Debug("In Load_Next_Document")
Dim layoutSuspended As Boolean = False
Try
If first = True Then
MyValidationLogger.Debug("First Document")
CURRENT_WMFILE = Nothing
Else
MyValidationLogger.Debug("Following Document ")
End If
If first = False Then
PanelValidatorControl.SuspendLayout()
layoutSuspended = True
Clear_all_Input()
End If
MyValidationLogger.Debug($"CURRENT_JUMP_DOC_GUID: {CURRENT_JUMP_DOC_GUID}'")
If CURRENT_JUMP_DOC_GUID = 0 Then
CURRENT_DOC_GUID = Get_Next_GUID()
MyValidationLogger.Debug($"CURRENT_JUMP_DOC_GUID = 0 ## NEW CURRENT_DOC_GUID: {CURRENT_DOC_GUID}'")
ElseIf first = False Then
CURRENT_DOC_GUID = 0
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach Get_Next_GUID: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
MyValidationLogger.Info("LoadNextDocument - Dokument-GUID: '" & CURRENT_DOC_GUID.ToString & "'")
If CURRENT_DOC_GUID > 0 Then
If (OPERATION_MODE_FS = ClassConstants.OpModeFS_PWM Or OPERATION_MODE_FS = ClassConstants.OpModeFS_IDBWM) And GetDocPathWindows(0) = False Then
SetStatusLabel($"File not accessible: {DocPathWindows}", "DarkOrange")
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach GetDocPathWindows: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If IDB_ACTIVE = False Then
If CreateWMObject() = False Then
Exit Sub
End If
Else
Load_IDB_DOC_DATA()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach Load_IDB_DOC_DATA: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If IsNothing(IDB_DT_DOC_DATA) Then
MyValidationLogger.Warn("⚠️ ATTENTION: IDB-Data is nothing. Check the IDB_DOC_DATA_SQL Variable Source")
Exit Sub
Else
If IDB_DT_DOC_DATA.Rows.Count = 1 Then
MyValidationLogger.Debug("Got one IDB DocData Result")
End If
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach CreateWMObject/Load_IDB_DOC_DATA: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
PRTF_PROFILE_FILES_WORK("InWork")
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach IN_WORK-UPDATE: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If Amount_Docs2Validate > 1 Then
Dim omsg = String.Format(Translation_Strings.Verbleibende_Vorgänge___0_, Amount_Docs2Validate)
bsiInformation.Caption = omsg
bsiInformation.Caption = omsg
If RbnPgGrpActions.Visible = False Then
RbnPgGrpActions.Visible = True
End If
bbtniNext.Visibility = BarItemVisibility.Always
Else
bbtniNext.Visibility = BarItemVisibility.Never
If bbtniDelete.Visibility = BarItemVisibility.Never And bbtniAnnotation.Visibility = BarItemVisibility.Never Then
RbnPgGrpActions.Visible = False
End If
bsiInformation.Caption = ""
End If
bsiDocID.Caption = "Document-ID: " & CURRENT_DOC_ID & " - GUID: " & CURRENT_DOC_GUID
MyValidationLogger.Debug("AllDocInfo created...")
If IDB_ACTIVE = False Then
oErrMsgMissingInput = Windream_get_Doc_info()
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach Windream_get_Doc_info: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Dim oCurrency As String
If PROFIL_CURRENCY_ATTRIBUTE <> "" Then
oCurrency = GetVariableValuefromSource(PROFIL_CURRENCY_ATTRIBUTE, 1, False)
Else
oCurrency = "EUR"
End If
If Not IsNothing(oCurrency) Then
DocCurrency = oCurrency
If IsDBNull(DocCurrency) Then
DocCurrency = "EUR"
Else
Try
DocCurrency = DocCurrency.ToString
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Converting oCurreny to string: " & ex.Message)
DocCurrency = "EUR"
End Try
End If
End If
If oErrMsgMissingInput = "" Then
If WMDocPathWindows <> String.Empty Or OPERATION_MODE_FS = ClassConstants.OpModeFS_ZF Then
LoadDocument_DDViewer()
If Current_Document.Extension <> "pdf" Then
bbtniAnnotation.Visibility = BarItemVisibility.Never
End If
End If
If LOG_HOTSPOTS Then
oMilliseconts = (DateTime.Now - perfLastCheck).TotalMilliseconds
If oMilliseconts > 6000 Then
MyValidationLogger.Warn($"[PERF LND] ⚠️ LoadDocument_DDViewer lasted far to long: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
Else
MyValidationLogger.Info($"[PERF LND] Nach LoadDocument_DDViewer: {oMilliseconts}ms")
End If
perfLastCheck = DateTime.Now
End If
FillIndexValues(first)
If LOG_HOTSPOTS Then
oMilliseconts = (DateTime.Now - perfLastCheck).TotalMilliseconds
If oMilliseconts > 6000 Then
MyValidationLogger.Warn($"[PERF LND] ⚠️ FillIndexValues lasted far to long: {oMilliseconts}ms")
Else
MyValidationLogger.Info($"[PERF LND] Nach FillIndexValues: {oMilliseconts}ms")
End If
perfLastCheck = DateTime.Now
End If
Dim sqlControls As DataRow() = Nothing
If DTCONTROLS_WITH_SQL IsNot Nothing AndAlso DTCONTROLS_WITH_SQL.Rows.Count > 0 Then
sqlControls = DTCONTROLS_WITH_SQL.Select($"PROFIL_ID = {CURRENT_ProfilGUID}")
End If
If sqlControls IsNot Nothing AndAlso sqlControls.Length > 0 Then
Dim sqlControlIds As New HashSet(Of Integer)()
For Each r As DataRow In sqlControls
Dim controlId As Integer = 0
If Integer.TryParse(r.Item("GUID").ToString, controlId) Then
sqlControlIds.Add(controlId)
End If
Next
For Each oControl As Control In PanelValidatorControl.Controls
Dim controlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
If sqlControlIds.Contains(controlId) Then
LoadSQLData(oControl, controlId)
End If
Next
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach LoadSQLData-Loop: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
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)
End If
End If
activate_controls(True)
Else
errormessage = oErrMsgMissingInput
frmError.ShowDialog()
End If
Else
If oErrMsgMissingInput <> "" Then
errormessage = oErrMsgMissingInput
frmError.ShowDialog()
Else
Dim oMsg = Translation_Strings.Ende_des_Profils___Keine_weiteren_Vorgänge
MyValidationLogger.Info(oMsg)
MyValidationLogger.Debug(oMsg)
activate_controls(True)
MyValidationLogger.Debug("Closing the form...")
Me.Close()
End If
End If
Try
If DocCurrency <> String.Empty Then
If DocCurrency.ToString.Length <> 3 Then
DocCurrency = "EUR"
End If
For Each oControl As Control In PanelValidatorControl.Controls
Try
If TypeOf oControl Is GridControl Then
Dim oGrid As GridControl = DirectCast(oControl, GridControl)
Dim oControlMeta = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata)
Dim oFilteredDatatable As DataTable = DT_COLUMNS_GRID.Clone()
Dim oExpression = $"CONTROL_ID = {oControlMeta.Guid}"
DT_COLUMNS_GRID.Select(oExpression, "SEQUENCE").CopyToDataTable(oFilteredDatatable, LoadOption.PreserveChanges)
Dim oCultureInfo As CultureInfo = New CultureInfo("de-DE")
oCultureInfo.NumberFormat.CurrencySymbol = DocCurrency
Dim riTextEdit As RepositoryItemTextEdit = New RepositoryItemTextEdit()
riTextEdit.MaskSettings.Configure(Of MaskSettings.Numeric)(Sub(settings)
settings.MaskExpression = "c"
settings.Culture = oCultureInfo
End Sub)
riTextEdit.UseMaskAsDisplayFormat = True
oGrid.RepositoryItems.Add(riTextEdit)
Dim oGridView As GridView = DirectCast(oGrid.FocusedView, GridView)
For Each oCol As GridColumn In oGridView.Columns
Dim oColumnData As DataRow = oFilteredDatatable.Select($"SPALTENNAME = '{oCol.FieldName}'").FirstOrDefault()
If oColumnData Is Nothing Then
Continue For
End If
Dim oColumnType As String = oColumnData.Item("TYPE_COLUMN")
If oColumnType = "CURRENCY" Then
oCol.DisplayFormat.FormatType = FormatType.Custom
oCol.ColumnEdit = riTextEdit
End If
Next
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
Next
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in display format Currency: " & ex.Message)
End Try
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach Currency-Format: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Try
Show_WF_Messages(False)
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
If LOG_HOTSPOTS Then
oMilliseconts = (DateTime.Now - perfLastCheck).TotalMilliseconds
If oMilliseconts > 6000 Then
MyValidationLogger.Warn($"[PERF LND] ⚠️ Show_WF_Messages lasted far to long: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
Else
MyValidationLogger.Info($"[PERF LND] Nach Show_WF_Messages: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
End If
perfLastCheck = DateTime.Now
End If
Controls2B_EnDisabled()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF LND] Nach Controls2B_EnDisabled: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
MyValidationLogger.Debug("frmValidator: LoadNextDocument finished!")
Catch ex As Exception
MyValidationLogger.Error(ex)
errormessage = "unexpected error in Load_Next_Document:" & ex.Message
My.Settings.Save()
MyValidationLogger.Info("unexpected error in Load_Next_Document: " & ex.Message)
frmError.ShowDialog()
Finally
If layoutSuspended Then
PanelValidatorControl.ResumeLayout()
End If
If LOG_HOTSPOTS Then
' ========== DIAGNOSE ENDE ==========
MyValidationLogger.Info($"[INFO] Load_Next_Document ENDE")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" frmValidator.Visible: {Me.Visible}")
' ========== ENDE DIAGNOSE ==========
MyValidationLogger.Info($"[PERF LND] Load_Next_Document GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
End Try
End Sub
Sub Show_WF_Messages(pShow As Boolean)
Try
If Not Application.OpenForms().OfType(Of frmValidator_Messages).Any Then
Dim oSQLMessage = $"SELECT
CONVERT(VARCHAR(30), A.ADDED_WHEN,20) + ' - ' + B.STRING1 as MSG,A.ImageIndex
FROM
TBTFVALIDATOR_MESSAGE A INNER JOIN
(SELECT * FROM TBDD_GUI_LANGUAGE_PHRASE
WHERE MODULE = 'PM' AND OBJ_NAME = 'frmValidator' AND CAPT_TYPE = 'WF_MESSAGE') B ON A.GUI_LANG_TITLE = B.TITLE
WHERE
A.Active = 1 and (A.DocID = {CURRENT_DOC_ID}) AND B.LANGUAGE = '{USER_LANGUAGE}' ORDER BY A.ADDED_WHEN DESC"
If SQL_WF_MESSAGES <> String.Empty Then
oSQLMessage = SQL_WF_MESSAGES
oSQLMessage = oSQLMessage.Replace("@DocID", CURRENT_DOC_ID)
oSQLMessage = oSQLMessage.Replace("@LANGUAGE", USER_LANGUAGE)
oSQLMessage = oSQLMessage.Replace("@UserID", USER_ID)
oSQLMessage = oSQLMessage.Replace("@UserName", USER_USERNAME)
End If
DTInfoDoc = DatabaseFallback.GetDatatableECM(oSQLMessage)
If DTInfoDoc.Rows.Count > 0 Then
rbnPgGroupHinweise.Visible = True
bchkitmNotes.Checked = CONFIG.Config.NOTES_ONCLICK
If CONFIG.Config.NOTES_ONCLICK = False Or pShow = True Then
Dim ofrmMessage As New frmValidator_Messages(DTInfoDoc)
frmMessages = ofrmMessage
ofrmMessage.Show()
End If
Else
rbnPgGroupHinweise.Visible = False
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
End Sub
Sub LoadDocument_DDViewer()
Try
Dim oDocument As DocumentResultList.Document = Nothing
' Load DocumentInfo
oDocument = DD_Documentloader.Load(CURRENT_DOC_ID, WMDocPathWindows)
If oDocument Is Nothing Then
Exit Sub
End If
Current_Document = oDocument
Catch ex As Exception
MyValidationLogger.Error(ex)
Exit Sub
End Try
If ActiveWorkflowType = ConstAHWorkflow_BlindFile Or PROFILE_SHOW_DOCUMENT = False Then
If PROFILE_SHOW_DOCUMENT = False And ActiveWorkflowType <> ConstAHWorkflow_BlindFile Then
MyValidationLogger.Warn("⚠️ PROFILE_SHOW_DOCUMENT = False - DocumentViewer won't be displayed. Configuration error?")
End If
SplitContainer1.Panel2Collapsed = True
If Not IsNothing(DocumentViewer1) Then
DocumentViewer1.Visible = False
End If
RibbonPageFile.Visible = False
Exit Sub
Else
If Not IsNothing(DocumentViewer1) Then
DocumentViewer1.Visible = True
End If
End If
' Load Document in Document Viewer
Dim oFileName = $"{CURRENT_DOC_ID}.{Current_Document.Extension}"
If Not IsNothing(DocumentViewer1) Then
MyValidationLogger.Info("LoadDocument_DDViewer - Current_Document.FullPath: " & Current_Document.FullPath)
If (OPERATION_MODE_FS = ClassConstants.OpModeFS_PWM Or OPERATION_MODE_FS = ClassConstants.OpModeFS_IDBWM) Then
DocumentViewer1.LoadFile_FromPath(Current_Document.FullPath)
'Erstmal auskommentiert
'DocumentViewer1.LoadFile(oFileName, New MemoryStream(Current_Document.Contents))
Else
'DocumentViewer1.LoadFile(oFileName, New MemoryStream(Current_Document.Contents))
End If
DocumentViewer1.RightOnlyView(USER_RIGHT_VIEW_ONLY) 'war auskommentiert.....WARUM?
End If
If USER_RIGHT_VIEW_ONLY = True Then
RibbonPageFile.Visible = False
Else
RibbonPageFile.Visible = True
End If
SplitContainer1.Panel2Collapsed = False
End Sub
Sub activate_controls(pStatus As Boolean)
Try
MyValidationLogger.Debug("Sub activate_controls - status = " + pStatus.ToString)
Me.PanelValidatorControl.Enabled = pStatus
Me.btnSave.Enabled = pStatus
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
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
MyValidationLogger.Debug($"GetVariableValue [{INDEX_DMS_ERSTELLT}]...")
CURRENT_DOC_CREATION_DATE = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT)
Catch ex As Exception
MyValidationLogger.Error(ex)
If ex.Message.Contains("Variable: " & INDEX_DMS_ERSTELLT & " not found!") Then
MyValidationLogger.Info("1. Ausnahme in Windream_get_Doc_info: Variable: " & INDEX_DMS_ERSTELLT & " not found", True)
MyValidationLogger.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
MyValidationLogger.Info("error in Windream_get_Doc_info 1: " & ex.Message)
Return "error in Windream_get_Doc_info 1: " & ex.Message
End If
End Try
MyValidationLogger.Debug("DMS-Erstellt aus WD: " & CURRENT_DOC_CREATION_DATE)
Try
MyValidationLogger.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
MyValidationLogger.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
MyValidationLogger.Debug($"GetVariableValue (2) [{INDEX_DMS_ERSTELLT_ZEIT}]...")
CURRENT_DOC_CREATION_TIME = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT)
Else
MyValidationLogger.Error(ex)
MyValidationLogger.Info("error in Windream_get_Doc_info 3: " & ex.Message)
Return "error in Windream_get_Doc_info 3: " & ex.Message
End If
End Try
MyValidationLogger.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
MyValidationLogger.Error(ex)
MyValidationLogger.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
MyValidationLogger.Error(ex)
MsgBox("error in ReturnVektor_IndexValue: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE)
MyValidationLogger.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
MyValidationLogger.Debug($"GetVariableValuefromSource - IDBCase...")
oValuefromSource = IDBData.GetVariableValue(oSourceIndexName, oIDBTyp, FromIDB)
End If
Return oValuefromSource
Catch ex As Exception
MyValidationLogger.Error(ex)
Return Nothing
End Try
End Function
Sub FillIndexValues(first As Boolean, Optional SingleAttribute As String = "")
' ========== PERFORMANCE-LOGGING ==========
Dim perfStart As DateTime = DateTime.MinValue
Dim perfLastCheck As DateTime = DateTime.MinValue
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
perfLastCheck = perfStart
MyValidationLogger.Info($"[PERF FillIndexValues] START - Controls: {PanelValidatorControl.Controls.Count}")
End If
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues")
Dim oControlType As String
Dim oIndexName As String
Dim oControName As String
Dim oIDBOverride As Boolean = False
' ========== OPTIMIERUNG 1: Einmalige Gruppierung von Grid-Spalten ==========
' VORHER: Für jedes Grid wurde DT_COLUMNS_GRID.Select() aufgerufen → O(n * m)
' NACHHER: Einmalig gruppieren, dann Dictionary-Lookup → O(n + m)
Dim columnsByControl As Dictionary(Of Integer, DataTable) = Nothing
If DT_COLUMNS_GRID IsNot Nothing AndAlso DT_COLUMNS_GRID.Rows.Count > 0 Then
columnsByControl = New Dictionary(Of Integer, DataTable)()
For Each groupRow In DT_COLUMNS_GRID.AsEnumerable().GroupBy(Function(r) r.Field(Of Integer)("CONTROL_ID"))
Dim controlId As Integer = groupRow.Key
Dim dt = groupRow.OrderBy(Function(r) r.Field(Of Integer)("SEQUENCE")).CopyToDataTable()
columnsByControl(controlId) = dt
Next
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach columnsByControl-Gruppierung: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
End If
' ========== ENDE OPTIMIERUNG 1 ==========
' ========== OPTIMIERUNG 2: Control-Dictionary für schnellere Suche ==========
' VORHER: Verschachtelte Loops für Control-Suche → O(n²)
' NACHHER: Dictionary-Lookup → O(1)
If _CachedControlsByGuid Is Nothing Then
_CachedControlsByGuid = New Dictionary(Of Integer, Control)()
For Each ctrl As Control In PanelValidatorControl.Controls
Try
Dim meta = DirectCast(ctrl.Tag, ClassControlCreator.ControlMetadata)
_CachedControlsByGuid(meta.Guid) = ctrl
Catch
Continue For
End Try
Next
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach _CachedControlsByGuid-Erstellung: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
End If
' ========== ENDE OPTIMIERUNG 2 ==========
' ========== OPTIMIERUNG 3: UI-Updates pausieren (kritisch für Performance!) ==========
' VORHER: Jede Zuweisung triggerte Repaint → tausende UI-Updates
' NACHHER: Alle Updates gebündelt → nur ein Repaint am Ende
PanelValidatorControl.SuspendLayout()
_suppressLookupEvents = True ' ← NEU: Events während FillIndexValues unterdrücken
Try
' ========== ENDE OPTIMIERUNG 3 ==========
If DTVWCONTROL_INDEX.Rows.Count > 0 Then
Dim oCount As Integer = 0
For Each oControl As Control In Me.PanelValidatorControl.Controls
Dim oValueFromSource
Dim oFormattedValue As String = ""
' ========== OPTIMIERUNG 4: LINQ statt Loop für Control-Row-Suche ==========
' VORHER: Implizite Loop über DTVWCONTROL_INDEX
' NACHHER: Optimierter LINQ-Query mit SingleOrDefault
Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
Dim oControlRow = (From form In DTVWCONTROL_INDEX.AsEnumerable()
Where form.Item("GUID") = oControlId).SingleOrDefault()
If oControlRow Is Nothing Then Continue For
' ========== ENDE OPTIMIERUNG 4 ==========
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")
Dim oDefaultValue As String = ObjectEx.NotNull(oControlRow.Item("DEFAULT_VALUE"), String.Empty)
oIndexName = oSourceIndexName
oControName = oControl.Name
Dim oLoadIndex As Boolean = oControlRow.Item("LOAD_IDX_VALUE")
If oIndexName = "@@DISPLAY_ONLY" Then
oLoadIndex = False
End If
MyValidationLogger.Debug("INDEX: " & oSourceIndexName & " - CONTROLNAME: " & oControl.Name & " - LOAD IDXVALUES: " & oLoadIndex.ToString)
Select Case True
Case oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType = GetType(MemoEdit)
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues/TextEdit")
Try
oControlType = "Textbox"
Dim oTextBox As DevExpress.XtraEditors.TextEdit = oControl
Dim oMeta As ClassControlCreator.ControlMetadata = oTextBox.Tag
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 Then
MyValidationLogger.Debug($" oControl {oControl.Name}: Indexwert soll nicht geladen werden.")
If Not {"@@DISPLAY_ONLY", "DD PM-ONLY FOR DISPLAY"}.Contains(oSourceIndexName) Then
oTextBox.EditValue = oDefaultValue
End If
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
MyValidationLogger.Debug("TextBox with VektorField: " & oSourceIndexName)
Try
MyValidationLogger.Debug($"Length of Vektorarray: {oValueFromSource.length}")
Catch ex As Exception
MyValidationLogger.Info($"Error in gettin the lenth of vektorfield {oSourceIndexName} - {ex.Message}")
End Try
If oValueFromSource.length = 1 Then
oValueFromSource = oValueFromSource(0)
Else
MyValidationLogger.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used")
oValueFromSource = oValueFromSource(0)
End If
MyValidationLogger.Debug($"wertWD has been saved...")
End If
End If
End If
MyValidationLogger.Debug("Value from Source: [{0}]", oValueFromSource)
Try
Dim oFormatString As String = oControlRow.ItemEx("CTRL_FORMAT_STRING", "")
oTextBox.EditValue = ObjectEx.NotNull(oValueFromSource, oDefaultValue)
If oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) And oFormatString = "CURRENCY" Then
ApplyCurrencyMask(oTextBox)
End If
' BackColor-Logik
Try
Dim oBackColor As String = oControlRow.Item("CTRL_BACKCOLOR_IF")
If oBackColor <> String.Empty Then
Dim oSPlit = Split(oBackColor, ";")
If oSPlit.Length = 3 Then
Dim oValueConverted
If IsNumeric(oValueFromSource) Then
oValueConverted = oValueFromSource.ToString.Replace(",", ".")
Else
oValueConverted = oValueFromSource
End If
Dim oExpression = $"{oValueConverted} {oSPlit(0)}"
Dim oSQl = $"SELECT CASE WHEN {oExpression} THEN CONVERT(BIT,1) ELSE CONVERT(BIT,0) END "
Dim oColorName = IIf(DatabaseECM.GetScalarValue(oSQl), oSPlit(1), oSPlit(2))
oControl.BackColor = Color.FromName(oColorName)
oMeta.BackColor = oControl.BackColor
oControl.ForeColor = GraphicsEx.GetContrastedColor(oControl.BackColor)
End If
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Set Backcolor [{oControl.Name}]: {ex.Message}")
MyValidationLogger.Error(ex)
End Try
' ========== OPTIMIERUNG 5: GridTables erst NACH allen TextBox-Updates ==========
' NACHHER wird dies EINMAL am Ende aufgerufen (siehe unten)
' ========== ENDE OPTIMIERUNG 5 ==========
Catch ex As Exception
MyValidationLogger.Info("Error While converting defaultValue [" & oDefaultValue & "]: " & ex.Message)
oTextBox.EditValue = ""
End Try
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
errormessage = $"Unvorhergesehener Fehler bei FillIndexValues TextBox [{oControl.Name}]:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile"
My.Settings.Save()
frmError.ShowDialog()
MyValidationLogger.Info("Unexpected error in FillIndexValuesTextBox: " & ex.Message, True)
MyValidationLogger.Info(">> Controltype: " & oControlType)
MyValidationLogger.Info(">> Indexname windream: " & oIndexName)
Exit Sub
End Try
Case oControl.GetType = GetType(Windows.Forms.ComboBox)
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues/ComboBox")
oControlType = "ComboBox"
Dim oMyCombobox As Windows.Forms.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 Then
MyValidationLogger.Debug($" oMyComboBox {oMyCombobox.Name}: Indexwert soll nicht geladen werden.")
If Not {"@@DISPLAY_ONLY", "DD PM-ONLY FOR DISPLAY"}.Contains(oSourceIndexName) Then
If oDefaultValue = String.Empty Then
oMyCombobox.SelectedIndex = -1
Else
oMyCombobox.Text = oDefaultValue
End If
End If
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
MyValidationLogger.Debug($"oMyComboBox {oMyCombobox.Name} - Indexvalue from index {oSourceIndexName}: Nothing")
If oDefaultValue = String.Empty Then
MyValidationLogger.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wurde nicht gefunden")
oMyCombobox.SelectedIndex = -1
Else
MyValidationLogger.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wird geladen")
oMyCombobox.Text = oDefaultValue
End If
Else
If oValueFromSource.ToString = "System.Object[]" Then
MyValidationLogger.Debug($"oMyComboBox {oMyCombobox.Name} - Combobox with VektorField: " & oSourceIndexName)
Try
MyValidationLogger.Debug($"Length of Vektorarray: {oValueFromSource.length}")
Catch ex As Exception
MyValidationLogger.Info($"Error in gettin the length of vektorfield {oSourceIndexName} - {ex.Message}")
End Try
If oValueFromSource.length = 1 Then
oValueFromSource = oValueFromSource(0)
Else
MyValidationLogger.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used")
oValueFromSource = oValueFromSource(0)
End If
MyValidationLogger.Debug($"wertWD has been saved...")
End If
MyValidationLogger.Debug($"Indexwert from Index {oSourceIndexName}: {oValueFromSource}")
MyValidationLogger.Debug($"Items in Combobox: {oMyCombobox.Items.Count}")
If oMyCombobox.Items.Count = 0 Then
oMyCombobox.Text = oValueFromSource
Else
MyValidationLogger.Debug($"Index Wert [{oValueFromSource}] wurde ausgewählt")
oMyCombobox.SelectedIndex = oMyCombobox.FindStringExact(oValueFromSource)
MyValidationLogger.Debug($"oMyComboBox {oMyCombobox.Name} .SelectedIndex: {oMyCombobox.SelectedIndex}")
End If
End If
End If
MyValidationLogger.Debug("")
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Info(">> Unexpected error in FillIndexValues(Combobox: " & oMyCombobox.Name & "): " & ex.Message, True)
MyValidationLogger.Info(">> Controltype: " & oControlType)
MyValidationLogger.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 oControl.GetType = GetType(GridControl)
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues/GridControl")
oControlType = "DevExpress.XtraGrid.GridControl"
Dim oMyGridControl As GridControl = oControl
' ========== OPTIMIERUNG 6: Dictionary-Lookup statt Select() ==========
' VORHER: DT_COLUMNS_GRID.Select($"CONTROL_ID = {oControlId}") → O(n) pro Grid
' NACHHER: Dictionary.TryGetValue() → O(1)
Dim oDTColumnsPerDevExGrid As DataTable = Nothing
If columnsByControl IsNot Nothing AndAlso columnsByControl.TryGetValue(oControlId, oDTColumnsPerDevExGrid) Then
MyValidationLogger.Debug($"Grid [{oControl.Name}]: {oDTColumnsPerDevExGrid.Rows.Count} Spalten aus Cache geladen")
Else
oDTColumnsPerDevExGrid = DT_COLUMNS_GRID.Clone()
MyValidationLogger.Warn($"⚠️ Grid [{oControl.Name}]: Keine Spalten-Definition gefunden!")
End If
' ========== ENDE OPTIMIERUNG 6 ==========
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, ADDITIONAL_TITLE)
Exit For
End If
If oSourceIndexName Is Nothing = False Then
If oLoadIndex = False Then
MyValidationLogger.Debug($" oControl {oControl.Name}: Indexwert soll nicht geladen werden.")
Exit Select
End If
MyValidationLogger.Debug($"getting Value for Attribute [{oSourceIndexName}] - oIDBTyp [{oIDBTyp}] - oIDBOverride [{oIDBOverride}]...")
oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride)
If oValueFromSource Is Nothing = False Then
Dim oValueType = oValueFromSource.GetType.ToString
MyValidationLogger.Debug($"oValueType is [{oValueType}]!")
If oValueType.Contains("System.Object") Or oValueType = "System.Data.DataTable" Or oValueType = "System.String" Then
Select Case oTyp
Case "TABLE"
Dim oColValuesfromSource As String()
MyValidationLogger.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
MyValidationLogger.Debug("ValueFromSource contains {0} items", oValueFromSource)
For Each Zeile As Object In oValueFromSource
MyValidationLogger.Debug($"vektorrow Value {Zeile.ToString}...")
oColValuesfromSource = Split(Zeile, PMDelimiter)
Dim oNewRow = oDataSource.NewRow()
MyValidationLogger.Debug("Creating new row..")
For index = 0 To oDTColumnsPerDevExGrid.Rows.Count - 1
Dim rawValue As String = If(index < oColValuesfromSource.Length, oColValuesfromSource(index), String.Empty)
Dim targetColumn As DataColumn = oDataSource.Columns(index)
Dim colName As String = targetColumn.ColumnName
Dim colType As String = targetColumn.DataType.FullName
MyValidationLogger.Debug("Grid row assign: RowIdx={0}, ColIdx={1}, ColName={2}, ColType={3}, RawValue=[{4}], IsEmpty={5}",
oDataSource.Rows.Count, index, colName, colType, rawValue, String.IsNullOrWhiteSpace(rawValue))
Try
If oColValuesfromSource.Length > index Then
oNewRow.Item(index) = oColValuesfromSource(index)
Else
If colType = "System.Double" Or colType = "System.Int32" Or colType = "System.Int64" Then
oNewRow.Item(index) = 0
Else
oNewRow.Item(index) = String.Empty
End If
End If
Catch ex As Exception
MyValidationLogger.Warn("⚠️ Grid row assign FAILED RowIdx = {0}, ColIdx={1}, ColName={2}, ColType={3}, RawValue=[{4}]",
oDataSource.Rows.Count, index, colName, colType, rawValue)
MyValidationLogger.Error(ex)
Try
MyValidationLogger.Debug("Column.AllowDBNull={0}, Column.MaxLength={1}", targetColumn.AllowDBNull, targetColumn.MaxLength)
Catch
End Try
Throw
End Try
Next
MyValidationLogger.Debug("Adding row To grid..")
oDataSource.Rows.Add(oNewRow)
Next
Else
' IDB-Logik (bleibt gleich)
If oValueType = "System.String" Then
MyValidationLogger.Debug($"IDB Fill Grid [{oControl.Name}] With String")
MyValidationLogger.Debug($"oValueFromSource [{oValueFromSource}] - PMDelimiter[{PMDelimiter}]")
oColValuesfromSource = Split(oValueFromSource.ToString, PMDelimiter)
If oColValuesfromSource.Length > 8 Then
MyValidationLogger.Warn("⚠️ Fill Grid Error - Max 8 columns can be configured!")
End If
Dim oRowData As New List(Of Object)
MyValidationLogger.Debug(String.Format("Now creating the rows For DevexpressGrid ..."))
Dim oMSG = ""
Try
For index = 1 To oColValuesfromSource.Length
oMSG = ""
Dim oValue = oColValuesfromSource(index - 1)
oMSG = String.Format("...Index [{0}] - Value [{1}]", index, oValue)
MyValidationLogger.Debug(oMSG)
If oDTColumnsPerDevExGrid.Rows.Count > (index - 1) Then
Dim oColumnType = oDTColumnsPerDevExGrid.Rows.Item(index - 1).Item("TYPE_COLUMN")
Dim oConvertedValue = ClassFormat.GetConvertedValue(oValue, oColumnType)
oRowData.Add(oConvertedValue)
Else
MyValidationLogger.Warn(String.Format("Mehr Values als Spaten in oDTColumnsPerDevExGrid {0}", oControl.Name))
End If
Next
Catch ex As Exception
MyValidationLogger.Warn(String.Format("Unexpected Error While working On IDB Fill GridControl {0}", oControl.Name))
If Not oMSG = String.Empty Then
MyValidationLogger.Warn(String.Format("oMSG {0}", oMSG))
End If
MyValidationLogger.Error(ex)
End Try
oDataSource.Rows.Add(oRowData.ToArray())
ElseIf oValueType = "System.Data.DataTable" Then
Dim oMyDatatable As DataTable = oValueFromSource
Dim oIsGridReadOnly As Boolean = CBool(oControlRow.Item("READ_ONLY"))
MyValidationLogger.Debug($"IDB Fill Grid [{oControl.Name}] With Datatable - Rows {oMyDatatable.Rows.Count} - ReadOnly: {oIsGridReadOnly}")
' ========== FIX: Spaltenanzahl-Prüfung EINMALIG vor dem Loop ==========
Dim oConfiguredColumns As Integer = oDTColumnsPerDevExGrid.Rows.Count
Dim oMaxSourceColumns As Integer = If(oMyDatatable.Rows.Count > 0,
oMyDatatable.Rows.Cast(Of DataRow)().
Max(Function(r) Split(r.Item(0).ToString, PMDelimiter).Length),
0)
If oMaxSourceColumns > oConfiguredColumns Then
If oIsGridReadOnly Then
MyValidationLogger.Info($"⚠️ [DataTable] Grid [{oControl.Name}] ist ReadOnly → {oMaxSourceColumns} Quelldaten, {oConfiguredColumns} Spalten konfiguriert. Überzählige Felder werden ignoriert.")
Else
' ========== FIX: Sprachabhängige Texte ==========
Dim oTitle As String
Dim oQuestion As String
Select Case USER_LANGUAGE
Case "de-DE"
oTitle = "Spaltenkonfiguration prüfen"
oQuestion = $"Das Grid '{oControl.Name}' enthält Zeilen mit bis zu {oMaxSourceColumns} Datenwerten," & vbCrLf &
$"aber nur {oConfiguredColumns} Spalten sind konfiguriert." & vbCrLf &
$"Es werden nur die ersten {oConfiguredColumns} Werte je Zeile angezeigt." & vbCrLf & vbCrLf &
"Möchten Sie trotzdem fortfahren?"
Case "fr-FR"
oTitle = "Vérifier la configuration des colonnes"
oQuestion = $"La grille '{oControl.Name}' contient des lignes avec jusqu'à {oMaxSourceColumns} valeurs," & vbCrLf &
$"mais seulement {oConfiguredColumns} colonnes sont configurées." & vbCrLf &
$"Seules les {oConfiguredColumns} premières valeurs par ligne seront affichées." & vbCrLf & vbCrLf &
"Voulez-vous continuer quand même?"
Case Else ' en-US, en-GB, etc.
oTitle = "Check column configuration"
oQuestion = $"The grid '{oControl.Name}' contains rows with up to {oMaxSourceColumns} values," & vbCrLf &
$"but only {oConfiguredColumns} columns are configured." & vbCrLf &
$"Only the first {oConfiguredColumns} values per row will be displayed." & vbCrLf & vbCrLf &
"Do you want to continue anyway?"
End Select
' ========== ENDE FIX ==========
Dim oResult = MessageBox.Show(
oQuestion,
oTitle,
MessageBoxButtons.YesNo,
MessageBoxIcon.Warning)
If oResult = DialogResult.No Then
MyValidationLogger.Warn($"⚠️ [DataTable] Benutzer hat Fortfahren für Grid [{oControl.Name}] abgebrochen.")
Exit Select
End If
End If
End If
' ========== ENDE FIX ==========
For Each oRow As DataRow In oMyDatatable.Rows
Try
MyValidationLogger.Debug($"IDB ROW Vector {oRow.Item(0).ToString}...")
oColValuesfromSource = Split(oRow.Item(0).ToString, PMDelimiter)
MyValidationLogger.Debug($"oColValuesfromSource splitted - Length ({oColValuesfromSource.Length.ToString})")
Dim oRowData As New List(Of Object)
For index = 1 To oConfiguredColumns
Try
Dim oRawValue As String = If(index <= oColValuesfromSource.Length,
oColValuesfromSource(index - 1),
String.Empty)
Dim oColumnType = oDTColumnsPerDevExGrid.Rows.Item(index - 1).Item("TYPE_COLUMN")
MyValidationLogger.Debug($"oColumnType Of DGView-Column ({oColumnType.ToString})...")
Dim oConvertedValue = ClassFormat.GetConvertedValue(oRawValue, oColumnType)
oRowData.Add(oConvertedValue)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error While converting/adding Value To oRowData " & ex.Message)
oRowData.Add(String.Empty)
End Try
Next
oDataSource.Rows.Add(oRowData.ToArray())
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error While adding datarow [{oRow.Item(0).ToString}] To Grid " & ex.Message)
End Try
Next
End If
End If
Else
MyValidationLogger.Info($"⚠️ DevExpressGrid There are no columns configured/listed For control {oControlId}.")
End If
Case Else
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})
End If
Next
End Select
Else
MyValidationLogger.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
' ========== OPTIMIERUNG 7: GridView-Spaltenbreiten mit Dictionary ==========
' VORHER: Verschachtelte Loop über Columns × oDTColumnsPerDevExGrid → O(n × m)
' NACHHER: Dictionary-Lookup → O(n + m)
Try
Dim oMyGridView As DevExpress.XtraGrid.Views.Grid.GridView = oMyGridControl.MainView
oMyGridView.OptionsView.ColumnAutoWidth = False
If oDTColumnsPerDevExGrid IsNot Nothing AndAlso oDTColumnsPerDevExGrid.Rows.Count > 0 Then
Dim columnsByName = oMyGridView.Columns.Cast(Of GridColumn)().
ToDictionary(Function(c) c.FieldName, StringComparer.OrdinalIgnoreCase)
For Each oRow As DataRow In oDTColumnsPerDevExGrid.Rows
Dim columnName = oRow.Item("SPALTENNAME").ToString()
Dim column As GridColumn = Nothing
If columnsByName.TryGetValue(columnName, column) Then
column.Width = oRow.Item("SPALTENBREITE")
End If
Next
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
' ========== ENDE OPTIMIERUNG 7 ==========
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Info(">> Unexpected Error In FillIndexValues(GridControl " & oMyGridControl.Name & ") " & ex.Message, True)
MyValidationLogger.Info(">> Controltype " & oControlType)
MyValidationLogger.Info(">> Attributname " & oIndexName)
errormessage = "Unexpected Error In FillIndexValues(Combobox " & oMyGridControl.Name & ") " & vbNewLine & ex.Message & vbNewLine & "Check Logfile"
My.Settings.Save()
frmError.ShowDialog()
End Try
Case oControl.GetType = GetType(CheckBox)
MyValidationLogger.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 {"@@DISPLAY_ONLY", "DD PM-ONLY For DISPLAY"}.Contains(oSourceIndexName) Then
MyValidationLogger.Debug($" oControl {oControl.Name} Indexwert soll nicht geladen werden.")
Exit Select
End If
MyValidationLogger.Debug("Loading Bool-Value from Source...")
If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then
oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName)
Else
Try
MyValidationLogger.Debug($"..Now GetVariableValue({oSourceIndexName})...")
oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride)
Catch ex As Exception
MyValidationLogger.Warn($"Could Not Get the windreamValue For CheckboxIndex {oSourceIndexName} [{ex.Message}]")
End Try
End If
If oValueFromSource Is Nothing Then
MyValidationLogger.Info(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Checking defaultvalue")
MyValidationLogger.Debug(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Checking defaultvalue")
If oDefaultValue <> String.Empty Then
MyValidationLogger.Info($"Using Default value [{oDefaultValue}]")
MyValidationLogger.Debug($"Using Default value [{oDefaultValue}]")
myCheckBox.Checked = CBool(oDefaultValue)
Exit Select
Else
MyValidationLogger.Debug("No Default Value for Checkbox - so using false!")
myCheckBox.CheckState = CheckState.Indeterminate
End If
Else
MyValidationLogger.Debug("oValueFromSource: " & oValueFromSource.ToString)
If oValueFromSource.ToString = "" Then
MyValidationLogger.Info(">> Versuch, default Value zu laden")
If oDefaultValue <> String.Empty Then
Dim result = False
If Boolean.TryParse(oDefaultValue, result) Then
MyValidationLogger.Info(">> defaultValue wurde geladen")
myCheckBox.Checked = result
myCheckBox.CheckState = If(result, CheckState.Checked, CheckState.Unchecked)
Else
myCheckBox.Checked = False
myCheckBox.CheckState = CheckState.Unchecked
End If
Else
MyValidationLogger.Info(">> defaultValue war leer")
myCheckBox.Checked = False
myCheckBox.CheckState = CheckState.Unchecked
End If
Else
Dim _value
If oValueFromSource.ToString = "System.Object[]" Then
MyValidationLogger.Debug("CheckBoxValue with VectorField: " & oSourceIndexName)
If oValueFromSource.length = 1 Then
_value = oValueFromSource(0)
Else
MyValidationLogger.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used")
_value = oValueFromSource(0)
End If
Else
_value = oValueFromSource
MyValidationLogger.Debug($"Value is not nothing and also not System.Object: [{_value}]")
End If
Try
Select Case CBool(_value)
Case True
MyValidationLogger.Debug(">> CBool(_value) = True")
myCheckBox.Checked = True
myCheckBox.CheckState = CheckState.Checked
Case False
MyValidationLogger.Debug(">> CBool(_value) = False")
myCheckBox.Checked = False
myCheckBox.CheckState = CheckState.Unchecked
End Select
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.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 oControl.GetType = GetType(LookupControl3)
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues/LookupControl")
Try
Dim oLookup As LookupControl3 = oControl
Dim oLookupMeta As ClassControlCreator.ControlMetadata = DirectCast(oLookup.Tag, ClassControlCreator.ControlMetadata)
' ========== BUGFIX START: Alte SelectedValues SICHERN bevor DataSource überschrieben wird ==========
Dim previousSelectedValues As List(Of String) = Nothing
Dim hadPreviousSelection As Boolean = False
If oLookup.Properties.SelectedValues IsNot Nothing AndAlso oLookup.Properties.SelectedValues.Count > 0 Then
previousSelectedValues = New List(Of String)(oLookup.Properties.SelectedValues)
hadPreviousSelection = True
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: Alte SelectedValues gesichert = [{String.Join(",", previousSelectedValues)}]")
End If
' ========== BUGFIX END: Sicherung ==========
oValueFromSource = GetVariableValuefromSource(oSourceIndexName, oIDBTyp, oIDBOverride)
If oLoadIndex = False Then
MyValidationLogger.Debug($" oLookup {oLookup.Name}: Indexwert soll nicht geladen werden.")
Exit Select
End If
Dim oNewValues As List(Of String) = Nothing
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
oNewValues = oArrlist
Else
oNewValues = New List(Of String) From {oValueFromSource.ToString}
End If
Else
' ========== BUGFIX START: Wenn KEIN neuer Wert, alte Werte behalten ==========
If hadPreviousSelection AndAlso previousSelectedValues IsNot Nothing AndAlso previousSelectedValues.Count > 0 Then
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: Kein neuer Wert von Quelle → alte Werte BEHALTEN")
oNewValues = previousSelectedValues
ElseIf oDefaultValue <> String.Empty Then
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: Keine alten Werte, verwende DefaultValue = [{oDefaultValue}]")
oNewValues = oDefaultValue.Split(",").ToList()
Else
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: KEINE Werte (oValueFromSource=Nothing, oDefaultValue leer, keine vorherigen Werte)")
End If
' ========== BUGFIX END: Wert-Beibehaltung ==========
End If
' ========== KRITISCH: DataSource-Backup erstellen BEVOR SelectedValues gelöscht wird ==========
Dim savedDataSource = oLookup.Properties.DataSource
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: DataSource-Backup erstellt")
' ========== KRITISCH: DataSource ZUERST wiederherstellen, DANN SelectedValues leeren ==========
' Wenn DataSource verloren gegangen sein sollte (z.B. aus LoadSQLData), JETZT wiederherstellen
If oLookup.Properties.DataSource Is Nothing AndAlso savedDataSource IsNot Nothing Then
oLookup.Properties.DataSource = savedDataSource
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: DataSource wiederhergestellt BEVOR SelectedValues gelöscht")
End If
' Jetzt erst SelectedValues leeren (DataSource ist wieder da!)
Try
oLookup.Properties.SelectedValues = New List(Of String)
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: SelectedValues auf leere Liste zurückgesetzt")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: Fehler beim Zurücksetzen SelectedValues: {ex.Message}")
End Try
' Finale SelectedValues setzen
If oNewValues IsNot Nothing Then
oLookup.Properties.SelectedValues = oNewValues
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: SelectedValues FINAL gesetzt = [{String.Join(",", oNewValues)}]")
Else
MyValidationLogger.Debug($"[FillIndexValues BUGFIX] Lookup [{oLookupMeta.Name}]: oNewValues ist Nothing, SelectedValues bleiben leer")
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Info(" - Unvorhergesehener Unexpected error in FillIndexValues LookupControl3 - Indexname: " & oIndexName & " - Fehler: " & vbNewLine & ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Add LookupControl3:")
End Try
Case oControl.GetType = GetType(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
MyValidationLogger.Debug("DATE über PM-Vektor holen")
oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName)
MyValidationLogger.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)
MyValidationLogger.Debug("DATE konnte umgewandelt werden")
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Debug("DATE wurde auf heute gesetzt")
End Try
DTP.Text = tempdate
Else
MyValidationLogger.Debug("DATE ist leer")
DTP.Text = tempdate
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
errormessage = "Unvorhergesehener Fehler bei DTP: " & vbNewLine & ex.Message
MyValidationLogger.Info("Unexpected error in FillIndex DTP: " & ex.Message & vbNewLine & "Wert WD: " & oValueFromSource.ToString & vbNewLine & "Indexname: " & oSourceIndexName, True)
frmError.ShowDialog()
MyValidationLogger.Info("Unexpected error in FillIndex DTP: " & ex.Message, True)
End Try
End If
End Select
oCount += 1
Next
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach Control-Schleife: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Focus_FirstControl()
' ========== OPTIMIERUNG 8: Grid-Dropdown-Columns nur EINMAL am Ende ==========
' VORHER: Wurde potenziell mehrfach aufgerufen
' NACHHER: Nur einmal nach allen Control-Updates
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)
' ========== OPTIMIERUNG 9: Control-Suche mit Dictionary ==========
' VORHER: Für jede Row wurde über alle Controls geloopt
' NACHHER: Dictionary-Lookup
For Each oRow As DataRow In oDataTable.Rows
Dim oDEPENDING_CTRL_ID = CInt(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 = GetCachedDatatable(oSqlCommand, oCONNID)
If Not IsNothing(oDTRESULT_FOR_COLUMN) Then
MyValidationLogger.Debug($"Trying to create a DropDown(FIV) for CONTROL-ID [{oDEPENDING_CTRL_ID}] - RowCount: [{oDTRESULT_FOR_COLUMN.Rows.Count}] ")
' Dictionary-Lookup statt Loop
Dim oControl As Control = Nothing
If _CachedControlsByGuid.TryGetValue(oDEPENDING_CTRL_ID, oControl) Then
ControlCreator.GridTables_CacheDatatableForColumn(oDEPENDING_CTRL_ID, oDEPENDING_COLUMN, oSqlCommand, oCONNID, oAdvancedLookup)
Else
MyValidationLogger.Warn($"⚠️ Control mit ID {oDEPENDING_CTRL_ID} nicht gefunden!")
End If
Else
MyValidationLogger.Warn($"⚠️ FillIndexValues - oDTRESULT_FOR_COLUMN is nothing!")
End If
Catch ex As Exception
MyValidationLogger.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
MyValidationLogger.Warn($"⚠️ FillIndexValues - Unexpected error in creating dropdown for Grid: " & ex.Message)
End Try
' ========== ENDE OPTIMIERUNG 8+9 ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach Grid-Dropdown-Loop: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If LOG_PERF Then PerformanceLogger.Info("FillIndexValues/Postload")
' IDB PM_Info Setup (bleibt gleich)
If IDB_ACTIVE = True Then
Try
Dim oSQL = $"select Attribut, TERM_VALUE from VWIDB_VALUE_TEXT WHERE LANG_CODE IN ('{USER_LANGUAGE}','UNQID') AND IDB_OBJ_ID = {CURRENT_DOC_ID} AND Attribut in ('PM_Info1','PM_Info2') ORDER BY Attribut"
Dim oDTINFO As DataTable = DatabaseFallback.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 = BarItemVisibility.Never
ElseIf oDTINFO.Rows.Count = 2 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
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 = BarItemVisibility.Always
End If
RibbonPageGroup2.Visible = True
Else
MyValidationLogger.Debug($"No PM_Info-Configuration!!")
RibbonPageGroup2.Visible = False
End If
Else
MyValidationLogger.Warn($"⚠️ oDTINFO is nothing!!")
RibbonPageGroup2.Visible = False
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Setting PMINFO - ERROR: {ex.Message}")
RibbonPageGroup2.Visible = False
End Try
Else
RibbonPageGroup2.Visible = False
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach PM_Info-Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
_Indexe_Loaded = True
Load_Additional_Searches(Not CONFIG.Config.ADDITIONAL_SEARCHES_LOAD_ONCLICK)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach Load_Additional_Searches: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If CONFIG.Config.ADDITIONAL_SEARCHES_LOAD_ONCLICK = False And (AdditionalDocResultsExist = True Or AdditionalDataResultsExist = True) Then
TryOpen_Additional_Searches()
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF FillIndexValues] Nach TryOpen_Additional_Searches: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Else
MsgBox("No Form-Mask defined for this profile!" & vbNewLine & "Please inform Your admin!" & vbNewLine & "The validator will be closed!", MsgBoxStyle.Exclamation, "Attention:")
Me.Close()
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in FillIndexValues: [{oControName} -TYPE: {oControlType}-INDEXNAME: {oIndexName}] ERROR: {ex.Message}")
errormessage = $"Unexpected error in FillIndexValues: [{oControName} -TYPE: {oControlType}-INDEXNAME: {oIndexName}] ERROR: {ex.Message}" & vbNewLine & "Check Logfile"
My.Settings.Save()
frmError.ShowDialog()
Finally
_suppressLookupEvents = False ' ← NEU: Events wieder freigeben
' KRITISCH: Erst HIER wird das Panel neu gezeichnet → nur EINMAL statt tausende Male
PanelValidatorControl.ResumeLayout()
' ========== ENDE OPTIMIERUNG 10 ==========
' ========== OPTIMIERUNG 11: GridTables nur EINMAL am Ende ==========
' VORHER: War im TextBox-Case drin → wurde für jede TextBox aufgerufen
' NACHHER: Nur noch EINMAL am Ende → massive Zeitersparnis
Try
ControlCreator.GridTables_HandleControlValueChange(PanelValidatorControl, DT_COLUMNS_GRID_WITH_SQL_WITH_CTRL_PLACEHOLDER)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ GridTables_HandleControlValueChange Fehler: {ex.Message}")
End Try
' ========== ENDE OPTIMIERUNG 11 ==========
If LOG_HOTSPOTS Then
Dim totalMs = (DateTime.Now - perfStart).TotalMilliseconds
If totalMs > 6000 Then
MyValidationLogger.Warn($"⚠️ [PERF FillIndexValues] ⚠️ GESAMT LANGSAM: {totalMs}ms (Schwellwert: 6000ms)")
Else
MyValidationLogger.Info($"[PERF FillIndexValues] GESAMT: {totalMs}ms")
End If
End If
End Try
End Sub
Private Sub ApplyCurrencyMask(pTextEdit As TextEdit)
If pTextEdit Is Nothing Then Return
Try
' Kultur auf Basis der aktuellen UI, aber Währungssymbol aus DocCurrency setzen
Dim culture As New CultureInfo("de-DE")
' Wenn DocCurrency leer/fehlerhaft ist, fallback auf EUR
Dim currencySymbol As String = If(String.IsNullOrWhiteSpace(DocCurrency) OrElse DocCurrency.Length <> 3, "EUR", DocCurrency)
' DevExpress Numeric-Mask "c" mit angepasster Kultur
pTextEdit.Properties.MaskSettings.Configure(Of MaskSettings.Numeric)(
Sub(settings)
settings.MaskExpression = "c"
settings.Culture = DirectCast(culture.Clone(), CultureInfo)
settings.Culture.NumberFormat.CurrencySymbol = currencySymbol
End Sub)
pTextEdit.Properties.UseMaskAsDisplayFormat = True
Catch ex As Exception
MyValidationLogger.Warn(String.Format("Unexpected error while applying CurrencyMaskfor pTextEdit: [{0} - ERROR: {1}", pTextEdit.Name, ex.Message))
End Try
End Sub
Private Sub frmValidation_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown
Dim oHandle = SplashScreenManager.ShowOverlayForm(Me)
Dim perfStart As DateTime = DateTime.MinValue
Dim perfLastCheck As DateTime = DateTime.MinValue
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
perfLastCheck = perfStart
MyValidationLogger.Info("[PERF] frmValidation_Shown START")
End If
Try
' Refresh_FileList()
Load_Next_Document(True)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] frmValidation_Shown nach Load_Next_Document: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
_DependingControl_In_Action = False
_DependingColumn_In_Action = False
' 18.10.2021: Brauchen Sie das Überhaupt??
'Controls2beDisabled()
BringToFront()
If bbtniRefreshSearches.Visibility = 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
RibbonPageGroupCustom.Text = RibbonPageCustTitle
RibbonPageGroupCustom.Visible = True
Else
RibbonPageGroupCustom.Visible = False
End If
If Not (IsNothing(WMDocPathWindows) And ActiveWorkflowType = ConstAHWorkflow_BlindFile) Then
If ButtonExport2Folder_Caption <> "" And WMDocPathWindows <> "" Then
MyValidationLogger.Debug("Enabling Export2File, Caption set")
MyValidationLogger.Debug("Button Caption: [{0}]", ButtonExport2Folder_Caption)
MyValidationLogger.Debug("Export root folder: [{0}]", ButtonExport2Folder_RootFolder)
If File.Exists(WMDocPathWindows) Then
MyValidationLogger.Debug("File exists, Showing Export Button")
barbtnitmExport.Caption = ButtonExport2Folder_Caption
If ButtonExport2Folder_Mode <> String.Empty Then
barbtnitmExport.Tag = ButtonExport2Folder_Mode
End If
barbtnitmExport.Visibility = BarItemVisibility.Always
Try
If ButtonExport2Folder_RootFolder <> "" Then
If Directory.Exists(ButtonExport2Folder_RootFolder) Then
If CONFIG.Config.LastExportPath <> String.Empty Then
MyValidationLogger.Debug("Last export path exists, using as default path")
FolderBrowserDialog1.SelectedPath = CONFIG.Config.LastExportPath
Else
FolderBrowserDialog1.SelectedPath = ButtonExport2Folder_RootFolder
End If
MyValidationLogger.Debug("Setting default export path to [{0}]", FolderBrowserDialog1.SelectedPath)
Else
MyValidationLogger.Warn($"⚠️ ### Dis/Enabale Export2Path - RootFolder {ButtonExport2Folder_RootFolder} not existing or accessible!###")
End If
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ ### Error Dis/Enabale Export2Path: {ex.Message} !###")
End Try
End If
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] frmValidation_Shown nach Ribbon/Export Setup: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
MyValidationLogger.Debug("frmValidation_Shown finished!")
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] frmValidation_Shown GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
Finally
SplashScreenManager.CloseOverlayForm(oHandle)
End Try
End Sub
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
' ========== FIX 1: Button-State-Management ==========
If btnSave.Enabled = False Then
MyValidationLogger.Warn("btnSave_Click: Button bereits disabled, Exit Sub")
Exit Sub
End If
btnSave.Enabled = False
' ========== ENDE FIX 1 ==========
' ========== FIX 2: Overlay-Handle global speichern ==========
_overlayHandle = SplashScreenManager.ShowOverlayForm(Me)
_overlayActive = True
' ========== ENDE FIX 2 ==========
Try
If ForceGridValidation() = True Then
Finish_WFStep()
End If
Finally
' ========== FIX 3: Overlay IMMER schließen ==========
_overlayActive = False
Try
SplashScreenManager.CloseOverlayForm(_overlayHandle)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [btnSave_Click] Overlay-Close failed: {ex.Message}")
End Try
_overlayHandle = Nothing
' ========== ENDE FIX 3 ==========
' ========== FIX 4: Button nur re-enablen wenn Form nicht schließt ==========
If Not _FormClosing AndAlso Not Me.IsDisposed Then
btnSave.Enabled = True
Else
MyValidationLogger.Debug("btnSave_Click: Form closing, Button bleibt disabled")
End If
' ========== ENDE FIX 4 ==========
End Try
End Sub
Private Function ForceGridValidation()
Dim perfStart As DateTime = If(LOG_HOTSPOTS, DateTime.Now, Nothing)
Dim perfLastCheck As DateTime = perfStart
If LOG_HOTSPOTS Then MyValidationLogger.Info("[PERF] ForceGridValidation START")
Dim oValidation As Boolean = True
Dim oGrids = (From oControl In PanelValidatorControl.Controls
Where TypeOf oControl Is GridControl
Select oControl).ToList()
MyValidationLogger.Debug("Forcing grid Validation")
For Each oGrid As GridControl In oGrids
MyValidationLogger.Debug("Validating Grid [{0}]", oGrid.Name)
Dim oView As GridView = oGrid.MainView
' WICHTIG: Leere Grids nicht überspringen,
' damit das Löschen gespeichert wird.
If oView.RowCount > 0 Then
If DoCellValidation(oView) = False Then
oValidation = False
End If
End If
MyValidationLogger.Debug("Validation of Grid [{0}] ended with Result: [{1}]", oGrid.Name, oValidation)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Grid {oGrid.Name}: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If oValidation = False Then
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] ForceGridValidation ABORT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
Return False
End If
Next
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] ForceGridValidation GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
Return True
End Function
Private Function DoCellValidation(pView As GridView) As Boolean
For i As Integer = 0 To pView.DataRowCount - 1
Dim oRowHandle = i
pView.FocusedRowHandle = oRowHandle
For Each oColumn As GridColumn In pView.Columns
pView.FocusedColumn = oColumn
If pView.PostEditor() = True Then
If pView.UpdateCurrentRow() = False Then
Return False
End If
Else
Return False
End If
Next
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 = DatabaseFallback.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
MyValidationLogger.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
MyValidationLogger.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
MyValidationLogger.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, "")
MyValidationLogger.Warn($"⚠️ No valid action provided [{oMsgType}] in btnFinishContinue!")
Return False
End Select
Catch ex As Exception
MyValidationLogger.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)
Dim oHandle As Object = Nothing
Dim overlayStartedHere As Boolean = False
If Not _overlayActive Then
oHandle = SplashScreenManager.ShowOverlayForm(Me)
_overlayActive = True
overlayStartedHere = True
End If
Dim perfStart As DateTime = DateTime.MinValue
Dim perfLastCheck As DateTime = DateTime.MinValue
If LOG_HOTSPOTS Then
perfStart = DateTime.Now
perfLastCheck = perfStart
MyValidationLogger.Info("[PERF] Finish_WFStep START")
End If
btnSave.Enabled = False
MyValidationLogger.Debug("Abschluss für DocID " & CURRENT_DOC_ID & " wird gestartet ...")
Dim oErrorOcurred As Boolean = False
If OverrideAll = False Then
If Check_UpdateIndexe() = True Then
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach Check_UpdateIndexe: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If PROFIL_FINISH_SQL <> String.Empty Then
If btnFinish_continue() = False Then
If overlayStartedHere Then
_overlayActive = False
SplashScreenManager.CloseOverlayForm(oHandle)
End If
Exit Sub
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach btnFinish_continue: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If includeFI = True Then
Try
Dim oDTFinalIndexing As DataTable = _CachedFinalIndexing
If oDTFinalIndexing?.Rows.Count > 0 Then
MyValidationLogger.Debug("FINAL INDEXING STARTING...")
For Each oFinalIndexRow As DataRow In oDTFinalIndexing.Rows
Dim oValue As String = oFinalIndexRow.Item("VALUE").ToString
Dim oDTResult As DataTable = Nothing
Dim oFinalIndex = oFinalIndexRow.Item("INDEXNAME")
MyValidationLogger.Debug($"Working on final index [{oFinalIndex}]...")
Dim oContinueOnIndifferentState As Boolean = CBool(oFinalIndexRow.Item("CONTINUE_INDETERMINED"))
Dim oIndexType = 0
If IDB_ACTIVE = False Then
oIndexType = WINDREAM_MOD.GetIndexType(oFinalIndexRow.Item("INDEXNAME"))
End If
If oValue.ToUpper = "SQL-Command".ToUpper Then
MyValidationLogger.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
End If
If Not IsNothing(oSQLCommand) Then
Dim oResultfromSQL As Object = DatabaseFallback.GetDatatable(oSQLCommand, oConnectionID)
If Not IsNothing(oResultfromSQL) Then
If TypeOf oResultfromSQL Is DataTable Then
oDTResult = oResultfromSQL
If oDTResult.Rows.Count > 1 Then
oResultfromSQL = oDTResult
MyValidationLogger.Debug($"oResultfromSQL from SQL is a datatable with [{oDTResult.Rows.Count.ToString}] rows!")
ElseIf oDTResult.Rows.Count = 1 Then
oResultfromSQL = oDTResult.Rows(0).Item(0)
oValue = oResultfromSQL
MyValidationLogger.Debug($"oResultfromSQL from SQL is exactly 1 value: {oResultfromSQL.ToString}")
Else
MyValidationLogger.Debug("oResultfromSQL from SQL is an empty DataTable")
oResultfromSQL = ""
oValue = oResultfromSQL
End If
Else
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
Else
MyValidationLogger.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
End If
Else
MyValidationLogger.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()
If Len(oValue) > 0 And oDTResult Is Nothing Then
ReDim Preserve oResult(0)
oResult(0) = oValue
ElseIf oDTResult IsNot Nothing Then
ReDim Preserve oResult(oDTResult.Rows.Count - 1)
Dim i As Integer = 0
For Each oRow As DataRow In oDTResult.Rows
oResult(i) = oRow.Item(0).ToString
i += 1
Next
End If
MyValidationLogger.Debug($"oIndexType {oIndexType.ToString}")
MyValidationLogger.Debug("Now the final indexing...")
If oIndexType > 4000 And oIndexType < 5000 Then
MyValidationLogger.Debug("...via WMIndexVectofield as its an Vektorfield")
If WMIndexVectofield(oResult, oFinalIndexRow.Item("INDEXNAME"), oFinalIndexRow.Item("PREVENT_DUPLICATES"), oFinalIndexRow.Item("ALLOW_NEW_VALUES")) = False Then
MyValidationLogger.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
End If
Else
MyValidationLogger.Debug("...as single 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)
MyValidationLogger.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
MyValidationLogger.Debug("FINALER INDEX '" & oFinalIndexRow.Item("INDEXNAME") & "' WURDE ERFOLGREICH GESETZT")
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
MyValidationLogger.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
End If
End If
If oErrorOcurred = True Then
Exit For
End If
Next
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Error in finalIndexing: {ex.Message}")
oErrorOcurred = True
End Try
End If
If LOG_HOTSPOTS AndAlso includeFI Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach FinalIndexing: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Try
If Override = True And Override_SQLCommand <> "" Then
DatabaseFallback.ExecuteNonQueryECM(Override_SQLCommand)
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach Override-SQL: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
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
MyValidationLogger.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}"
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(WORK_HISTORY_ENTRY)
For Each element As System.Text.RegularExpressions.Match In elemente
Try
MyValidationLogger.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
Select Case True
Case oControl.GetType() = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType() = GetType(MemoEdit)
Try
Dim oBaseEdit As BaseEdit = oControl
value_from_control = oBaseEdit.EditValue
Catch ex As Exception
MyValidationLogger.Error(ex)
value_from_control = String.Empty
End Try
Case oControl.GetType() = GetType(System.Windows.Forms.ComboBox)
Dim cmb As Windows.Forms.ComboBox = oControl
Try
value_from_control = cmb.Text
Catch ex As Exception
MyValidationLogger.Error(ex)
value_from_control = String.Empty
End Try
Case oControl.GetType() = GetType(System.Windows.Forms.DateTimePicker)
Dim dtp As DateTimePicker = oControl
Try
value_from_control = dtp.Value.ToString
Catch ex As Exception
MyValidationLogger.Error(ex)
value_from_control = String.Empty
End Try
Case oControl.GetType() = GetType(System.Windows.Forms.CheckBox)
Dim chk As CheckBox = oControl
Try
value_from_control = chk.Checked
Catch ex As Exception
MyValidationLogger.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
MyValidationLogger.Error(ex)
MyValidationLogger.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
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach WORK_HISTORY: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
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, System.Environment.MachineName, WORK_HISTORY_ENTRY)
DatabaseFallback.ExecuteNonQueryECM(ins)
Dim oFIsql As String
If Not IsNothing(Current_Document) Then
If Current_Document.Extension = "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 = DatabaseFallback.GetDatatableECM(oFIsql)
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 = DatabaseFallback.GetDatatableECM(oFIsql)
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
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach Annotation: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
If Move2Folder <> "" And (OPERATION_MODE_FS = ClassConstants.OpModeFS_PWM Or OPERATION_MODE_FS = ClassConstants.OpModeFS_IDBWM) 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
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach Move2Folder: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
errormessage = "Unexpected error in Finish:" & ex.Message
My.Settings.Save()
frmError.ShowDialog()
oErrorOcurred = True
MyValidationLogger.Info("Unexpected error in Finish: " & ex.Message, True)
If overlayStartedHere Then
_overlayActive = False
SplashScreenManager.CloseOverlayForm(oHandle)
End If
Exit Sub
End Try
Else
errormessage = oErrMsgMissingInput
MyValidationLogger.Warn($"⚠️ [Finish_WFStep] Validierung fehlgeschlagen → OpenfrmError")
OpenfrmError(oErrMsgMissingInput) ' ← Statt: frmError.ShowDialog()
oErrorOcurred = True
' ========== FIX: Overlay schließen NACH Dialog ==========
If overlayStartedHere Then
_overlayActive = False
Try
SplashScreenManager.CloseOverlayForm(_overlayHandle)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [Finish_WFStep] Overlay-Close failed: {ex.Message}")
End Try
_overlayHandle = Nothing
End If
' ========== ENDE FIX ==========
Exit Sub
End If
Else
MyValidationLogger.Info($"Overriding all in action for DocID: {CURRENT_DOC_ID} - ProfileID: {CURRENT_ProfilGUID}")
If Override_SQLCommand <> "" Then
If DatabaseFallback.ExecuteNonQueryECM(Override_SQLCommand) = False Then
oErrorOcurred = True
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach OverrideAll-SQL: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
OverrideAll = False
' Overlay wird weiter unten geschlossen (vor Load_Next_Document bzw. BeginInvoke)
End If
If oErrorOcurred = True Then
MsgBox("Unhandled error occured in Finish Workflow-Step...Please check your log!", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE)
Else
PRTF_PROFILE_FILES_WORK("Worked")
MyValidationLogger.Debug("Validation of document ended successfully!")
Dim oPROCSQL = $"EXEC PRPM_CHECK_NEXT_WF {CURRENT_DOC_GUID}"
If DatabaseFallback.ExecuteNonQueryECM(oPROCSQL) = False Then
MyValidationLogger.Warn($"⚠️ Attention: Error executing proc [{oPROCSQL}]")
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach PRPM_CHECK_NEXT_WF: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
End If
If CURRENT_JUMP_DOC_GUID <> 0 Then
CURRENT_DOC_GUID = 0
MyValidationLogger.Info($"[Finish_WFStep] CURRENT_JUMP_DOC_GUID <> 0 → verzögertes Close()")
If overlayStartedHere Then
_overlayActive = False
SplashScreenManager.CloseOverlayForm(oHandle)
End If
BeginInvoke(New Action(Sub()
If Not Me.IsDisposed Then
MyValidationLogger.Debug("[BeginInvoke] Führe Me.Close() aus")
Me.Close()
Else
MyValidationLogger.Warn("[BeginInvoke] Form bereits disposed, Close() übersprungen")
End If
End Sub))
Exit Sub
Else
Load_Next_Document(False)
If overlayStartedHere Then
_overlayActive = False
SplashScreenManager.CloseOverlayForm(oHandle)
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep nach Load_Next_Document: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
Focus_FirstControl()
End If
' ========== FIX: Overlay schließen am Ende ==========
If overlayStartedHere Then
_overlayActive = False
Try
SplashScreenManager.CloseOverlayForm(_overlayHandle)
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ [Finish_WFStep] Overlay-Close failed: {ex.Message}")
End Try
_overlayHandle = Nothing
End If
' ========== ENDE FIX ==========
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Finish_WFStep GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
End If
End Sub
Sub Focus_FirstControl()
If first_control Is Nothing = False Then
Dim otype = first_control.GetType
first_control.Focus()
End If
End Sub
Function Check_Missing_Control_Value(control As Control, typ As String) As Boolean
Select Case typ
Case "txt"
Dim oTextBox As BaseEdit = control
If IsNothing(oTextBox.EditValue) Then
Return True
End If
If oTextBox.EditValue.ToString = String.Empty Then
Return True
End If
End Select
Return False
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
MyValidationLogger.Error(ex)
MyValidationLogger.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
MyValidationLogger.Error(ex)
MyValidationLogger.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(pValues As Object, 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
If TypeOf pValues Is DataTable Then
MyValidationLogger.Debug("WMIndexVectofield - pValues is Datatable ...")
Dim i As Integer = 0
For Each oRow As DataRow In pValues.Rows
oValueList.Add(oRow.Item(0).ToString)
i += 1
Next
ElseIf TypeOf pValues Is String() Then
MyValidationLogger.Debug("WMIndexVectofield - pValues is String() ...")
For Each oStr As String In DirectCast(pValues, String())
oValueList.Add(oStr)
Next
Else
MyValidationLogger.Debug("WMIndexVectofield - pValues is Single String ...")
' Add the new value
oValueList.Add(pValues)
End If
Else
If TypeOf pValues Is DataTable Then
MyValidationLogger.Debug("WMIndexVectofield (2) - pValues is DataTable ...")
Dim i As Integer = 0
For Each oRow As DataRow In pValues.Rows
oValueList.Add(oRow.Item(0).ToString)
i += 1
Next
ElseIf TypeOf pValues Is String() Then
MyValidationLogger.Debug("WMIndexVectofield (2) - pValues is String() ...")
For Each oStr As String In DirectCast(pValues, String())
oValueList.Add(oStr)
Next
Else
MyValidationLogger.Debug("WMIndexVectofield (2) - pValues is Single String ...")
' Just add input as the only value
oValueList.Add(pValues)
End If
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
MyValidationLogger.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
' ========== BATCH: Sammelmodus starten (nur IDB) ==========
If IDB_ACTIVE Then
IDBData.BeginBatch()
End If
' ========== ENDE BATCH START ==========
' ========== OPTIMIERUNG: Nur geänderte Controls durchlaufen ==========
For Each oControl As Control In Me.PanelValidatorControl.Controls
Dim oMeta As ClassControlCreator.ControlMetadata = Nothing
Try
oMeta = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata)
Catch
Continue For ' Control ohne Metadata überspringen
End Try
MyValidationLogger.Debug($"[CHECK_UPDATE] Control: [{oMeta.Name}], Type: [{oControl.GetType().Name}], IsDirty: [{oMeta.IsDirty}]")
' Suche die Control-Definition
Dim oControlRow = (From form In DTVWCONTROL_INDEX.AsEnumerable()
Where form.Item("GUID") = oMeta.Guid).SingleOrDefault()
If oControlRow Is Nothing Then Continue For
Dim oCtrlType = oControlRow.Item("CTRL_TYPE").ToString
Dim oIndexName As String = oControlRow.Item("INDEX_NAME")
Dim oIsRequired As Boolean = CBool(oControlRow.Item("VALIDATION"))
Dim oIsReadOnly As Boolean = CBool(oControlRow.Item("READ_ONLY"))
Dim oSaveChangeEnabledFalse As Boolean = CBool(oControlRow.Item("SAVE_CHANGE_ON_ENABLED"))
' Überspringe System-Controls
If oCtrlType = "LBL" Or oCtrlType = "LINE" Or oCtrlType = "BUTTON" Then
Continue For
End If
If oIndexName = "@@DISPLAY_ONLY" Then
Continue For
End If
' Überspringe ReadOnly-Controls (außer SAVE_CHANGE_ON_ENABLED)
If oIsReadOnly = True And oSaveChangeEnabledFalse = False Then
MyValidationLogger.Debug($"Skipping ReadOnly ControlName [{oControl.Name}]!")
Continue For
End If
' ========== KERN-OPTIMIERUNG: Dirty-Check ==========
' Überspringe unveränderte, nicht-required Controls
If Not oMeta.IsDirty And Not oIsRequired Then
MyValidationLogger.Debug($"Skipping unchanged control [{oMeta.Name}]")
Continue For
End If
' ========== ENDE OPTIMIERUNG ==========
' Rejection-Handling
If REJECTION_ACTIVE = True And (oIndexName = PROFIL_REJECT_ACTIONS_ATTRIBUTE Or oIndexName = PROFIL_REJECT_COMMENT_ATTRIBUTE) Then
MyValidationLogger.Debug($"Index [{oIndexName}] will be skipped as Rejection is in progress!")
Continue For
End If
' ========== AB HIER: Bestehender Validierungs-Code ==========
Dim oMyInput As String = ""
Dim oSQLCheckCommand As String = IIf(IsDBNull(oControlRow.Item("SQL_UEBERPRUEFUNG")), "", oControlRow.Item("SQL_UEBERPRUEFUNG"))
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 = ObjectEx.NotNull(oControlRow.Item("REGEX_MATCH"), String.Empty)
Dim oRegexMessage As String = ObjectEx.NotNull(oControlRow.Item("REGEX_MESSAGE_DE"), String.Empty)
oControlName = oControlRow.Item("CTRL_NAME")
Dim oOVERWRITE_DATA = oControlRow.Item("OVERWRITE_DATA")
MyValidationLogger.Debug("Indexierung für Control (" & oControlId & ") '" & oControlName & "' gestartet. Indexname '" & oIndexName & "'")
If oIndexName = "" Then
MyValidationLogger.Info(">> Indexname is unexpected empty.")
Continue For
End If
' ========== SELECT CASE: Control-Type-Handling (wie bisher) ==========
Select Case True
Case oControl.GetType = GetType(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}'"
MyValidationLogger.Warn($"⚠️ Kein Auswahl getroffen in LookupGrid '{oControl.Name}'")
oControl.BackColor = Color.Red
frmError.ShowDialog()
Exit For
Else
If lookup.Properties.MultiSelect = True Then
Dim oLookupRows As Integer = lookup.Properties.SelectedValues.Count
If oLookupRows > 0 Then
Dim ZeilenGrid As Integer = 0
Dim myVektorArr As String()
For Each value As String In lookup.Properties.SelectedValues
If value Is Nothing = False Then
ReDim Preserve myVektorArr(ZeilenGrid)
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
MyValidationLogger.Warn($"⚠️ Error while indexing [{oIndexName}] von LookupGrid - ERROR: " & idxerr_message)
frmError.ShowDialog()
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"
MyValidationLogger.Warn($"⚠️ Error while indexing IDB-Object LookupGrid [{oIndexName}] ")
frmError.ShowDialog()
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
MyValidationLogger.Warn($"⚠️ Error while indexing LookupGrid [{oIndexName}] ")
frmError.ShowDialog()
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
' Single-Select Lookup
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}"
MyValidationLogger.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
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
MyValidationLogger.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
MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is NOTHING!")
oValueIsIndifferent = True
End If
If oValueIsIndifferent = False Then
If IsDBNull(oValueFromObject) Then
MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is DBNULL!")
oValueIsIndifferent = True
End If
End If
Dim oValueSourceIsDifferent As Boolean = False
If oValueIsIndifferent = False Then
MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: oValueFromObject is [{oValueFromObject}]")
Try
If oValueFromObject <> oMyInput Then
oValueSourceIsDifferent = True
MyValidationLogger.Debug($"CheckUpdateIndex.LookUpGrid: There is a difference between oValueFromObject and [{oValueFromObject}]")
End If
Catch ex As Exception
oValueSourceIsDifferent = True
MyValidationLogger.Debug($"oValueFromObject <> oMyInput not possible as one object might be a multiple row object")
End Try
End If
If (oValueIsIndifferent = True Or oValueSourceIsDifferent = True) Then
If oIndexName.StartsWith("[%VKT") Then
oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName)
If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrMsgMissingInput = "Error while indexing Textbox as VEKTOR - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
frmError.ShowDialog()
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
MyValidationLogger.Warn(oErrMsgMissingInput)
frmError.ShowDialog()
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)
End If
End If
End If
End If
End If
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
Case oControl.GetType = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType = GetType(MemoEdit)
Try
Dim oWrongInputMessage = Translation_Strings.Falsche_Eingabe
Dim oDevexpressTextEdit As DevExpress.XtraEditors.TextEdit = oControl
MyValidationLogger.Debug("Validating Textbox..")
If oRegexMatch <> String.Empty AndAlso Not Regex.IsMatch(oDevexpressTextEdit.EditValue, oRegexMatch) Then
oMissing = True
oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
If oRegexMessage <> String.Empty Then
oErrMsgMissingInput &= ":" & vbCrLf & oRegexMessage
End If
oControl.BackColor = Color.Red
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
If Check_Missing_Control_Value(oControl, "txt") = True And oIsRequired = True Then
oMissing = True
oErrMsgMissingInput = oWrongInputMessage & " textbox '" & oControl.Name & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
oControl.BackColor = Color.Red
frmError.ShowDialog()
Exit For
Else
MyValidationLogger.Debug("Reading current value from Textbox")
Dim oTextEdit As BaseEdit = DirectCast(oControl, BaseEdit)
oMyInput = ClassFormat.GetStringValue(oTextEdit.EditValue)
MyValidationLogger.Debug("Form Value: [{0}]", oMyInput)
Dim oSourceValue = GetVariableValuefromSource(oIndexName, oIDBTyp)
MyValidationLogger.Debug("Current Value: [{0}]", oSourceValue)
If oIndexName.StartsWith("[%VKT") Then
oSourceValue = ReturnVektor_IndexValue(oIndexName)
Else
If Not IsNothing(oSourceValue) Then
If oSourceValue.ToString = "System.Object[]" Then
If oSourceValue.Length = 1 Then
oSourceValue = oSourceValue(0)
Else
MyValidationLogger.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
MyValidationLogger.Debug("Preparing Indexing for Textbox")
If oSetValue = True Then
If oIndexName.StartsWith("[%VKT") Then
oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName)
If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} as VEKTOR - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
Else
If IDB_ACTIVE = False Then
Dim result() As String
ReDim Preserve result(0)
result(0) = oMyInput
MyValidationLogger.Debug("Indexing Index [{0}] with value [{1}]", oMyInput, oIndexName)
If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then
oMissing = True
oErrMsgMissingInput = $"Error while indexing Textbox {oControl} - Attribute {oIndexName} - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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)
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"
MyValidationLogger.Error(ex)
Dim st As New StackTrace(True)
st = New StackTrace(ex, True)
MyValidationLogger.Warn("⚠️ Unexpected error in Check_UpdateIndexe TextBox :" & ex.Message, True)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
' Nach Fehler: Dirty-Flag zurücksetzen
oMeta.IsDirty = False
Return False
End Try
Case oControl.GetType = GetType(System.Windows.Forms.ComboBox)
' ... (Dein bestehender ComboBox-Code bleibt gleich) ...
Try
MyValidationLogger.Debug($"Working on Combobox...")
Dim cmb As Windows.Forms.ComboBox = oControl
If cmb.SelectedIndex = -1 And oIsRequired = True Then
oMissing = True
oErrMsgMissingInput = "Please Choose an entry out of ComboBox '" & cmb.Name & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
Else
oMyInput = cmb.Text
MyValidationLogger.Debug($"inputvalue Combobox: {cmb.Text}")
Dim oValue
If oIndexName.StartsWith("[%VKT") Then
oValue = ReturnVektor_IndexValue(oIndexName)
Else
oValue = GetVariableValuefromSource(oIndexName, oIDBTyp)
End If
If IsNothing(oValue) Then
MyValidationLogger.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
MyValidationLogger.Debug($"Exception while oValue.ToString = System.Object[]...")
End Try
If oIndexType = "Vector" Then
MyValidationLogger.Debug($"Control with ID{oControlId} is a vectorfield...")
If oValue.Length = 1 Then
oValue = oValue(0).ToString
Else
MyValidationLogger.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used")
oValue = oValue(0).ToString
End If
Else
MyValidationLogger.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
MyValidationLogger.Warn($"⚠️ Could not convert the oValue of Control with ID{oControlId}...")
MyValidationLogger.Error(ex.Message)
oitsadifference = True
End Try
If oitsadifference = True Then
MyValidationLogger.Debug($"Index with ID{oControlId} will now be indexed...")
If oIndexName.StartsWith("[%VKT") Then
oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName)
If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrMsgMissingInput = "Error while indexing Combobox as VEKTOR - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
Else
If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then
cmb.DroppedDown = True
oMissing = True
oErrMsgMissingInput = "Error indexing combobox idb"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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)
End If
End If
End If
Else
MyValidationLogger.Debug($"oitsadifference = False...Index with ID {oControlId} will not be indexed...")
End If
End If
End If
Catch ex As Exception
MyValidationLogger.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:")
MyValidationLogger.Info($"Unexpected error in Check_UpdateIndexe Combobox : ID{oControlId}" & ex.Message)
oMeta.IsDirty = False
Return False
End Try
Case oControl.GetType = GetType(DateTimePicker)
' ... (Dein bestehender DateTimePicker-Code) ...
Try
Dim dtp As DateTimePicker = oControl
If oIsRequired = True And dtp.Value.ToString = String.Empty Then
oMissing = True
oErrMsgMissingInput = "Please Choose DateValue for field'" & dtp.Name & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then
oMyInput = CDate(dtp.Value)
Dim oObjectValue
If oIndexName.StartsWith("[%VKT") Then
oObjectValue = ReturnVektor_IndexValue(oIndexName)
Else
oObjectValue = GetVariableValuefromSource(oIndexName, oIDBTyp)
End If
If IsNothing(oObjectValue) Or IsDBNull(oObjectValue) Then
oObjectValue = CDate("01.01.1900")
End If
If oObjectValue <> oMyInput Then
If oIndexName.StartsWith("[%VKT") Then
oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName)
If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrMsgMissingInput = "Error while indexing DatePicker as VEKTOR - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
Else
If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then
oMissing = True
oErrMsgMissingInput = "Error indexing datepicker idb"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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)
End If
End If
End If
Else
MyValidationLogger.Debug("Value WD ('" & oObjectValue.ToString & "') = Input-value ('" & oMyInput.ToString & "')")
End If
Else
MyValidationLogger.Debug("DateValue is 01.01.0001 00:00:00")
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
oMeta.IsDirty = False
End Try
Case oControl.GetType = GetType(CheckBox)
' ... (Dein bestehender CheckBox-Code) ...
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 & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
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
MyValidationLogger.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
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
oMyInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexName)
If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrMsgMissingInput = "Error while indexing Checkbox as VEKTOR - ERROR: " & idxerr_message
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
Else
If IDBData.SetVariableValue(oIndexName, chk.Checked.ToString) Then
oErrMsgMissingInput = "error indexing checkbox idb"
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
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)
End If
End If
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
oMeta.IsDirty = False
End Try
Case oControl.GetType = GetType(DataGridView)
' ... (Dein bestehender DataGridView-Code) ...
Try
Dim dgv As DataGridView = oControl
Dim Zeilen As Integer = 0
For Each row As DataGridViewRow In dgv.Rows
Dim exists = False
If row.Cells(0).Value Is Nothing = False Then
Zeilen += 1
End If
Next
If oIsRequired = True And Zeilen = 0 Then
oMissing = True
oErrMsgMissingInput = "Fehlende Eingabe in Vektorfeld '" & dgv.Name & "'"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
ElseIf Zeilen > 0 Then
Dim ZeilenGrid As Integer = 0
Dim myVektorArr As String()
For Each row As DataGridViewRow In dgv.Rows
Dim exists = False
Select Case oControlType
Case "TABLE"
Dim str As String
If row.Cells(0).Value Is Nothing = False Then
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
myVektorArr(ZeilenGrid) = str
ZeilenGrid += 1
End If
Case Else
If row.Cells(0).Value Is Nothing = False Then
ReDim Preserve myVektorArr(ZeilenGrid)
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
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(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"
MyValidationLogger.Warn(oErrMsgMissingInput)
' Vor ShowDialog prüfen
If _FormClosing Then
MyValidationLogger.Warn("Form closing - skip error dialog")
Return False
End If
OpenfrmError(oErrMsgMissingInput)
Exit For
End If
End If
End If
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
oMeta.IsDirty = False
End Try
Case oControl.GetType = GetType(GridControl)
Dim oGrid As GridControl = oControl
MyValidationLogger.Debug($"[4] GridControl-Case erreicht: [{oGrid.Name}]")
' ========== NEU: Cleanup VOR Validierung ==========
CleanupDeletedRows(oGrid)
' ========== ENDE NEU ==========
Dim oSettings = New ControlSettings() With {
.IndexName = oIndexName,
.ControlType = GetType(GridControl).ToString,
.Name = oControlName,
.IsRequired = oIsRequired,
.IDBAttributeType = oIDBTyp
}
Dim oGridColumnDefinition As DataTable = DT_COLUMNS_GRID.Clone()
Dim oExpression = $"CONTROL_ID = {oControlRow.Item("GUID")}"
DT_COLUMNS_GRID.Select(oExpression, "SEQUENCE").CopyToDataTable(oGridColumnDefinition, LoadOption.PreserveChanges)
Dim oResult = ValidateGridControl(oGrid, oSettings, oGridColumnDefinition, oMissing, oErrMsgMissingInput)
If oResult = False Then
MyValidationLogger.Warn($"⚠️ Validierung fehlgeschlagen für Grid [{oGrid.Name}] → Exit For")
Exit For ' ← SOFORT stoppen, keinen zweiten Dialog!
End If
End Select
' ========== NEU: Dirty-Flag nach erfolgreicher Indexierung zurücksetzen ==========
oMeta.IsDirty = False
Next ' End For Each oControl
' ========== BATCH: Gesammelte Statements abfeuern ==========
If IDB_ACTIVE Then
If oMissing = False Then
If Not IDBData.CommitBatch() Then
LOGGER.Warn("CommitBatch failed in Check_UpdateIndexe")
oMissing = True
End If
Else
' Validierungsfehler → Batch verwerfen
IDBData.RollbackBatch()
End If
End If
' ========== ENDE BATCH ==========
If oMissing = True Then
MyValidationLogger.Warn("⚠️ Check_UpdateIndexe: ERROR or Missing Indexing - returning False")
Return False
Else
MyValidationLogger.Debug("Check_UpdateIndexe: Everything OK - returning True")
Return True
End If
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Check_UpdateIndexe - ControlID: {oControlId},{oControlName}")
MyValidationLogger.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:")
MyValidationLogger.Info("Unexpected error in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True)
Return False
End Try
End Function
Sub OpenfrmError(pErrormessage As String)
' ========== FIX: Verhindere mehrfache Dialoge ==========
If _isShowingErrorDialog Then
MyValidationLogger.Warn("⚠️ [OpenfrmError] Dialog bereits offen → Exit Sub")
Return
End If
_isShowingErrorDialog = True
' ========== ENDE FIX ==========
' ========== KRITISCH: Overlay NICHT hier schließen! ==========
' Das macht der Aufrufer (Finish_WFStep oder btnSave_Click)!
' ========== ENDE KRITISCH ==========
' 2. Events blockieren
_suppressLookupEvents = True
Try
Using ofrm As New frmError With {.ValidatorError = pErrormessage}
ofrm.ShowDialog(Me)
End Using
Finally
_suppressLookupEvents = False
' ========== FIX: Guard zurücksetzen ==========
_isShowingErrorDialog = False
' ========== ENDE FIX ==========
End Try
End Sub
Private Class ControlSettings
Public Name As String
Public IsRequired As Boolean
Public IndexName As String
Public ControlType As String
Public IDBAttributeType As Integer
End Class
Private Function ValidateGridControl(pGrid As GridControl, pSettings As ControlSettings, pColumnDefinition As DataTable, ByRef pMissing As Boolean, ByRef pMissingMessage As String) As Boolean
Try
Dim oRowCount As Integer = pGrid.DataSource.Rows.Count
MyValidationLogger.Debug("Grid Row Count: [{0}]", oRowCount)
'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss
If pSettings.IsRequired = True And oRowCount = 0 Then
pMissing = True
' ========== NEU: Liste der Required-Spalten sammeln ==========
Dim requiredColumns = pColumnDefinition.AsEnumerable().
Where(Function(row) row.ItemEx("VALIDATION", False) = True).
Select(Function(row) row.ItemEx("SPALTEN_HEADER_LANG", row.ItemEx("SPALTENNAME", "")).ToString()).
Where(Function(colName) Not String.IsNullOrWhiteSpace(colName)).
ToList()
If requiredColumns.Count > 0 Then
pMissingMessage = $"Missing input in table '{pGrid.Name}'. At least on row with following required fields necessary: {String.Join(", ", requiredColumns)}"
Else
pMissingMessage = $"Missing input in table '{pGrid.Name}' - at least one row necessary"
End If
' ========== ENDE NEU ==========
pGrid.BackColor = Color.Red
MyValidationLogger.Warn(pMissingMessage)
'Exit For
Return False
End If
If oRowCount > 0 Then
Dim oView As GridView = pGrid.FocusedView
Dim oDatasource As DataTable = pGrid.DataSource
Dim oRowIndex As Integer = 0
For Each oRow As DataRow In oDatasource.Rows
For Each oColumn As DataColumn In oRow.Table.Columns
Dim oValue = oRow.ItemEx(oColumn.ColumnName, "")
Dim oDefinition = pColumnDefinition.AsEnumerable().
Where(Function(row) row.Item("SPALTENNAME") = oColumn.ColumnName).
FirstOrDefault()
If oDefinition IsNot Nothing Then
Dim oIsRequired = oDefinition.Item("VALIDATION")
If oIsRequired = True And oValue = String.Empty Then
' Translates the visible row index into the internal rowhandle
' they might be different because of sorting
Dim oRowHandle = oView.GetRowHandle(oRowIndex)
oView.FocusedRowHandle = oRowHandle
oView.FocusedColumn = oView.Columns.Item(oColumn.ColumnName)
pMissing = True
pMissingMessage = $"Fehlende Eingabe in Tabelle '{pGrid.Name}' in Spalte '{oDefinition.Item("SPALTEN_HEADER_LANG")}', Zeile '{oRowHandle + 1}'"
MyValidationLogger.Warn(pMissingMessage)
Return False
End If
End If
Next
oRowIndex += 1
Next
Dim ZeilenGrid As Integer = 0
Dim myVektorArr As String()
'Jeden Werte des Datagridviews durchlaufen
For Each oRow As DataRow In pGrid.DataSource.Rows
' ========== NEU: Sicherheits-Guard für Deleted/Detached ==========
If oRow.RowState = DataRowState.Deleted OrElse oRow.RowState = DataRowState.Detached Then
MyValidationLogger.Debug($"Grid [{pSettings.Name}]: Überspringe Zeile mit RowState={oRow.RowState}")
Continue For
End If
' ========== ENDE NEU ==========
Dim exists = False
Select Case pSettings.ControlType
Case "DevExpress.XtraGrid.GridControl" '"TABLE"
Dim oRowValue = oRow.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 As Object In oRow.ItemArray
Dim normalized As Object = ObjectEx.NotNull(item, String.Empty)
If TypeOf normalized Is IFormattable AndAlso Not TypeOf normalized Is String Then
Dim provider As IFormatProvider =
If(TypeOf normalized Is Decimal OrElse
TypeOf normalized Is Double OrElse
TypeOf normalized Is Single,
CultureInfo.CurrentCulture,
CultureInfo.InvariantCulture)
MyValidationLogger.Debug("Normalizing value [{0}]", normalized.ToString)
normalized = DirectCast(normalized, IFormattable).ToString(Nothing, provider)
End If
oValueList.Add(normalized)
Next
str = String.Join(PMDelimiter, oValueList.ToArray)
' 22.10.2021 Attempt at fixing empty lines appearing in indexes
MyValidationLogger.Debug("Grid Value before saving: [{0}]", str)
If str.Trim.Length = 0 Or str.Trim.Replace(PMDelimiter, "").Length = 0 Then
MyValidationLogger.Debug("Empty line in Grid [{0}]. Skipping.", pSettings.Name)
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 oRow.Item(0) Is Nothing = False Then
'Das Array anpassen
ReDim Preserve myVektorArr(ZeilenGrid)
'Den Wert im Array speichern
myVektorArr(ZeilenGrid) = oRow.Item(0).Value.ToString
ZeilenGrid += 1
End If
End Select
Next
If IDB_ACTIVE = False Then
If Indexiere_File(CURRENT_WMFILE, pSettings.IndexName, myVektorArr) = False Then
pMissing = True
pMissingMessage = $"Error while indexing table (1) {pGrid.Name} - ERROR: " & idxerr_message
MyValidationLogger.Warn(pMissingMessage)
'Exit For
Return False
End If
Else
Dim oMyDT = DT_FOR_ARRAY(myVektorArr)
If oMyDT.Rows.Count > 0 Then
If IDBData.SetVariableValue(pSettings.IndexName, oMyDT, True, pSettings.IDBAttributeType) = False Then
pMissing = True
pMissingMessage = $"Error while indexing table IDB (1) {pGrid.Name} - ERROR: " & idxerr_message
MyValidationLogger.Warn(pMissingMessage)
'Exit For
Return False
End If
End If
End If
Else ' Row Count = 0
Dim oValue As New List(Of Object) From {String.Empty}
If IDB_ACTIVE = False Then
If Indexiere_File(CURRENT_WMFILE, pSettings.IndexName, oValue.ToArray) = False Then
pMissing = True
pMissingMessage = $"Error while indexing table (2) {pGrid.Name} - ERROR: " & idxerr_message
MyValidationLogger.Warn(pMissingMessage)
Return False
End If
Else
Dim oOldAttributeResult = IDBData.GetVariableValue(pSettings.IndexName, pSettings.IDBAttributeType)
Dim oTypeOldResult = oOldAttributeResult.GetType.ToString
If oTypeOldResult = "System.Data.DataTable" Then
Dim oDT As DataTable = IDBData.GetVariableValue(pSettings.IndexName, pSettings.IDBAttributeType)
If oDT.Rows.Count > 0 Then
MyValidationLogger.Debug("User cleared the grid, so data needs to be erased!")
IDBData.Delete_AttributeData(CURRENT_DOC_ID, pSettings.IndexName)
End If
Else
MyValidationLogger.Debug("(String) User cleared the grid, so data needs to be erased!")
IDBData.Delete_AttributeData(CURRENT_DOC_ID, pSettings.IndexName)
End If
End If
End If
Return True
Catch ex As Exception
MyValidationLogger.Error(ex)
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
MyValidationLogger.Debug("Indexing Index '" & pIndexName & "' with Arrayvalue")
For Each oValue In pIndexValues
Try
MyValidationLogger.Debug("Current Index Value for [{0}] is [{1}]", pIndexName, oValue)
Catch ex As Exception
MyValidationLogger.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
MyValidationLogger.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
MyValidationLogger.Error(ex)
idxerr_message = "Unexpected error in Indexiere_File: " & ex.Message.ToString
MyValidationLogger.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
Sub Datei_ueberspringen()
Dim oHandle = SplashScreenManager.ShowOverlayForm(Me)
Dim perfStart As DateTime = If(LOG_HOTSPOTS, DateTime.Now, Nothing)
Dim perfLastCheck As DateTime = perfStart
If LOG_HOTSPOTS Then
' ========== DIAGNOSE START ==========
MyValidationLogger.Info($"[INFO] Datei_ueberspringen START")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" CURRENT_DOC_GUID: {CURRENT_DOC_GUID}")
' ========== ENDE DIAGNOSE ==========
End If
If LOG_HOTSPOTS Then MyValidationLogger.Info("[PERF] Datei_ueberspringen START")
Try
MyValidationLogger.Debug("Skipping document....(Datei_ueberspringen)")
Dim oPRoc = String.Format("EXEC PRTF_PROFILE_FILES_WORK {0},{1},{2},{3}", CURRENT_DOC_ID, CURRENT_ProfilGUID, USER_ID, "FreeFile")
Dim oSQL = oPRoc & vbCrLf &
$"EXECUTE PRPM_FILES_NOT_INDEXED '{USER_USERNAME}',{CURRENT_ProfilGUID},'{WMDocPathWindows}',{CURRENT_DOC_GUID};"
If LOG_HOTSPOTS Then
' ========== DIAGNOSE: Vor DB-Execute ==========
MyValidationLogger.Info($"[INFO] Führe DB-UPDATE aus...")
MyValidationLogger.Info($" VOR DB: frmValidator.IsDisposed: {Me.IsDisposed}")
' ========== ENDE DIAGNOSE ==========
End If
DatabaseFallback.ExecuteNonQueryECM(oSQL)
If LOG_HOTSPOTS Then
MyValidationLogger.Info($" NACH DB: frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($"[PERF] Nach UPDATE+PRPM_FILES_NOT_INDEXED: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
End If
MyValidationLogger.Debug($"Skipped DocGUID {CURRENT_DOC_GUID}")
If LOG_HOTSPOTS Then
' ========== DIAGNOSE: Vor Load_Next_Document ==========
MyValidationLogger.Info($"[INFO] Rufe Load_Next_Document auf...")
MyValidationLogger.Info($" VOR: frmValidator.IsDisposed: {Me.IsDisposed}")
' ========== ENDE DIAGNOSE ==========
End If
Load_Next_Document(False)
If LOG_HOTSPOTS Then
' ========== DIAGNOSE: Nach Load_Next_Document ==========
MyValidationLogger.Info($" NACH: frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" NACH: frmValidator.Visible: {Me.Visible}")
' ========== ENDE DIAGNOSE ==========
MyValidationLogger.Info($"[PERF] Nach Load_Next_Document: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Fehler bei Überspringen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
Finally
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Datei_ueberspringen GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
' ========== DIAGNOSE ENDE ==========
MyValidationLogger.Info($"[INFO] Datei_ueberspringen ENDE")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
' ========== ENDE DIAGNOSE ==========
End If
SplashScreenManager.CloseOverlayForm(oHandle)
End Try
End Sub
Private Function PRTF_PROFILE_FILES_WORK(ByVal pMode As String) As Boolean
Try
Dim sql = $"EXEC PRTF_PROFILE_FILES_WORK {CURRENT_DOC_ID},{CURRENT_ProfilGUID},{USER_ID},'{pMode}'"
Return DatabaseFallback.ExecuteNonQueryECM(sql)
Catch ex As Exception
MyValidationLogger.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
If Not IsNothing(DocumentViewer1) Then
DocumentViewer1.CloseDocument()
DocumentViewer1.Done()
End If
Catch ex As Exception
MyValidationLogger.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 DatabaseFallback.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
MyValidationLogger.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()
MyValidationLogger.Debug("## Delete_WMFile WMFile unlocked! ##")
End If
Try
CURRENT_WMFILE.Delete()
MyValidationLogger.Info("Manual deleting of file [" & CURRENT_WMFILE.aName & "] successfull!")
Return True
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Could not delete via windream-function - ERROR: [{ex.Message}] {vbNewLine} Trying system.io...")
Try
Try
CURRENT_WMFILE.unlock()
Catch exul As Exception
MyValidationLogger.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)
MyValidationLogger.Info("Deleting of file via system.io [" & WMDocPathWindows & "] successfull!")
Return True
Catch ex1 As Exception
MyValidationLogger.Warn($"⚠️ Could not delete via System.IO - ERROR: [{ex1.Message}] {vbNewLine} Trying system.io...")
Return False
End Try
End Try
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Das windream-Objekt konnte nicht gelöscht werden!" & vbNewLine & vbNewLine & "Fehlermeldung:" & vbNewLine & ex.Message, MsgBoxStyle.Critical)
MyValidationLogger.Info(" windream-Objekt konnte nicht gelöscht werden - Fehlermeldung: " & ex.Message, True)
Return False
End Try
End If
Catch ex As Exception
MyValidationLogger.Error(ex)
MyValidationLogger.Info("Fehler bei Delete_File")
MyValidationLogger.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()
End If
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)
ToolTip1.Show(Translation_Strings.F2_für_Speichern, 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
Try
bsiInformation.ItemAppearance.Normal.BackColor = Color.FromName(pColor)
bsiInformation.ItemAppearance.Normal.ForeColor = GraphicsEx.GetContrastedColor(Color.FromName(pColor))
Catch ex As Exception
bsiInformation.ItemAppearance.Normal.BackColor = Color.Transparent
bsiInformation.ItemAppearance.Normal.ForeColor = Color.Black
End Try
Else
bsiInformation.ItemAppearance.Normal.BackColor = Color.Transparent
bsiInformation.ItemAppearance.Normal.ForeColor = Color.Black
End If
End Sub
Private Sub BarButtonItem3_ItemClick(sender As Object, e As ItemClickEventArgs) Handles BarButtonItem3.ItemClick
frmFileInfo.ShowDialog()
End Sub
Private Sub BarButtonItem4_ItemClick(sender As Object, e As 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 bbtniRefreshSearches_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtniRefreshSearches.ItemClick
TryOpen_Additional_Searches()
End Sub
Sub TryOpen_Additional_Searches()
Try
_frmValidatorSearch?.Close()
_frmValidatorSearch = New frmValidatorSearch(Me, Environment)
_frmValidatorSearch.Show()
Catch ex As Exception
MyValidationLogger.Error(ex)
End Try
Load_Additional_Searches(True)
End Sub
Private Sub bbtniRefresh_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtniRefresh.ItemClick
' ========== KRITISCH: Events KOMPLETT blockieren während Refresh ==========
_suppressLookupEvents = True
Dim oHandle = SplashScreenManager.ShowOverlayForm(Me)
Try
Reload_Controls("")
Try
btnSave.Text = Translation_Strings.Speichern___Nächster_Vorgang__F2_
Catch ex As Exception
End Try
listChangedLookup.Clear()
SetStatusLabel("All Data refreshed", "Yellow")
Finally
_suppressLookupEvents = False ' ← Erst NACH allem wieder freigeben
SplashScreenManager.CloseOverlayForm(oHandle)
End Try
End Sub
Private Sub bbtniNext_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtniNext.ItemClick
Cursor = Cursors.WaitCursor
Dim perfStart As DateTime = If(LOG_HOTSPOTS, DateTime.Now, Nothing)
Dim perfLastCheck As DateTime = perfStart
If LOG_HOTSPOTS Then
' ========== DIAGNOSE START ==========
MyValidationLogger.Info($"[START] bbtniNext_ItemClick START")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" frmValidator.Visible: {Me.Visible}")
MyValidationLogger.Info($" _FormClosing: {_FormClosing}")
' ========== ENDE DIAGNOSE ==========
MyValidationLogger.Info("[PERF] bbtniNext_ItemClick START")
End If
If ForceGridValidation() = True Then
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Nach ForceGridValidation: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
' ========== DIAGNOSE: Vor Reset_CurrentReferences ==========
MyValidationLogger.Info($"[START] Rufe Reset_CurrentReferences auf...")
MyValidationLogger.Info($" VOR: frmValidator.IsDisposed: {Me.IsDisposed}")
' ========== ENDE DIAGNOSE ==========
End If
Reset_CurrentReferences()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Nach Reset_CurrentReferences: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
perfLastCheck = DateTime.Now
' ========== DIAGNOSE: Nach Reset_CurrentReferences ==========
MyValidationLogger.Info($" NACH: frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" NACH: frmValidator.Visible: {Me.Visible}")
' ========== ENDE DIAGNOSE ==========
' ========== DIAGNOSE: Vor Datei_ueberspringen ==========
MyValidationLogger.Info($"[START] Rufe Datei_ueberspringen auf...")
MyValidationLogger.Info($" VOR: frmValidator.IsDisposed: {Me.IsDisposed}")
' ========== ENDE DIAGNOSE ==========
End If
Datei_ueberspringen()
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] Nach Datei_ueberspringen: {(DateTime.Now - perfLastCheck).TotalMilliseconds}ms")
' ========== DIAGNOSE: Nach Datei_ueberspringen ==========
MyValidationLogger.Info($" NACH: frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" NACH: frmValidator.Visible: {Me.Visible}")
' ========== ENDE DIAGNOSE ==========
End If
End If
If LOG_HOTSPOTS Then
MyValidationLogger.Info($"[PERF] bbtniNext_ItemClick GESAMT: {(DateTime.Now - perfStart).TotalMilliseconds}ms")
' ========== DIAGNOSE ENDE ==========
MyValidationLogger.Info($"[START] bbtniNext_ItemClick ENDE")
MyValidationLogger.Info($" frmValidator.IsDisposed: {Me.IsDisposed}")
MyValidationLogger.Info($" frmValidator.Visible: {Me.Visible}")
' ========== ENDE DIAGNOSE ==========
End If
Cursor = Cursors.Default
End Sub
Private Sub bbtniDelete_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtniDelete.ItemClick
If ForceGridValidation() = True Then
delete_active_File()
End If
End Sub
Private Sub bbtniAnnotation_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtniAnnotation.ItemClick
Application.DoEvents()
frmAnnotations.ShowDialog()
LoadDocument_DDViewer()
End Sub
Private Sub BbtnItm_ItemClick(sender As Object, e As ItemClickEventArgs) Handles BbtnitmSave.ItemClick
' ========== FIX 1: Button-State-Management ==========
If BbtnitmSave.Enabled = False Then
MyValidationLogger.Warn("BbtnitmSave_ItemClick: Button bereits disabled, Exit Sub")
Exit Sub
End If
BbtnitmSave.Enabled = False
' ========== ENDE FIX 1 ==========
Dim oHandle = SplashScreenManager.ShowOverlayForm(Me)
Try
' ========== FIX 2: Nur EINEN Check-Aufruf ==========
If Check_UpdateIndexe() = True Then
SetStatusLabel("Data saved", "LimeGreen")
MyValidationLogger.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, System.Environment.MachineName, "Manual Save via button")
DatabaseFallback.ExecuteNonQueryECM(ins)
Else
SetStatusLabel("Error while saving data!", "Red")
MsgBox("Unexpeceted error while savign data! Please check Your log and try again.", MsgBoxStyle.Critical)
End If
' ========== ENDE FIX 2 ==========
Finally
' ========== FIX 3: Button nur re-enablen wenn Form nicht schließt ==========
If Not _FormClosing AndAlso Not Me.IsDisposed Then
BbtnitmSave.Enabled = True
Else
MyValidationLogger.Debug("BbtnitmSave_ItemClick: Form closing, Button bleibt disabled")
End If
SplashScreenManager.CloseOverlayForm(oHandle)
' ========== ENDE FIX 3 ==========
End Try
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
MyValidationLogger.Error(ex)
MyValidationLogger.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
MyValidationLogger.Error(ex)
MyValidationLogger.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(USER_CONFIG_DIRECTORY, Filename)
End Function
Private Sub BarButtonItem5_ItemClick_1(sender As Object, e As ItemClickEventArgs) Handles BarButtonItem5.ItemClick
MsgBox("Versioning not configured! (Reasons: RightManagement, Displaying)", MsgBoxStyle.Information)
End Sub
Private Sub Attmt_bbtnitmShow_Click(sender As Object, e As ItemClickEventArgs) Handles Attmt_bbtnitmShow.ItemClick
TryOpen_Additional_Searches()
End Sub
Private Sub barbtnitmExport_ItemClick(sender As Object, e As ItemClickEventArgs) Handles barbtnitmExport.ItemClick
If File.Exists(WMDocPathWindows) = False Then
MsgBox("Workflow-Document seems not to exist. Check Your log.", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE)
Exit Sub
End If
Try
Dim oFilenameOnly As String
Dim oExtension As String
Dim oTargetPath As String
Dim oFile2Export As String
Dim oCount As Integer = 0
Dim oSQLGetFilename As String
If FolderBrowserDialog1.ShowDialog <> DialogResult.OK Then
Exit Sub
End If
oFilenameOnly = Path.GetFileName(WMDocPathWindows)
oExtension = Path.GetExtension(WMDocPathWindows)
oSQLGetFilename = $"DECLARE @Filename Varchar(512) " & vbNewLine &
$"EXEC dbo.PRPM_GETFILENAME_EXPORT {CURRENT_DOC_ID}, 1, @Outputfilename = @Filename OUTPUT;" & vbNewLine &
"SELECT @Filename"
Dim oExportFilename = DatabaseFallback.GetScalarValueECM(oSQLGetFilename)
If Not IsNothing(oExportFilename) Then
If IsDBNull(oExportFilename) Then
MyValidationLogger.Info($"#### ATTENTION: oExportFilename is DBNULL - SQL: {oSQLGetFilename}")
oExportFilename = ""
End If
If oExportFilename <> String.Empty Then
oTargetPath = FolderBrowserDialog1.SelectedPath & "\" & oExportFilename & oExtension
If Not IsNothing(barbtnitmExport.Tag) Then
If barbtnitmExport.Tag.ToString = "Convert to PDF" Then
If oExtension.ToLower.EndsWith("pdf") Then
Dim oTempPath = System.IO.Path.GetTempPath()
Dim oTempFullFilename = oTempPath + "\" + oExportFilename & oExtension
Dim oConverter As New PDFConverter(LOGCONFIG)
If oConverter.ConvertPDFADocumentToPDFDocument(WMDocPathWindows, oTempFullFilename) = False Then
MyValidationLogger.Warn("⚠️ File [{0}] could not be converted to plain PDF!", WMDocPathWindows)
oFile2Export = WMDocPathWindows
Else
MyValidationLogger.Info("File [{0}] successfully converted to plain PDF!", oTempFullFilename)
MyValidationLogger.Info("File [{0}] successfully converted to plain PDF!", WMDocPathWindows)
oFile2Export = oTempFullFilename
End If
Else
MyValidationLogger.Warn("⚠️ No converting as File [{0}] not ending with pdf [{1}]", WMDocPathWindows, oExtension.ToLower)
oFile2Export = WMDocPathWindows
End If
Else
MyValidationLogger.Warn("⚠️ No converting as barbtnitmExport.Tag.ToString <> Convert to PDF")
oFile2Export = WMDocPathWindows
End If
Else
oFile2Export = WMDocPathWindows
End If
MyValidationLogger.Info("Final export path is: [{0}]", oFile2Export)
File.Copy(oFile2Export, oTargetPath)
MyValidationLogger.Info($"File {WMDocPathWindows} exported successfully!")
oCount += 1
Else
MsgBox("Error encountered while extracting Export-Filename!" & vbNewLine & "Please inform Admin-Team!", MsgBoxStyle.Critical, ADDITIONAL_TITLE)
End If
End If
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 = DatabaseFallback.GetScalarValueECM(oSQLGetFilename)
oExtension = Path.GetExtension(oFromFilename)
If Not IsNothing(oExportFilename) Then
If IsDBNull(oExportFilename) Then
MyValidationLogger.Info($"#### ATTENTION: oExportFilename is DBNULL - SQL: {oSQLGetFilename}")
oExportFilename = ""
End If
If oExportFilename <> String.Empty Then
oTargetPath = FolderBrowserDialog1.SelectedPath & "\" & oExportFilename & oExtension
File.Copy(oFromFilename, oTargetPath)
oCount += 1
Else
Dim omsg = $"Error encountered while extracting ATTACHMENT-Export-Filename DocID [{oDocID}]!"
MyValidationLogger.Info($"#### ATTENTION: {omsg} SQL: {oSQLGetFilename}")
MsgBox(omsg & vbNewLine & "Please inform Admin-Team!", MsgBoxStyle.Critical, ADDITIONAL_TITLE)
End If
End If
'oFilenameOnly = Path.GetFileName(oFromFilename)
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)
Catch ex As Exception
MyValidationLogger.Error(ex)
MsgBox("Could not move file to target: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, ADDITIONAL_TITLE)
End Try
End Sub
Private Sub BarCheckItemLoadOnClick_CheckedChanged(sender As Object, e As ItemClickEventArgs) Handles Attmnt_bbtnitm_LoadonClick.CheckedChanged
If _FormLoaded = False Then
Exit Sub
End If
CONFIG.Config.ADDITIONAL_SEARCHES_LOAD_ONCLICK = Attmnt_bbtnitm_LoadonClick.Checked
CONFIG.Save()
End Sub
Private Sub btnReject_Click(sender As Object, e As EventArgs) Handles btnReject.Click
oProfile_REJECT_SQL_REASONS = clsPatterns.ReplaceAllValues(oProfile_REJECT_SQL_REASONS, PanelValidatorControl, True)
Dim frmRejCommit As New frmRejectionCommit(CURRENT_ProfilGUID, CURRENT_DOC_ID, oProfileRejectionText, oProfile_REJECT_SQL_REASONS)
frmRejCommit.ShowDialog()
If frmRejCommit.pRejection_Commited = True Then
Dim oNoError As Boolean = True
'Ablehnungsgrund speichern
If IDB_ACTIVE = False Then
oNoError = Indexiere_File(CURRENT_WMFILE, PROFIL_REJECT_ACTIONS_ATTRIBUTE, frmRejCommit.pRejection_Action)
If oNoError Then
oNoError = Indexiere_File(CURRENT_WMFILE, PROFIL_REJECT_COMMENT_ATTRIBUTE, frmRejCommit.pRejection_Comment)
End If
Else
oNoError = IDBData.SetVariableValue(PROFIL_REJECT_ACTIONS_ATTRIBUTE, frmRejCommit.pRejection_Action)
If oNoError Then
oNoError = IDBData.SetVariableValue(PROFIL_REJECT_COMMENT_ATTRIBUTE, frmRejCommit.pRejection_Comment)
End If
End If
If oNoError Then
REJECTION_ACTIVE = True
If Check_UpdateIndexe() = True Then
Finish_WFStep(True)
End If
Else
MsgBox("We are sorry, but an enexpected error in rejection-process occured!" & vbNewLine & "Inform Your admin-team and check Your log. Thank You.", MsgBoxStyle.Exclamation, ADDITIONAL_TITLE)
End If
End If
End Sub
Private Sub btnNotResponsible_Click(sender As Object, e As EventArgs) Handles btnNotResponsible.Click
Dim oCommentSoFar As String = ""
For Each oControl As Control In PanelValidatorControl.Controls
If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Attribute = PROFIL_NOT_RESP_COMMENT_ATTR Then
Dim oName = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Name
MyValidationLogger.Debug($"Got the control for the NR Attribute :{oName}..Gettin the value...")
If oControl.GetType() = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType() = GetType(MemoEdit) Then
Try
oCommentSoFar = DirectCast(oControl, DevExpress.XtraEditors.TextEdit).EditValue
Exit For
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Unexpected error in Checking EditValue: {ex.Message}")
End Try
End If
End If
Next
Dim oIncludeFI As Boolean = False
OverrideAll = True
Override = True
Override_SQLCommand = clsPatterns.ReplaceAllValues(oProfile_NOT_RESP_SQL, PanelValidatorControl, True)
Dim oCaption As String = "Bestätigung - "
If USER_LANGUAGE <> "de-DE" Then
oCaption = "Confirmation - "
End If
Dim frmDialog As New frmYesNo(oProfileNotResponsibleQuestion, oCaption + oProfileNotResponsibleText, oCommentSoFar, PROFILE_NOT_RESP_COMMENT)
frmDialog.ShowDialog()
' result = MessageBox.Show(oProfileNotResponsibleQuestion, ADDITIONAL_TITLE, MessageBoxButtons.YesNo, MessageBoxIcon.Exclamation)
If frmDialog.DialogResult = DialogResult.OK Then
Dim oOverrideDT As DataTable = DatabaseFallback.GetDatatableECM(Override_SQLCommand)
If Not IsNothing(oOverrideDT) Then
If oOverrideDT.Rows.Count = 1 Then
Try
OverrideAll = oOverrideDT?.Rows(0).Item("OverrideAll")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Could not set OverrideAll {ex.Message}")
End Try
Try
oIncludeFI = oOverrideDT?.Rows(0).Item("IncludeFI")
Catch ex As Exception
MyValidationLogger.Warn($"⚠️ Could not set oIncludeFI {ex.Message}")
End Try
Else
MyValidationLogger.Info(String.Format("Result of oProfile_NOT_RESP_SQL did not delivered a Datatable - OverrideAll = True"))
End If
Else
MyValidationLogger.Warn(String.Format("oProfile_NOT_RESP_SQL returned Nothing - OverrideAll = True"))
End If
If OverrideAll = True Then
MyValidationLogger.Info($"CURRENT_DOC_ID: {CURRENT_DOC_ID} - OverrideAll will be in Action!")
End If
'For Each oControl As Control In PanelValidatorControl.Controls
' If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Attribute = PROFIL_NOT_RESP_COMMENT_ATTR Then
' Dim oName = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Name
' Logger.Debug($"Got the control for the NR Attribute :{oName}..Gettin the value...")
' If oControl.GetType() = GetType(DevExpress.XtraEditors.TextEdit) Or oControl.GetType() = GetType(MemoEdit) Then
' Try
' DirectCast(oControl, DevExpress.XtraEditors.TextEdit).EditValue = frmDialog.oComment
' Exit For
' Catch ex As Exception
' Logger.Warn($"⚠️ Unexpected error in Setting EditValue NotResponsible: {ex.Message}")
' End Try
' End If
' End If
'Next
If IDB_ACTIVE = False Then
Indexiere_File(CURRENT_WMFILE, PROFIL_NOT_RESP_COMMENT_ATTR, frmDialog.oComment)
Else
Dim oREsult = IDBData.SetVariableValue(PROFIL_NOT_RESP_COMMENT_ATTR, frmDialog.oComment)
End If
Finish_WFStep(oIncludeFI)
End If
End Sub
Private Sub bbtnitmInfoWorkflow_ItemClick(sender As Object, e As ItemClickEventArgs) Handles bbtnitmInfoWorkflow.ItemClick
Show_WF_Messages(True)
End Sub
Private Sub BarCheckItem1_CheckedChanged(sender As Object, e As ItemClickEventArgs) Handles bchkitmNotes.CheckedChanged
If _FormLoaded = False Then
Exit Sub
End If
CONFIG.Config.NOTES_ONCLICK = bchkitmNotes.Checked
CONFIG.Save()
End Sub
End Class