Imports WINDREAMLib Imports System.Threading Imports System.Runtime.InteropServices Imports Oracle.ManagedDataAccess.Client Imports Independentsoft Imports System.IO Imports System.Text.RegularExpressions Imports System.ComponentModel Imports DD_LIB_Standards Imports DigitalData.Controls.LookupGrid Imports DevExpress.XtraGrid Imports DigitalData.Controls.DocumentViewer Imports System.Reflection Public Class frmValidator Dim viewerID Dim strFileList() Dim PROFIL_sortbynewest As Boolean Dim PROFIL_VEKTORINDEX Dim PROFIL_LOGINDEX Dim Delimiter As String Dim WD_Search As String Dim finalProfile As Boolean Dim Move2Folder As String 'Private _windreamPM As New ClassPMWindream Private _windream As New ClassWindream_allgemein Private allgFunk As New ClassAllgemeineFunktionen 'speichert die DocumentDaten Private navStep As String = Nothing Public Shared WMDocPathWindows As String Public WMDocFileString As String Dim OLD_Document_Path As String = "" Dim ValueDTP As Date Dim AnzDoks As Integer Dim docCounter As Integer = 1 'Anzahl der Validierungsdokumente Dim Anzahl_ValDoks As Integer 'Anzahl der validierten Dokumente Dim Anzahl_validierte_Dok As Integer = 0 Dim me_closing As Boolean = False Dim oErrorMessage As String = "Please validate red marked fields" Dim first_control As Control Dim last_control As Control Dim _Indexe_Loaded As Boolean = False Public Shared idxerr_message As String = "" Dim DocView Dim viewer_string As String Dim pdfxchange As Boolean = False Dim sumatra As Boolean = False Private _CURRENT_INDEX_ARRAY(100, 250) As String Dim MyDocViewer As DocumentViewer Private _frmValidatorSearch As frmValidatorSearch 'You need a reference to Form1 Private _dependingControl_in_action As Boolean = False Private DTCONTROLS As DataTable Private DTVWCONTROL_INDEX As DataTable Private FormLoaded As Boolean = False Private ControlHandleStarted As Boolean = False Public Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As Boolean End Function Function set_foreground() Try Dim hwnd As IntPtr Dim prc() As Process = Process.GetProcessesByName("DD_PM_WINDREAM") If Not prc Is Nothing AndAlso Not prc.Length = 0 Then hwnd = prc(0).MainWindowHandle SetForegroundWindow(hwnd) Else prc = Process.GetProcessesByName("DD_PM_WINDREAM.vshost") If Not prc Is Nothing AndAlso Not prc.Length = 0 Then hwnd = prc(0).MainWindowHandle SetForegroundWindow(hwnd) End If End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler in set_foreground: " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Fehler:") End Try End Function Private Sub frmValidation_Load(sender As Object, e As System.EventArgs) Handles Me.Load SplitContainer1.Panel2Collapsed = True docCounter = 1 OLD_Document_Path = "" first_control = Nothing me_closing = False pdfxchange = False sumatra = False FormLoaded = False If My.Settings.frmValidatorPosition.IsEmpty = False Then If My.Settings.frmValidatorPosition.X > 0 And My.Settings.frmValidatorPosition.Y > 0 Then Location = My.Settings.frmValidatorPosition End If End If If My.Settings.frmValidatorSize.IsEmpty = False Then Size = My.Settings.frmValidatorSize End If Dim _step = 0 Try MyDocViewer = New DocumentViewer MyDocViewer.Init(LOGCONFIG, "21182889975216572111813147150675976632") Catch ex As Exception LOGGER.Error(ex) End Try Try _step = 1 TBPM_PROFILE_CONTROLSTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBDD_CONNECTIONTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_PROFILE_FILESTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_PROFILE_FINAL_INDEXINGTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_PROFILETableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_KONFIGURATIONTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = CONNECTION_STRING _step = 2 Dim oSQL = $"SELECT * FROM VWPM_CONTROL_INDEX WHERE PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY Y_LOC, X_LOC" DTVWCONTROL_INDEX = ClassDatabase.Return_Datatable(oSQL) 'VWPM_CONTROL_INDEXTableAdapter.Fill(DD_DMSLiteDataSet.VWPM_CONTROL_INDEX, CURRENT_ProfilName) _step = 3 TBDD_CONNECTIONTableAdapter.Fill(DD_DMSLiteDataSet.TBDD_CONNECTION) _step = 4 TBPM_CONTROL_TABLETableAdapter.FillAll(DD_DMSLiteDataSet.TBPM_CONTROL_TABLE) LOGGER.Debug("Profile Data geladen") Catch ex As Exception LOGGER.Error(ex) MsgBox("Error LOADING profile-data(" & _step.ToString & "):" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error LOADING profile-data: " & ex.Message, USER_USERNAME) LOGGER.Info(">> Fehler in LOADING profile-data: " & ex.Message, True) Me.Close() End Try Try Delimiter = TBPM_KONFIGURATIONTableAdapter.cmdGetDelimiter If CURRENT_DT_PROFILE.Rows.Count = 0 Then LOGGER.Info(">> Profildaten konnten nicht geladen werden - Übergebenes Profil: : " & CURRENT_ProfilName, True) MsgBox("Achtung: Profildaten konnten nicht übergeben oder geladen werden.", MsgBoxStyle.Critical, "Achtung:") Me.Close() End If If CURRENT_DT_PROFILE.Rows.Count > 1 Then MsgBox("Es wurde mehr als 1 Profil (" & CURRENT_DT_PROFILE.Rows.Count & ") zurückgegeben!!", MsgBoxStyle.Critical, "Achtung:") Else If CURRENT_DT_PROFILE.Rows.Count = 1 Then For Each dr As DataRow In CURRENT_DT_PROFILE.Rows PROFIL_VEKTORINDEX = dr.Item("PM_VEKTOR_INDEX") PROFIL_LOGINDEX = dr.Item("LOG_INDEX") Me.Text = "Process Manager - " & dr.Item("TITLE") TITLELabel1.Text = dr.Item("TITLE") DESCRIPTIONLabel.Text = IIf(IsDBNull(dr.Item("DESCRIPTION")), "", dr.Item("DESCRIPTION")) If PROFIL_VEKTORINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_VEKTORINDEX = "" End If If PROFIL_LOGINDEX.GetType.ToString.ToLower = "system.dbnull" Then PROFIL_LOGINDEX = "" End If WD_Search = dr.Item("WD_SEARCH") finalProfile = dr.Item("FINAL_PROFILE") Move2Folder = IIf(IsDBNull(dr.Item("MOVE2Folder")), "", dr.Item("MOVE2Folder")) Try If finalProfile = True Then Dim text As String = IIf(IsDBNull(dr.Item("FINAL_TEXT")), "", dr.Item("FINAL_TEXT")) If text <> "" Then btnSave.Text = text Else btnSave.Text = "Validierung speichern - Nächstes Dokument" End If Else btnSave.Text = "Validierung speichern - Nächstes Dokument" End If LOGGER.Debug("Final profile Text geladen") Catch ex As Exception LOGGER.Error(ex) MsgBox("Error loading final profile text:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error loading final profile text: " & ex.Message, USER_USERNAME) LOGGER.Info(">> Fehler in loading final profile text: " & ex.Message, True) End Try ToolStripButtonJumpFile.Enabled = True If CURRENT_JUMP_DOC_GUID <> 0 Then ToolStripButtonJumpFile.Enabled = False Anzahl_ValDoks = 1 Else Anzahl_ValDoks = TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(CURRENT_ProfilGUID) End If Next If LOG_ERRORS_ONLY = False Then LOGGER.Info(" >> Profildaten gespeichert") LOGGER.Info(" >> WD_Search: " & WD_Search) LOGGER.Info(" >> finalProfile: " & finalProfile) LOGGER.Info(" >> Move2Folder: " & Move2Folder) LOGGER.Info(" >> Right_Delete: " & USER_RIGHT_FILE_DELETE) End If PROFIL_sortbynewest = CURRENT_DT_PROFILE.Rows(0).Item("SORT_BY_LATEST") LOGGER.Debug("PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString) 'Delete Button anzeigen ja/nein If USER_RIGHT_FILE_DELETE = True Then ToolStripButtonDeleteFile.Enabled = True Else ToolStripButtonDeleteFile.Enabled = False End If LOGGER.Debug("Right_Delete: " & USER_RIGHT_FILE_DELETE.ToString) Load_Controls() End If End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Error LOADING Profile-Data1:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error LOADING(2) Profile-Data: " & ex.Message, USER_USERNAME) LOGGER.Info(">> Fehler in LOADING(2) Profile-Data: " & ex.Message, True) End Try End Sub Private Sub frmValidation_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Try me_closing = True Try ' Position und Größe speichern My.Settings.frmValidatorSize = Me.Size My.Settings.frmValidatorPosition = Me.Location My.Settings.Save() Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Error in Load FormLayout: " & ex.Message) End Try Select Case Path.GetExtension(WMDocPathWindows).ToLower Case ".pdf" Select Case VIEWER_PDF Case "internal" My.Settings.frmValidation_Size_PDFViewer = Me.Size Case "pdfxchange" My.Settings.frmValidatorSize = Me.Size Case "sumatra" My.Settings.frmValidatorSize = Me.Size Case "system" My.Settings.frmValidatorSize = Me.Size End Select Case ".msg" My.Settings.frmValidation_Size_Email = Me.Size Case Else My.Settings.frmValidatorSize = Me.Size End Select My.Settings.Save() Try _frmValidatorSearch.Close() Catch ex As Exception End Try Catch ex As Exception LOGGER.Error(ex) End Try Try Dim oDel = $"DELETE FROM TBPM_FILES_USER_NOT_INDEXED WHERE UPPER(USR_NAME) = UPPER('{USER_USERNAME}')" ClassDatabase.Execute_non_Query(oDel) Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Übersprungene Files löschen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try If CURRENT_DOC_GUID <> 0 Then Try TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", CURRENT_DOC_GUID) Catch ex As Exception LOGGER.Error(ex) allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler bei Freigabe der Dok-ID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, USER_USERNAME) End Try End If If VIEWER_ALL = "docview" Then If IDB_ACTIVE = False Then CloseWDDocview() End If End If If VIEWER_PDF = "system" Then Kill_PDFAcrobat() Else If pdfxchange = True Or sumatra = True Then Close_PDF_Viewer(WMDocPathWindows) End If KillU_Viewer() End If End Sub Sub KillU_Viewer() Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo("taskkill.exe", "/im Viewer.exe") psi.UseShellExecute = True Proc.StartInfo = psi psi.WindowStyle = ProcessWindowStyle.Minimized Proc.Start() pdfxchange = False Dim p As Process Dim processes As Process() processes = Process.GetProcesses() For Each p In processes If p.ProcessName.ToLower = "viewer" Then p.Kill() End If Next Catch ex As Exception LOGGER.Error(ex) End Try End Sub Sub Kill_PDFAcrobat() Try Dim p As Process Dim processes As Process() processes = Process.GetProcesses() For Each p In processes If viewerID Is Nothing = False Then If p.Id = viewerID Then p.Kill() If p.ProcessName = "Acrobat.exe" Then p.Kill() Else If p.ProcessName = "Acrobat.exe" Then p.Kill() If p.ProcessName = "AcroRd32.exe" Then p.Kill() If p.ProcessName.ToLower = "acrord32" Then p.Kill() If p.ProcessName.Contains("croRd") Then p.Kill() End If Next Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Function process_User_exists(processname As String, Status As String) Dim fi = New FileInfo(processname) Dim filename As String = fi.Name.Replace(fi.Extension, "") Try If Process.GetProcessesByName(filename).Length > 0 Then Return True Else Return False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Fehler in process_User_exists: " & ex.Message, True) Return False End Try End Function 'Private Function process_terminate(processname As String) ' Try ' Dim selectQuery As SelectQuery = New SelectQuery("Win32_Process") ' Dim searcher As ManagementObjectSearcher = New ManagementObjectSearcher(selectQuery) ' For Each proc As ManagementObject In searcher.Get ' If proc("Name").ToString = processname Then ' Dim s(1) As String ' proc.InvokeMethod("GetOwner", CType(s, Object())) ' If CStr(s(0)).ToLower.Contains(USER_USERNAME.ToLower) Then ' proc.InvokeMethod("Terminate", Nothing) ' End If ' End If ' Next ' Return False ' Catch ex As Exception ' LOGGER.Info(">> Fehler in process_terminate: " & ex.Message, True) ' End Try 'End Function Sub Close_PDF_Viewer(vorherigefile As String) Try If VIEWER_PDF = "pdfxchange" Then Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(VIEWER_XCHANGE, "/Close:save """ & vorherigefile & """") psi.WindowStyle = ProcessWindowStyle.Minimized psi.UseShellExecute = True Proc.StartInfo = psi Proc.Start() pdfxchange = True sumatra = False 'Dim count As Integer = 0 'sss() 'Do While process_User_exists("PDFXCview.exe", "CLOSE") = True ' 'Warten bis PDF geschlossen ist ' count += 1 ' If count = 500 Then ' If process_terminate("PDFXCview.exe") Then ' process_terminate("PDFXCview.exe") ' End If ' End If 'Loop End If If VIEWER_PDF = "sumatra" Then Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo("taskkill.exe", "/im SumatraPDF.exe") psi.WindowStyle = ProcessWindowStyle.Minimized psi.UseShellExecute = True Proc.StartInfo = psi Proc.Start() pdfxchange = False sumatra = True Catch ex As Exception LOGGER.Error(ex) End Try End If If VIEWER_PDF = "system" Then Kill_PDFAcrobat() pdfxchange = False sumatra = False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Fehler in Close_PDFXCHANGE") LOGGER.Info(ex.Message) End Try End Sub Private Function Init_IDB() Try IDBData = New ClassIDBData Catch ex As Exception LOGGER.Error(ex) MsgBox("Error Init_IDB:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") End Try End Function Private Function Init_windream() Try WINDREAM = New ClassPMWindream() WINDREAM.Create_Session() LOGGER.Debug("Windream initiiert") Return True Catch ex As Exception LOGGER.Error(ex) MsgBox("Error Init_windream:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error Init _windream: " & ex.Message, USER_USERNAME) LOGGER.Info(">> Fehler in Init_windream: " & ex.Message, True) Return False End Try End Function Public Sub Load_Additional_Searches() If CURRENT_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Or CURRENT_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then Dim oDocResultCommand As String Dim oDatatableDocResult As DataTable Dim oDataResultCommand As String Dim oDatatableDataResult As DataTable If CURRENT_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Then 'Check whether DocData is there Dim oConID = CURRENT_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("CONN_ID") oDataResultCommand = CURRENT_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("SQL_COMMAND") oDataResultCommand = clsPatterns.ReplaceAllValues(oDataResultCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) oDatatableDataResult = ClassDatabase.Return_Datatable(oDataResultCommand) End If If CURRENT_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then 'Check whether DocData is there Dim oConID = CURRENT_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID") oDocResultCommand = CURRENT_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND") oDocResultCommand = clsPatterns.ReplaceAllValues(oDocResultCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) oDatatableDocResult = ClassDatabase.Return_Datatable(oDocResultCommand) End If Dim oDataResultsExist As Boolean = False Dim oDocResultsExist As Boolean = False If CURRENT_DT_PROFILE_SEARCHES_SQL.Rows.Count > 0 Then If Not IsNothing(oDatatableDataResult) Then If oDatatableDataResult.Rows.Count > 0 Then oDataResultsExist = True End If End If End If If CURRENT_DT_PROFILE_SEARCHES_DOC.Rows.Count > 0 Then If Not IsNothing(oDatatableDocResult) Then If oDatatableDocResult.Rows.Count > 0 Then oDocResultsExist = True End If End If End If If oDataResultsExist = True Or oDocResultsExist = True Then ToolStripButtonSearchesReload.Enabled = True frmValidatorSearch.Show() _frmValidatorSearch = frmValidatorSearch Dim oPnl1Collapsed As Boolean = True Dim oPnl2Collapsed As Boolean = True If oDataResultsExist = True Then oPnl1Collapsed = False Else oPnl1Collapsed = True End If If oDocResultsExist = True Then oPnl2Collapsed = False Else oPnl2Collapsed = True End If _frmValidatorSearch.TabPreload(oPnl1Collapsed, oPnl2Collapsed, CURRENT_DT_PROFILE_SEARCHES_SQL.Rows.Count, CURRENT_DT_PROFILE_SEARCHES_DOC.Rows.Count, CURRENT_DT_PROFILE_SEARCHES_SQL, CURRENT_DT_PROFILE_SEARCHES_DOC) If oDataResultsExist Then _frmValidatorSearch._DTSQLSearches = CURRENT_DT_PROFILE_SEARCHES_SQL Dim oConID = CURRENT_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("CONN_ID") Dim oCommand = CURRENT_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("SQL_COMMAND") oCommand = clsPatterns.ReplaceAllValues(oCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) _frmValidatorSearch.Refresh_Load_GridSQL(oConID, oCommand, 0, CURRENT_DT_PROFILE_SEARCHES_SQL.Rows(0).Item("TAB_TITLE")) End If If oDocResultsExist Then _frmValidatorSearch._DTDocSearches = CURRENT_DT_PROFILE_SEARCHES_DOC Dim oConID = CURRENT_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("CONN_ID") Dim oCommand = CURRENT_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("SQL_COMMAND") oCommand = clsPatterns.ReplaceAllValues(oCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) _frmValidatorSearch.RefreshTabDoc(oConID, oCommand, 0, CURRENT_DT_PROFILE_SEARCHES_DOC.Rows(0).Item("TAB_TITLE")) End If Else LOGGER.Info("Not loading AdditionalSearches...!") ToolStripButtonSearchesReload.Enabled = False End If Else LOGGER.Info("Not loading AdditionalSearches...!") ToolStripButtonSearchesReload.Enabled = False End If End Sub Sub LoadSQLData(control As Control, controlId As Integer) Try If TypeOf control Is Label Then Exit Sub Dim sql As String = $"SELECT NAME, CONNECTION_ID, SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE GUID = {controlId} AND PROFIL_ID = {CURRENT_ProfilGUID} AND LEN(ISNULL(SQL_UEBERPRUEFUNG,'')) > 0 AND SQL_UEBERPRUEFUNG NOT LIKE '%#WMI#%' AND SQL_UEBERPRUEFUNG NOT LIKE '%#CTRL#%'" Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) If IsNothing(dt) Then Exit Sub If dt.Rows.Count = 0 Then Exit Sub For Each row As DataRow In dt.Rows Dim name As String = row.Item("NAME") If IsDBNull(row.Item("CONNECTION_ID")) Then Continue For If IsDBNull(row.Item("SQL_UEBERPRUEFUNG")) Then Continue For Dim sqlStatement As String = row.Item("SQL_UEBERPRUEFUNG") Dim connectionId As Integer = row.Item("CONNECTION_ID") If clsPatterns.HasComplexPatterns(sqlStatement) Then Continue For End If sql = clsPatterns.ReplaceUserValues(sqlStatement, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) sql = clsPatterns.ReplaceInternalValues(sql) LOGGER.Debug(">>> sql after ReplaceInternalValues: " & sql) 'sql = ClassPatterns.ReplaceInternalValues(sqlStatement) dt = ClassDatabase.Return_Datatable_ConId(sql, connectionId) If IsNothing(dt) Then MsgBox($"SQL-Query for control {control.Name} is invalid.") Exit Sub End If Dim oValue If TypeOf control Is TextBox Then Try Dim firstRow As DataRow = dt.Rows(0) Dim value = firstRow.Item(0) control.Text = value oValue = value Catch ex As Exception LOGGER.Error(ex) clsLogger.Add("Error in LoadSimpleData for TextBox: " & ex.Message) End Try ElseIf TypeOf control Is ComboBox Then Try Dim oMyComboBox As ComboBox = control Dim oselectedIndex = oMyComboBox.SelectedIndex LOGGER.Debug($"oMyComboBox {oMyComboBox.Name} - Saving selected index {oselectedIndex}") Dim list As New List(Of String) For Each _row As DataRow In dt.Rows list.Add(_row.Item(0)) Next oMyComboBox.DataSource = list oMyComboBox.SelectedIndex = oselectedIndex Catch ex As Exception LOGGER.Error(ex) clsLogger.Add("Error in LoadSimpleData for Combobox: " & ex.Message) End Try ElseIf TypeOf control Is LookupControl2 Then Try Dim lookup As LookupControl2 = control lookup.DataSource = dt Catch ex As Exception LOGGER.Error(ex) clsLogger.Add("Error in LoadSimpleData for LookupControl2: " & ex.Message) End Try ElseIf TypeOf control Is GridControl Then Try Dim dataGridView As GridControl = control Dim oDataSource As DataTable = dataGridView.DataSource If oDataSource Is Nothing OrElse oDataSource.Rows.Count = 0 Then 'dataGridView.DataSource = dt Dim oDatatable As DataTable = dt.Clone() For Each oColumn As DataColumn In oDatatable.Columns If oDataSource.Columns(oColumn.ColumnName) Is Nothing Then 'oDataSource.Columns.Add(oColumn) oDataSource.Columns.Add(oColumn.ColumnName, oColumn.DataType) End If Next For Each oRow As DataRow In dt.Rows oDataSource.ImportRow(oRow) Next dataGridView.DataSource = oDataSource End If Catch ex As Exception LOGGER.Error(ex) clsLogger.Add("Error in LoadSimpleData for DataGridView: " & ex.Message) End Try End If Next Catch ex As Exception LOGGER.Error(ex) MsgBox("Error in LoadSimpleData: " & ex.Message, MsgBoxStyle.Critical) clsLogger.Add("Error in LoadSimpleData: " & ex.Message) End Try End Sub Private Function PreventNulletc(myObject As Object) If IsDBNull(myObject) Then Return String.Empty ElseIf IsNothing(myObject) Then Return String.Empty Else Return myObject End If End Function Sub Load_Controls() Try pnldesigner.Controls.Clear() Dim oSQL = $"SELECT * FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY Y_LOC, X_LOC" DTCONTROLS = ClassDatabase.Return_Datatable(oSQL) Dim oCount As Integer = 0 For Each oControlRow As DataRow In DTCONTROLS.Rows Dim oMyControl As Control Select Case oControlRow.Item("CTRL_TYPE").ToString.ToUpper Case "TXT" LOGGER.Debug("Versuch TXT zu laden") Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(oControlRow, False) LOGGER.Debug("TXT wurde geladen") AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp oMyControl = txt Case "LBL" LOGGER.Debug("Versuch LBL zu laden") oMyControl = ClassControlCreator.CreateExistingLabel(oControlRow, False) Case "CMB" LOGGER.Debug("Versuch CMB zu laden") If oControlRow.Item("READ_ONLY") Then Dim cmbReadonly = ClassControlCreator.CreateExistingTextbox(oControlRow, False) oMyControl = cmbReadonly Else Dim cmb = ClassControlCreator.CreateExistingCombobox(oControlRow, False) AddHandler cmb.SelectedValueChanged, AddressOf OnCmbselectedIndex AddHandler cmb.GotFocus, Sub(sender As Control, e As EventArgs) If DirectCast(cmb.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then cmb.BackColor = Color.Lime End If End Sub AddHandler cmb.LostFocus, Sub(sender As Control, e As EventArgs) If DirectCast(cmb.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then cmb.BackColor = Color.White End If End Sub #Region "CONTROL LIST" Dim ControlID = DirectCast(cmb.Tag, ClassControlCreator.ControlMetadata).Guid ' TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, cmb.Name) LOGGER.Debug("In add_ComboBox - GUID: " & ControlID) If ControlID > 0 Then LOGGER.Debug(" >>ControlID > 0") Dim ConID = PreventNulletc(oControlRow.Item("CONNECTION_ID")) ' Me.TBPM_PROFILE_CONTROLSTableAdapter.cmdgetConnectionID(ControlID) If ConID <> String.Empty Then Dim commandsql = PreventNulletc(oControlRow.Item("SQL_UEBERPRUEFUNG")) 'TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) LOGGER.Debug("ConID <> String.Empty") If ConID > 0 And commandsql <> String.Empty Then LOGGER.Debug("ConID > 0 And commandsql <> String.Empty") Dim connectionString As String TBDD_CONNECTIONTableAdapter.FillByID(DD_DMSLiteDataSet.TBDD_CONNECTION, ConID) Dim DTConnection As DataTable = DD_DMSLiteDataSet.TBDD_CONNECTION Dim drConnection As DataRow For Each drConnection In DTConnection.Rows Select Case drConnection.Item("SQL_PROVIDER").ToString.ToLower Case "ms-sql" If drConnection.Item("USERNAME") = "WINAUTH" Then connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog=" & drConnection.Item("DATENBANK") & ";Trusted_Connection=True;" Else connectionString = "Data Source=" & drConnection.Item("SERVER") & ";Initial Catalog= " & drConnection.Item("DATENBANK") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" End If LOGGER.Debug("ConnString Sql-Server: " & connectionString) Case "oracle" Dim conn As New OracleConnectionStringBuilder Dim connstr As String If drConnection.Item("SERVER") <> "" And drConnection.Item("DATENBANK").GetType.ToString <> "system.dbnull" Then connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & drConnection.Item("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" & drConnection.Item("DATENBANK") & ")));User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" Else conn.DataSource = drConnection.Item("SERVER") conn.UserID = drConnection.Item("USERNAME") conn.Password = drConnection.Item("PASSWORD") conn.PersistSecurityInfo = True conn.ConnectionTimeout = 120 connstr = conn.ConnectionString End If connectionString = connstr Case Else LOGGER.Info(" - ConnectionType nicht integriert") MsgBox("ConnectionType nicht integriert", MsgBoxStyle.Critical, "Bitte Konfiguration Connection überprüfen!") End Select Next If connectionString Is Nothing = False Then Try Dim sqlCnn As SqlClient.SqlConnection Dim sqlCmd As SqlClient.SqlCommand Dim adapter As New SqlClient.SqlDataAdapter Dim NewDataset As New DataSet Dim i As Integer Dim sql As String sql = PreventNulletc(oControlRow.Item("SQL_UEBERPRUEFUNG")) 'TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) 'sql = ClassPatterns.ReplaceAllValues(sql, pnldesigner, CURRENT_WMFILE) 'If ClassPatterns.HasOnlySimplePatterns(sql) Then If clsPatterns.HasOnlySimplePatterns(sql) Then sql = clsPatterns.ReplaceInternalValues(sql) sql = clsPatterns.ReplaceControlValues(sql, pnldesigner) LOGGER.Debug(">>> sql after HasOnlySimplePatterns: " & sql) sqlCnn = New SqlClient.SqlConnection(connectionString) ' Try sqlCnn.Open() sqlCmd = New SqlClient.SqlCommand(sql, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) Dim msg As String For i = 0 To NewDataset.Tables(0).Rows.Count - 1 cmb.Items.Add(NewDataset.Tables(0).Rows(i).Item(0)) Next adapter.Dispose() sqlCmd.Dispose() sqlCnn.Close() End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" - Unvorhergesehener Fehler bei GetValues SQL - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei GetValues SQL:") End Try End If Else LOGGER.Debug("Else Row 571") End If Else LOGGER.Debug("AListe Handling") Dim AListe As String = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetChoiceListName(ControlID) LOGGER.Debug("In add_ComboBox - AListe: " & AListe) If AListe Is Nothing = False Then 'Dim liste = _windreamPM.GetValuesfromAuswahlliste(AListe) Dim liste = WINDREAM.GetValuesfromAuswahlliste(AListe) If liste IsNot Nothing Then cmb.Items.Add("") For Each index As String In liste cmb.Items.Add(index) Next cmb.SelectedIndex = -1 Else MsgBox("Resultliste windream is nothing!", MsgBoxStyle.Exclamation, AListe) End If Else MsgBox("AListe from database is nothing!", MsgBoxStyle.Exclamation, AListe) End If End If End If #End Region Dim maxWith As Integer = cmb.Width Using g As Graphics = Me.CreateGraphics For Each oItem As Object In cmb.Items 'Für alle Einträge... Dim g1 As Graphics = cmb.CreateGraphics If g1.MeasureString(Text, cmb.Font).Width + 30 > maxWith Then maxWith = g1.MeasureString(Text, cmb.Font).Width + 30 End If g1.Dispose() Next oItem End Using cmb.DropDownWidth = maxWith oMyControl = cmb End If Case "DTP" LOGGER.Debug("Versuch DTP zu laden") oMyControl = ClassControlCreator.CreateExistingDatepicker(oControlRow, False) Case "DGV" LOGGER.Debug("Versuch DGV zu laden") Dim dgv = ClassControlCreator.CreateExistingDataGridView(oControlRow, False) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating oMyControl = dgv Case "LOOKUP" LOGGER.Debug("Versuch LOOKUP zu laden") Dim oMultiselect = oControlRow.Item("MULTISELECT") Dim oReadonly = oControlRow.Item("READ_ONLY") If oMultiselect = False And oReadonly = True Then Dim lookupReadonly = ClassControlCreator.CreateExistingTextbox(oControlRow, False) oMyControl = lookupReadonly Else Dim lookup As LookupControl2 = ClassControlCreator.CreateExistingLookupControl(oControlRow, False) lookup.PreventDuplicates = oControlRow.Item("VKT_PREVENT_MULTIPLE_VALUES") lookup.AllowAddNewValues = oControlRow.Item("VKT_ADD_ITEM") lookup.MultiSelect = oMultiselect If NotNull(oControlRow.Item("DEFAULT_VALUE"), "") <> "" Then lookup.SelectedValues = New List(Of String) From {oControlRow.Item("DEFAULT_VALUE")} End If oMyControl = lookup 'Wenn Multiselect false dann prüfen ob abhängiges Control If CBool(oControlRow.Item("MULTISELECT")) = False Then Dim filteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oMyControl.Name}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges) If filteredData.Rows.Count = 1 Then 'AddHandler lookup.EditValueChanged, AddressOf onLookUp1 AddHandler lookup.SelectedValuesChanged, AddressOf onLookUp1 End If End If AddHandler lookup.GotFocus, Sub(sender As Control, e As EventArgs) If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then lookup.BackColor = Color.Lime End If End Sub AddHandler lookup.LostFocus, Sub(sender As Control, e As EventArgs) If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then lookup.BackColor = Color.White End If End Sub End If 'Return filteredData 'AddHandler lookup.Leave, AddressOf onLookUp0 Case "CHK" LOGGER.Debug("Versuch Checkbox zu laden") oMyControl = ClassControlCreator.CreateExisingCheckbox(oControlRow, False) Case "TABLE" LOGGER.Debug("Versuch Tabelle zu laden") Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DD_DMSLiteDataSet.TBPM_CONTROL_TABLE Where r.CONTROL_ID = oControlRow.Item("GUID") Select r).ToList() Dim oGrid = ClassControlCreator.CreateExistingGridControl(oControlRow, columns, False) AddHandler oGrid.ProcessGridKey, Sub(ByVal _sender As Object, ByVal e As KeyEventArgs) If e.KeyCode = Keys.Tab Then Dim gridControl = TryCast(_sender, GridControl) Dim view = TryCast(gridControl.FocusedView, Views.Base.ColumnView) If (e.Modifiers = Keys.None And view.IsNewItemRow(view.FocusedRowHandle) And view.FocusedColumn.VisibleIndex = view.VisibleColumns.Count - 1) Then If view.IsEditing Then view.CloseEditor() Me.SelectNextControl(gridControl, e.Modifiers = Keys.None, True, True, True) e.Handled = True End If End If End If End Sub oMyControl = oGrid Case "LINE" LOGGER.Debug("Versuch Linie zu laden") oMyControl = ClassControlCreator.CreateExistingLine(oControlRow, False) End Select If TypeOf oMyControl IsNot Label Then If first_control Is Nothing Then first_control = oMyControl End If last_control = oMyControl oMyControl.TabIndex = oCount End If ' oMyControl.Tag = CInt(oControlRow.Item("GUID")) pnldesigner.Controls.Add(oMyControl) oCount += 1 Next LOGGER.Debug("Controls geladen") LOGGER.Debug("") Catch ex As Exception LOGGER.Error(ex) If LOG_ERRORS_ONLY = False Then MsgBox("Error Load_Controls: " & ex.Message, MsgBoxStyle.Critical, "Attention error:") allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error Load_Controls: " & ex.Message, USER_USERNAME) LOGGER.Info("Unvorhergesehener Fehler bei Load_Controls:" & ex.Message) LOGGER.Info("") End Try End Sub Sub Clear_all_Input() For Each inctrl As Control In Me.pnldesigner.Controls Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" inctrl.Text = "" Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl cmb.SelectedIndex = -1 Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = inctrl If dgv.Rows.Count > 0 Then dgv.Rows.Clear() End If Case "System.Windows.Forms.CheckBox" End Select Next set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If End Sub Public Sub OnTextBoxFocus(sender As Object, e As EventArgs) Dim box As TextBox = sender If DirectCast(box.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then box.BackColor = Color.Lime box.SelectAll() End If End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender If DirectCast(box.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then box.BackColor = Color.White End If End Sub Private Function GetControlID(ByVal PROFILEID As Integer, Controlname As String) For Each oROW As DataRow In DTVWCONTROL_INDEX.Rows Next End Function Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs) If ControlHandleStarted = True Then ControlHandleStarted = False Exit Sub End If Dim box As TextBox = sender If box.Text <> String.Empty And me_closing = False And _Indexe_Loaded = True Then If (e.KeyCode = Keys.Return) Or (e.KeyCode = Keys.Tab) Or (e.KeyCode = Keys.Enter) Then Try Dim CONTROL_ID = DirectCast(box.Tag, ClassControlCreator.ControlMetadata).Guid 'VWPM_CONTROL_INDEXTableAdapter.cmdGetControlID(CURRENT_ProfilGUID, box.Name) Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, box.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) And DT.Rows.Count > 0 Then For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) LOGGER.Debug(">>> sql after ReplaceAllValues: " & sql) '' Regulären Ausdruck zum Auslesen der Indexe definieren 'Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" '' einen Regulären Ausdruck laden 'Dim regulärerAusdruck As Regex = New Regex(preg) '' die Vorkommen im SQL-String auslesen 'Dim elemente As Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(sql_Statement) ''#### '' alle Vorkommen innerhalbd er Namenkonvention durchlaufen 'For Each element As Text.RegularExpressions.Match In elemente ' Try ' If LogErrorsOnly = False Then LOGGER.Info(" >> element in RegeX: " & element.Value) ' Dim MyPattern = element.Value.Substring(2, element.Value.Length - 3) ' Dim input_value ' If MyPattern.Contains(ClassControlCreator.PREFIX_TEXTBOX) Then ' Dim txt As TextBox = CType(pnldesigner.Controls(MyPattern), TextBox) ' input_value = txt.Text ' ElseIf MyPattern.Contains(ClassControlCreator.PREFIX_COMBOBOX) Then ' Dim cmb As ComboBox = CType(pnldesigner.Controls(MyPattern), ComboBox) ' input_value = cmb.Text ' End If ' sql_Statement = sql_Statement.ToString.Replace(element.Value, input_value) ' Catch ex As Exception ' LOGGER.Info("Unexpected Error in Checking control values for Variable SQL Result - ERROR: " & ex.Message) ' End Try 'Next _dependingControl_in_action = True Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _dependingControl_in_action = False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try If box.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End If End Sub Public Sub onDGVRowValidating(ByVal sender As Object, ByVal e As DataGridViewCellCancelEventArgs) Dim dgv As DataGridView = sender Try Dim CONTROL_ID = DirectCast(dgv.Tag, ClassControlCreator.ControlMetadata).Guid ' VWPM_CONTROL_INDEXTableAdapter.cmdGetControlID(CURRENT_ProfilGUID, dgv.Name) Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, dgv.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) And DT.Rows.Count > 0 Then For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString If Not IsDBNull(ROW.Item(1)) And Not IsDBNull(ROW.Item(2)) Then Dim sql_Statement = ROW.Item(2) Dim cellvalue = dgv.Rows(dgv.Rows.Count - 2).Cells(0).Value.ToString() sql_Statement = sql_Statement.ToString.Replace(dgv.Name, cellvalue) Dim resultDT As DataTable = ClassDatabase.Return_Datatable_ConId(sql_Statement, ROW.Item(1)) If resultDT.Rows.Count >= 1 Then 'Nur dediziert einen Wert zurückerhalten For Each row1 As DataRow In resultDT.Rows Dim result = row1.Item(0) If Not IsNothing(result) Then pnldesigner.Controls(displayboxname).Text = result.ToString Exit For Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING" Exit For End If Next Else pnldesigner.Controls(displayboxname).Text = "NO RESULT" End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try End Sub Public Sub onLookUp0(sender As Object, e As System.EventArgs) Dim oLookup As LookupControl2 = sender Try If Not IsNothing(oLookup.SelectedValues) Then For Each ocont In oLookup.SelectedValues Dim o = ocont Next End If Catch ex As Exception End Try End Sub Public Sub onLookUp1(sender As Object, SelectedValues As List(Of String)) LOGGER.Debug("onLookup1") If FormLoaded = False Then Exit Sub End If Dim oLookup As LookupControl2 = sender Try If Not IsNothing(SelectedValues) Then If SelectedValues.Count = 1 Then Dim oLOOKUPValue = SelectedValues.Item(0) Dim oLOOKUPName = oLookup.Name Dim oControlID = DirectCast(oLookup.Tag, ClassControlCreator.ControlMetadata).Guid Dim filteredData As DataTable = DTCONTROLS.Clone() Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oLOOKUPName}%'" DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges) If filteredData.Rows.Count = 1 Then Dim oDEPENDING_GUID = filteredData.Rows(0).Item("GUID") Dim oDEPENDING_CtrlName = filteredData.Rows(0).Item("NAME") If _dependingControl_in_action = True Then Exit Sub End If If Not IsDBNull(filteredData.Rows(0).Item("CONNECTION_ID")) And Not IsDBNull(filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG")) Then Dim oSqlCommand = IIf(IsDBNull(filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG")), "", filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG")) oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) LOGGER.Debug(">>> sql after ReplaceAllValues: " & oSqlCommand) _dependingControl_in_action = True Dim oDTDEPENDING_RESULT As DataTable = ClassDatabase.Return_Datatable(oSqlCommand) Try 'Dim oDependingLookup As LookupControl2 = pnldesigner.Controls.Find(oDEPENDING_CtrlName, False).FirstOrDefault() For Each oControl As Control In pnldesigner.Controls If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_GUID Then If oControl.GetType.ToString = "System.Windows.Forms.TextBox" Then oControl.Text = oDTDEPENDING_RESULT.Rows(0).Item(0) Else Dim oDependingLookup As LookupControl2 = oControl oDependingLookup.DataSource = oDTDEPENDING_RESULT End If _dependingControl_in_action = False Exit For End If Next Catch ex As Exception LOGGER.Warn($"Error while setting depending control-value for [{oDEPENDING_CtrlName}]: " & ex.Message) _dependingControl_in_action = False End Try SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End If End If Catch ex As Exception LOGGER.Error(ex) End Try End Sub Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 And _Indexe_Loaded = True Then If cmb.Name = last_control.Name Then 'Abschluss() Else Try Dim CONTROL_ID = DirectCast(cmb.Tag, ClassControlCreator.ControlMetadata).Guid 'VWPM_CONTROL_INDEXTableAdapter.cmdGetControlID(CURRENT_ProfilGUID, cmb.Name) Dim sql = String.Format("select NAME,CONNECTION_ID,SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE PROFIL_ID = {0} AND SQL_UEBERPRUEFUNG LIKE '%{1}%'", CURRENT_ProfilGUID, cmb.Name) Dim DT As DataTable = ClassDatabase.Return_Datatable(sql) If Not IsNothing(DT) And DT.Rows.Count > 0 Then If _dependingControl_in_action = True Then Exit Sub End If Dim _Step = 0 For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString _Step = 1 If Not IsDBNull(ROW.Item("CONNECTION_ID")) And Not IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")) Then _Step = 2 Dim sql_Statement = IIf(IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")), "", ROW.Item("SQL_UEBERPRUEFUNG")) sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) _Step = 3 LOGGER.Debug(">>> sql after ReplaceAllValues: " & sql) '' Regulären Ausdruck zum Auslesen der Indexe definieren 'Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" '' einen Regulären Ausdruck laden 'Dim regulärerAusdruck As Text.RegularExpressions.Regex = New Text.RegularExpressions.Regex(preg) '' die Vorkommen im SQL-String auslesen 'Dim elemente As Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(sql_Statement) ''#### '' alle Vorkommen innerhalbd er Namenkonvention durchlaufen 'For Each element As Text.RegularExpressions.Match In elemente ' Try ' If LogErrorsOnly = False Then LOGGER.Info(" >> element in RegeX: " & element.Value) ' Dim MyPattern = element.Value.Substring(2, element.Value.Length - 3) ' Dim input_value ' If MyPattern.Contains(ClassControlCreator.PREFIX_TEXTBOX) Then ' Dim txt As TextBox = CType(pnldesigner.Controls(MyPattern), TextBox) ' input_value = txt.Text ' ElseIf MyPattern.Contains(ClassControlCreator.PREFIX_COMBOBOX) Then ' Dim cmb1 As ComboBox = CType(pnldesigner.Controls(MyPattern), ComboBox) ' input_value = cmb1.Text ' End If ' sql_Statement = sql_Statement.ToString.Replace(element.Value, input_value) ' Catch ex As Exception ' LOGGER.Info("Unexpected Error in Checking control values for Variable SQL Result ComboBox - ERROR: " & ex.Message) ' End Try 'Next 'If LogErrorsOnly = False Then LOGGER.Info(">>> sql_Statement after replacement: " & sql_Statement) _dependingControl_in_action = True _Step = 4 Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _Step = 5 _dependingControl_in_action = False End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Display SQL result (Combobox) for control: (" & _Step.ToString & ")" & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Eventhandler Variable SQL Result ComboBox - ERROR: " & ex.Message) End Try SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End Sub Private Sub Depending_Control_Set_Result(displayboxname As String, sqlCommand As String, sqlConnection As String) Try Dim resultDT As DataTable = ClassDatabase.Return_Datatable_ConStr(sqlCommand, sqlConnection) If Not IsNothing(resultDT) Then 'Ist das Control ein Control was mehrfachwerte enthalten kann If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_DATAGRIDVIEW) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_TABLE) Then If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Then Dim cmbpanel As ComboBox = pnldesigner.Controls(displayboxname) cmbpanel.DataSource = Nothing cmbpanel.DataSource = resultDT cmbpanel.DisplayMember = resultDT.Columns(0).ColumnName cmbpanel.ValueMember = resultDT.Columns(0).ColumnName Dim maxWith As Integer = cmbpanel.Width Using g As Graphics = Me.CreateGraphics For Each oItem As Object In cmbpanel.Items 'Für alle Einträge... Dim g1 As Graphics = cmbpanel.CreateGraphics If g1.MeasureString(Text, cmbpanel.Font).Width + 30 > maxWith Then maxWith = g1.MeasureString(Text, cmbpanel.Font).Width + 30 End If g1.Dispose() Next oItem End Using cmbpanel.DropDownWidth = maxWith ElseIf displayboxname.StartsWith(ClassControlCreator.PREFIX_DATAGRIDVIEW) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_TABLE) Then 'not implemented End If Else If resultDT.Rows.Count = 1 Then pnldesigner.Controls(displayboxname).Text = resultDT.Rows(0).Item(0).ToString Else pnldesigner.Controls(displayboxname).Text = "RESULT = NOTHING or MORE THAN 1 ROW" End If End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Depending_Control_Set_Result - ERROR: " & ex.Message) MsgBox("Unexpected error: " & ex.Message, MsgBoxStyle.Critical) End Try End Sub Public Sub OnDTPValueChanged(sender As System.Object, e As System.EventArgs) Dim dtp As DateTimePicker = sender If _Indexe_Loaded = True Then ValueDTP = dtp.Value If dtp.Name = last_control.Name Then ' Abschluss() Else SendKeys.Send("{TAB}") ControlHandleStarted = True End If End If End Sub Private Function CheckValueExists(ByVal control As Control) Try For Each dr As DataRow In DTVWCONTROL_INDEX.Rows If dr.Item("PROFIL_ID") = CURRENT_ProfilGUID And dr.Item("CTRL_NAME") = control.Name Then Dim check = dr.Item("SQL_UEBERPRUEFUNG") If IsDBNull(check) Then LOGGER.Debug("SQL Check is not configured!") Return True End If If check.ToString.Length > 0 And dr.Item("INDEX_NAME") <> "DD PM-ONLY FOR DISPLAY" Then Dim cs As String = 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 = "Der eingegebene Wert '" & control.Text & "' existiert nicht in der Datenbank!" My.Settings.Save() Return False End If Else Return True End If End If Next Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unvorhergesehener Fehler bei CheckValueExists:" & ex.Message) Return False End Try End Function Sub ShowFile_UniversalViewer(AktuelleIndexfile As String) Try KillU_Viewer() Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(VIEWER_UNIVERSAL, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler in ShowFile_UniversalViewer:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub 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 Sub Open_PDFXCHANGE(AktuelleIndexfile As String) Try Dim Proc As New Process Dim psi As New ProcessStartInfo(VIEWER_XCHANGE, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True psi.UseShellExecute = False Proc.StartInfo = psi Proc.Start() Do While process_User_exists(VIEWER_XCHANGE, "START") = False 'Warten bis PDF geladen ist Thread.Sleep(500) Loop Catch ex As Exception LOGGER.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in Open_PDFXCHANGE:") LOGGER.Info("Fehler in Open_PDFXCHANGE") LOGGER.Info(ex.Message) End Try End Sub Sub Open_Sumatra(AktuelleIndexfile As String) Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(VIEWER_SUMATRA, """" & AktuelleIndexfile & """") psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True psi.UseShellExecute = False Proc.StartInfo = psi Proc.Start() Catch ex As Exception LOGGER.Error(ex) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler in Open_Sumatra:") LOGGER.Info("Fehler in Open_Sumatra") LOGGER.Info(ex.Message) End Try End Sub Sub Open_PDF_withStandard() If WMDocPathWindows.ToLower.EndsWith(".pdf") = True Then Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(WMDocPathWindows) psi.WindowStyle = ProcessWindowStyle.Minimized Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() viewerID = Proc.Id End If End Sub Function ReplaceWindreamDriveLetter(Filepath As String) As String Return Filepath. Replace("W:", "\\windream\objects"). Replace("K:", "\\windream\objects") End Function Function Get_Next_GUID() As Integer Try LOGGER.Debug("Get_Next_GUID...") Dim newGUID As Integer LOGGER.Debug("Old Document_Path: " & OLD_Document_Path) Dim oBIT As Integer = 0 If PROFIL_sortbynewest = True Then oBIT = 1 End If Dim oSQL = $"SELECT [dbo].[FNPM_GET_NEXT_DOC_GUID] ({CURRENT_ProfilGUID},{oBIT},{CURRENT_DOC_GUID},'{USER_USERNAME}')" newGUID = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING, True) WMDocPathWindows = "" CURRENT_DOC_PATH = "" CURRENT_WMFILE = Nothing If newGUID > 0 Then LOGGER.Debug("newGUID: " & newGUID.ToString) ElseIf newGUID <> 0 Then LOGGER.Info(" >> ACHTUNG: Ausnahme in GetNextGUID - Es konnte keine GUID abgerufen werden!") newGUID = 0 End If Return newGUID Catch ex As Exception LOGGER.Error(ex) oErrorMessage = "Unvorhergesehener Fehler in Get_Next_GUID: " & ex.Message LOGGER.Info(">> Unvorhergesehener Fehler in Get_Next_GUID:: " & ex.Message, True) Return 0 End Try End Function 'lädt die windream-Files für das Profil Sub Refresh_FileList() 'windream-Suche für Profil starten '_windreamPM = New ClassPMWindream() If PROFIL_sortbynewest = True Then TBPM_PROFILE_FILESTableAdapter.FillBy_Newest(DD_DMSLiteDataSet.TBPM_PROFILE_FILES, CURRENT_ProfilGUID) Else TBPM_PROFILE_FILESTableAdapter.Fill(DD_DMSLiteDataSet.TBPM_PROFILE_FILES, CURRENT_ProfilGUID) End If If CURRENT_DOC_GUID = 0 Then Dim DT As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_FILES CURRENT_DOC_GUID = 0 'DT.Rows(0).Item("GUID") AnzDoks = DT.Rows.Count Else AnzDoks = 1 WMDocPathWindows = CURRENT_DOC_PATH End If tsslblDocID.Text = "Document-ID: " & CURRENT_DOC_ID & " - GUID: " & CURRENT_DOC_GUID End Sub Sub Close_document_viewer() 'Vorherige Datei Schliessen If CURRENT_HTML_DOC <> "" Then If File.Exists(CURRENT_HTML_DOC) Then File.Delete(CURRENT_HTML_DOC) End If End If If pdfxchange = True Or sumatra = True Or VIEWER_PDF = "system" Then Close_PDF_Viewer(WMDocPathWindows) End If If CURRENT_WMFILE Is Nothing = False Then If CURRENT_WMFILE.aLocked Then CURRENT_WMFILE.Save() ' unlock the windream object CURRENT_WMFILE.unlock() End If End If End Sub Sub PdfControls_visible(visible As Boolean) If visible = False Then pnlpdf.Dock = DockStyle.None Else pnlpdf.Dock = DockStyle.Fill End If pnlpdf.Visible = visible End Sub Private Function CreateWMObject() As String LOGGER.Debug($"in GetWMDocFileString...'") Dim oWMRELPATH As String = CURRENT_DT_CONFIG.Rows.Item(0).Item("WM_REL_PATH") If oWMRELPATH.EndsWith("\") = False Then oWMRELPATH = oWMRELPATH & "\" End If Dim oWMOwnPath = WMDocPathWindows.Replace(oWMRELPATH, "") LOGGER.Debug($"oWMOwnPath: {oWMOwnPath}") Try Dim oNormalizedPath = WINDREAM.NormalizePath(oWMOwnPath) CURRENT_WMFILE = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oNormalizedPath) WMDocFileString = oNormalizedPath LOGGER.Debug("WMDocFileString: " & WMDocFileString) Return True Catch ex As Exception Dim _err1 As Boolean = False LOGGER.Error(ex) allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "error in creating WMObject - DocGUID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, USER_USERNAME) LOGGER.Info("Unexpected error creating WMObject(1) in GetWMDocFileString: " & ex.Message) LOGGER.Info("Error Number: " & Err.Number.ToString) errormessage = $"Could not create a WMObject(1) for [{oWMOwnPath}]!" frmError.ShowDialog() WMDocFileString = "" Return False End Try End Function Private Function GetWMDocPathWindows(_CheckStandard As Integer) Try Dim oResult As String Dim oSQL = $"SELECT dbo.FNPM_GET_FILEPATH ({CURRENT_DOC_GUID},{_CheckStandard})" oResult = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING) LOGGER.Debug($"Checking file [{oResult}] exists?...") If File.Exists(oResult) = False Then If USER_USERNAME = "SchreiberM" Then oResult = "\\dd-gan.local.digitaldata.works\DD-DFSR01\UserObjects\UserFiles\schreiberm\Desktop\AANG-3302-swbn.pdf" Else LOGGER.Debug($"GetWMDocPathWindows returned false - trying with standard again...") oSQL = $"SELECT [dbo].[FNPM_GET_FILEPATH] ({CURRENT_DOC_GUID},1)" oResult = ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING) LOGGER.Debug($"Checking file [{oResult}] exists?...") If File.Exists(oResult) = False Then LOGGER.Warn($"File {oResult} not existing!") Return False End If End If End If WMDocPathWindows = oResult OLD_Document_Path = WMDocPathWindows CURRENT_DOC_PATH = WMDocPathWindows LOGGER.Debug($"CURRENT_DOC_PATH: {CURRENT_DOC_PATH}") Return True Catch ex As Exception WMDocPathWindows = "" OLD_Document_Path = "" CURRENT_DOC_PATH = "" errormessage = $"Unexpected error in GetWMDocPathWindows: [{ex.Message}]!" frmError.ShowDialog() Return False End Try End Function Sub Load_Next_Document(first As Boolean) CURRENT_WMFILE = Nothing LOGGER.Debug("CURRENT_WMFILE nothing gesetzt") activate_controls(False) oErrorMessage = "" WMDocPathWindows = "" WMDocFileString = "" CURRENT_HTML_DOC = "" 'Me.lblerror.Visible = False _Indexe_Loaded = False LOGGER.Debug("In Load_Next_Document") 'Try If first = True Then LOGGER.Debug("First Document") CURRENT_WMFILE = Nothing Else LOGGER.Debug("Following Document ") docCounter += 1 End If ' Controls nicht beim ersten Laden leeren If first = False Then Clear_all_Input() End If 'Select Case navtype ' Case "next" ' Case "previous" ' Case "first" ' Case "last" 'End Select LOGGER.Debug($"CURRENT_JUMP_DOC_GUID: {CURRENT_JUMP_DOC_GUID}'") If CURRENT_JUMP_DOC_GUID = 0 Then CURRENT_DOC_GUID = Get_Next_GUID() ElseIf first = False Then CURRENT_DOC_GUID = 0 End If LOGGER.Debug("Dokument-GUID: '" & CURRENT_DOC_GUID.ToString & "'") If CURRENT_DOC_GUID > 0 Then If GetWMDocPathWindows(0) = False Then MsgBox("Could not acces the file! Check the log!", MsgBoxStyle.Critical, "") Exit Sub End If If IDB_ACTIVE = False Then If CreateWMObject() = False Then Exit Sub End If End If 'Beschriftung des Navigators 'lblNavigator_anzDok.Text = position & " of " & Anzahl_ValDoks & " files" If WMDocPathWindows <> String.Empty Then ' >> >> >> >> >> >>##### Das Dokument in Bearbeitung nehmen ########################### TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(True, USER_USERNAME, CURRENT_DOC_GUID) ' ############ Infos eintragen ################# tsslblDocID.Text = "Document-ID: " & CURRENT_DOC_ID & " - DocGUID: " & CURRENT_DOC_GUID ' txtDateipfad.Text = Document_Path tstrlbl_Info.Text = "Datei " & docCounter.ToString & " von " & Anzahl_ValDoks.ToString LOGGER.Info(">> Validierung für Dokument '" & WMDocPathWindows & "' gestartet") tsslblDocID.Text = "Document-ID: " & CURRENT_DOC_ID & " - GUID: " & CURRENT_DOC_GUID LOGGER.Debug("AllDocInfo created...") If IDB_ACTIVE = False Then oErrorMessage = Windream_get_Doc_info() Else ' oErrorMessage = IDB_GetDocInfo() End If If oErrorMessage = "" Then Me.grpbxMailBody.Visible = False Me.grpBetreff.Visible = False load_viewer() If WMDocPathWindows.ToLower.EndsWith(".pdf") Then ToolStripButtonAnnotation.Visible = True Else ToolStripButtonAnnotation.Visible = False End If LOGGER.Debug("Viewer geladen") FillIndexValues(first) For Each oControl As Control In pnldesigner.Controls LoadSQLData(oControl, DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid) Next LOGGER.Debug("Indexmaske geladen") LOGGER.Debug("") 'Nun im Vektoprindex loggen das das Profil geladen wurde 'If PROFIL_VEKTORINDEX <> "" Then ' Dim Profilstring = "DD-PM" & Delimiter & "Profil: '" & PROFIL_NAME & "'" & Delimiter & USER_NAME & Delimiter & Now.ToString ' If Indexiere_VektorfeldPM(Profilstring, PROFIL_VEKTORINDEX) = False Then ' If LogErrorsOnly = False Then LOGGER.Info(" >> Profilname erfolgreich in Vektorfeld PM geschrieben") ' 'Else ' ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' ' My.Settings.Save() ' ' frmError.ShowDialog() ' ' _error = True ' End If 'End If 'Nun loggen das das Profil geladen wurde If PROFIL_LOGINDEX <> "" Then Dim Profilstring = $"DD-PMLog{Delimiter}Loaded profile: [{CURRENT_ProfilName}]{Delimiter}{USER_USERNAME}{Delimiter}{Now.ToString}" If IDB_ACTIVE = False Then WMIndexVectofield(Profilstring, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, Profilstring) LOGGER.Debug("Profilname erfolgreich in Vektorfeld LOG geschrieben") 'Else ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' My.Settings.Save() ' frmError.ShowDialog() ' _error = True End If End If activate_controls(True) Me.BringToFront() Else errormessage = oErrorMessage frmError.ShowDialog() End If Else errormessage = oErrorMessage frmError.ShowDialog() End If Else If oErrorMessage <> "" Then errormessage = oErrorMessage frmError.ShowDialog() Else LOGGER.Info(" >> Ende des Profils - Kein weiteres Dokument!") LOGGER.Info("") MsgBox("Kein weiteres Dokument gefunden - Ende des Profils!" & vbNewLine & "Das Formular wird nun geschlossen.", MsgBoxStyle.Information, "Hinweis:") activate_controls(True) Me.Close() End If End If 'Catch ex As Exception ' LOGGER.Error(ex) ' allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Unvorhergesehener Fehler bei Load_Next_Document - DocGUID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, USER_USERNAME) ' errormessage = "Unvorhergesehener Fehler bei Load_Next_Document:" & ex.Message ' My.Settings.Save() ' LOGGER.Info("Unvorhergesehener Fehler in Load_Next_Document: " & ex.Message) ' frmError.ShowDialog() 'End Try End Sub Sub load_viewer() MyDocViewer.LoadFile(WMDocPathWindows) 'If VIEWER_ALL = "uviewer" Then ' pdfxchange = False ' sumatra = False ' If WMDocPathWindows.ToLower.EndsWith(".msg") Then ' Show_Email() ' Else ' ShowFile_UniversalViewer(WMDocPathWindows) ' End If 'ElseIf VIEWER_ALL = "docview" Then ' PdfControls_visible(False) ' If WMDocPathWindows.ToLower.EndsWith(".pdf") And VIEWER_PDF <> "none" Then ' Select Case VIEWER_PDF ' Case "internal" ' SplitContainer1.Panel2Collapsed = False ' PdfViewer1.LoadDocument(WMDocPathWindows) ' LOGGER.Debug("Internal Viewer Path: " & WMDocPathWindows) ' PdfControls_visible(True) ' Me.Size = My.Settings.frmValidation_Size_PDFViewer ' 'PdfViewer1.ZoomFactor = PDFViewer_ZoomMode ' PdfViewer1.ZoomMode = DevExpress.XtraPdfViewer.PdfZoomMode.FitToWidth ' pdfxchange = False ' sumatra = False ' Case "pdfxchange" ' SplitContainer1.Panel2Collapsed = True ' Open_PDFXCHANGE(WMDocPathWindows) ' pdfxchange = True ' sumatra = False ' System.Threading.Thread.Sleep(1000) ' Me.Size = My.Settings.frmValidatorSize ' Case "sumatra" ' SplitContainer1.Panel2Collapsed = True ' Open_Sumatra(WMDocPathWindows) ' sumatra = True ' pdfxchange = False ' System.Threading.Thread.Sleep(1000) ' Me.Size = My.Settings.frmValidatorSize ' Case "system" ' SplitContainer1.Panel2Collapsed = True ' sumatra = False ' pdfxchange = False ' Open_PDF_withStandard() ' System.Threading.Thread.Sleep(1000) ' Me.Size = My.Settings.frmValidatorSize ' End Select ' ElseIf WMDocPathWindows.ToLower.EndsWith(".msg") Then ' Show_Email() ' Else ' SplitContainer1.Panel2Collapsed = True ' Me.Size = My.Settings.frmValidatorSize ' pdfxchange = False ' sumatra = False ' DocView = Nothing ' DocView = CreateObject("WMPViewXNG.Viewer") ' ' open the viewer ' viewer_string = CURRENT_WMFILE.aPath.ToString ' DocView.ViewFile(viewer_string) ' End If 'Else ' SplitContainer1.Panel2Collapsed = True ' PdfControls_visible(False) ' Me.Size = My.Settings.frmValidatorSize ' pdfxchange = False ' sumatra = False ' DocView = Nothing ' DocView = CreateObject("WMPViewXNG.Viewer") ' ' open the viewer ' viewer_string = CURRENT_WMFILE.aPath.ToString ' DocView.ViewFile(viewer_string) 'End If End Sub 'Sub Show_Email() ' Me.grpBetreff.Dock = DockStyle.Top ' Me.grpbxMailBody.Dock = DockStyle.Fill ' Dim msg_email As New Msg.Message(WMDocPathWindows) ' 'Eine tempfile generieren ' Dim tempFilename = My.Computer.FileSystem.GetTempFileName() ' Dim name = Path.GetFileNameWithoutExtension(tempFilename) ' tempFilename = Path.Combine(Path.GetDirectoryName(tempFilename), name & ".html") ' 'tempfile löschen ' If My.Computer.FileSystem.FileExists(tempFilename) Then ' My.Computer.FileSystem.DeleteFile(tempFilename) ' End If ' Me.txtBetreff.Text = msg_email.Subject ' Try ' Dim wFile As System.IO.FileStream ' Dim byteData() As Byte ' byteData = msg_email.BodyHtml ' ' MsgBox(msg_email.InternetCodePage) ' ' wFile = New FileStream(tempFilename, FileMode.Append) ' ' wFile.Write(byteData, 0, byteData.Length) ' ' wFile.Close() ' 'Catch ex As IOException ' ' MsgBox(ex.ToString) ' 'End Try ' Dim vIn() As Byte = msg_email.BodyHtml ' Dim vOut As String = System.Text.Encoding.UTF8.GetString(vIn) ' File.WriteAllText(tempFilename, vOut, System.Text.Encoding.UTF8) ' CURRENT_HTML_DOC = tempFilename ' Me.tslblWebbrowser.Text = CURRENT_HTML_DOC ' WebBrowser.Navigate("file:///" & CURRENT_HTML_DOC) ' SplitContainer1.Panel2Collapsed = False ' Me.Size = My.Settings.frmValidation_Size_Email ' Me.grpbxMailBody.Visible = True ' Me.grpBetreff.Visible = True ' Catch ex As Exception ' LOGGER.Error(ex) ' errormessage = "Unvorhergesehener Fehler bei Show_Email:" & ex.Message ' LOGGER.Info("Unvorhergesehener Fehler in Show_Email: " & ex.Message) ' My.Settings.Save() ' frmError.ShowDialog() ' End Try 'End Sub Sub activate_controls(status As Boolean) Me.pnldesigner.Enabled = status Me.btnSave.Enabled = status End Sub Private Function Windream_get_Doc_info() Try 'If CultureInfo.CurrentUICulture.ThreeLetterISOLanguageName = "eng" Then ' My.Settings.vIDX_DMS_ERSTELLT = "DMS Created" ' dmsCreated = "DMS Created" ' My.Settings.vIDX_DMS_ERSTELLT_Zeit = "DMS Created Time" ' dmscreatedtime = "DMS Created Time" ' My.Settings.Save() 'Else 'End If Try LOGGER.Debug($"GetVariableValue [{INDEX_DMS_ERSTELLT}]...") CURRENT_DOC_CREATION_DATE = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT) Catch ex As Exception LOGGER.Error(ex) If ex.Message.Contains("Variable: " & INDEX_DMS_ERSTELLT & " not found!") Then LOGGER.Info("1. Ausnahme in Windream_get_Doc_info: Variable: " & INDEX_DMS_ERSTELLT & " not found", True) LOGGER.Info("1. Ausnahme-Fehler: " & ex.Message) If INDEX_DMS_ERSTELLT = "DMS Created" Then INDEX_DMS_ERSTELLT = "DMS erstellt" INDEX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS erstellt") Else INDEX_DMS_ERSTELLT = "DMS Created" INDEX_DMS_ERSTELLT_ZEIT = "DMS Created Time" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt Time") End If CURRENT_DOC_CREATION_DATE = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT) Else LOGGER.Info("Fehler in Windream_get_Doc_info 1: " & ex.Message) Return "Fehler in Windream_get_Doc_info 1: " & ex.Message End If End Try LOGGER.Debug("DMS-Erstellt aus WD: " & CURRENT_DOC_CREATION_DATE) Try LOGGER.Debug($"GetVariableValue [{INDEX_DMS_ERSTELLT_ZEIT}]...") CURRENT_DOC_CREATION_TIME = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Catch ex As Exception If ex.Message.Contains("Variable: " & INDEX_DMS_ERSTELLT_ZEIT & " not found!") Then LOGGER.Info("1. Ausnahme in Windream_get_Doc_info: Variable: " & INDEX_DMS_ERSTELLT_ZEIT & " not found", True) If INDEX_DMS_ERSTELLT = "DMS Created" Then INDEX_DMS_ERSTELLT = "DMS erstellt" INDEX_DMS_ERSTELLT_ZEIT = "DMS erstellt (Zeit)" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS erstellt (Zeit)") Else INDEX_DMS_ERSTELLT = "DMS Created" INDEX_DMS_ERSTELLT_ZEIT = "DMS Created Time" CONFIG.Config.IndexDmsErstellt = INDEX_DMS_ERSTELLT CONFIG.Config.IndexDmsErstelltZeit = INDEX_DMS_ERSTELLT_ZEIT CONFIG.Save() 'SaveMySettingsValue("IDX_DMS_ERSTELLT", "DMS Created") 'SaveMySettingsValue("IDX_DMS_ERSTELLT_ZEIT", "DMS Created Time") End If LOGGER.Debug($"GetVariableValue (2) [{INDEX_DMS_ERSTELLT_ZEIT}]...") CURRENT_DOC_CREATION_TIME = CURRENT_WMFILE.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Else LOGGER.Error(ex) LOGGER.Info("Fehler in Windream_get_Doc_info 3: " & ex.Message) Return "Fehler in Windream_get_Doc_info 3: " & ex.Message End If End Try LOGGER.Debug("DMSErstelltZeit aus WD: " & CURRENT_DOC_CREATION_TIME) If CURRENT_DOC_CREATION_TIME.Length > 11 Then CURRENT_DOC_CREATION_DATE = CURRENT_DOC_CREATION_DATE & " " & CURRENT_DOC_CREATION_TIME.Substring(10) Else CURRENT_DOC_CREATION_DATE = CURRENT_DOC_CREATION_DATE & " " & CURRENT_DOC_CREATION_TIME End If Return "" Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Fehler in Windream_get_Doc_info (GENERELL): " & ex.Message) Return "Fehler 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, Delimiter) If VektorArray(1).ToString.ToLower = name.ToLower Then value = VektorArray(2) Exit For End If Next End If End If If value Is Nothing Then value = "" Return value Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler in ReturnVektor_IndexValue: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Info("Fehler in ReturnVektor_IndexValue: " & ex.Message) Return "" End Try End Function Private Function GetVariableValuefromSource(oSourceIndexName) As Object Try Dim oValuefroMSource If IDB_ACTIVE = False Then oValuefroMSource = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) Else oValuefroMSource = IDBData.GetVariableValue(oSourceIndexName) End If Return oValuefroMSource Catch ex As Exception LOGGER.Error(ex) Return Nothing End Try End Function Sub FillIndexValues(first As Boolean) Dim oControlType As String Dim oIndexName As String ' Try If DTVWCONTROL_INDEX.Rows.Count > 0 Then Dim oCount As Integer = 0 For Each oControl As Control In Me.pnldesigner.Controls Dim oValueFromSource Dim oControlId = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid Dim oControlRow = (From form In DTVWCONTROL_INDEX.AsEnumerable() Select form Where form.Item("GUID") = oControlId).Single() Dim oType As String = oControl.GetType.ToString Dim oTyp As String = oControlRow.Item("CTRL_TYPE") Dim oSourceIndexName As String = oControlRow.Item("INDEX_NAME") ' Wenn kein defaultValue existiert, leeren String setzen Dim oDefaultValue As String = NotNull(oControlRow.Item("DEFAULT_VALUE"), String.Empty) oIndexName = oSourceIndexName Dim oLoadIndex As Boolean = oControlRow.Item("LOAD_IDX_VALUE") LOGGER.Debug("INDEX: " & oSourceIndexName & " - CONTROLNAME: " & oControl.Name & " - LOAD IDXVALUES: " & oLoadIndex.ToString) _CURRENT_INDEX_ARRAY(oCount, 0) = oSourceIndexName Select Case oType Case "System.Windows.Forms.TextBox" Try oControlType = "Textbox" If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then ' Wenn kein Index exisitiert, defaultValue laden oControl.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue LOGGER.Debug("Indexwert soll nicht geladen werden.") Exit Select End If If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else oValueFromSource = GetVariableValuefromSource(oSourceIndexName) If oValueFromSource Is Nothing Then oValueFromSource = "" Else If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug("TextBox with VektorField: " & oSourceIndexName) Try LOGGER.Debug($"Length of Vektorarray: {oValueFromSource.length}") Catch ex As Exception LOGGER.Info($"Error in gettin the lenth of vektorfield {oSourceIndexName} - {ex.Message}") End Try If oValueFromSource.length = 1 Then oValueFromSource = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") oValueFromSource = oValueFromSource(0) End If LOGGER.Debug($"wertWD has been saved...") End If End If End If Try oControl.Text = NotNull(oValueFromSource, oDefaultValue) _CURRENT_INDEX_ARRAY(oCount, 1) = NotNull(oValueFromSource, oDefaultValue) Catch ex As Exception LOGGER.Info("ERROR while converting defaultValue [" & oDefaultValue & "]: " & ex.Message) oControl.Text = "" _CURRENT_INDEX_ARRAY(oCount, 1) = "" End Try End If Catch ex As Exception LOGGER.Error(ex) errormessage = $"Unvorhergesehener Fehler bei FillIndexValues TextBox [{oControl.Name}]:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndexValuesTextBox: " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType) LOGGER.Info(">> Indexname windream: " & oIndexName) Exit Sub End Try Case "System.Windows.Forms.ComboBox" oControlType = "ComboBox" Dim oMyCombobox As ComboBox = oControl Try If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then If oDefaultValue = String.Empty Then oMyCombobox.SelectedIndex = -1 Else oMyCombobox.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue End If LOGGER.Debug($" oMyComboBox {oMyCombobox.Name}: Indexwert soll nicht geladen werden.") Exit Select End If If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else oValueFromSource = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) End If If oValueFromSource Is Nothing Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} - Indexvalue from index {oSourceIndexName}: Nothing") If oDefaultValue = String.Empty Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wurde nicht gefunden") oMyCombobox.SelectedIndex = -1 Else LOGGER.Debug($"oMyComboBox {oMyCombobox.Name}-defaultValue wird geladen") oMyCombobox.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue 'cmb.SelectedIndex = cmb.FindStringExact(defaultValue) End If Else If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} - Combobox with VektorField: " & oSourceIndexName) Try LOGGER.Debug($"Length of Vektorarray: {oValueFromSource.length}") Catch ex As Exception LOGGER.Info($"Error in gettin the length of vektorfield {oSourceIndexName} - {ex.Message}") End Try If oValueFromSource.length = 1 Then oValueFromSource = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") oValueFromSource = oValueFromSource(0) End If LOGGER.Debug($"wertWD has been saved...") Else End If LOGGER.Debug($"Indexwert from Index {oSourceIndexName}: {oValueFromSource}") LOGGER.Debug($"Items in Combobox: {oMyCombobox.Items.Count}") _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource LOGGER.Debug($"_CURRENT_INDEX_ARRAY set...") If oMyCombobox.Items.Count = 0 Then ' If LogErrorsOnly = False Then LOGGER.Info($"Index Wert wurde gesetzt") oMyCombobox.Text = oValueFromSource Else ' If LogErrorsOnly = False Then LOGGER.Info($"Index Wert wurde ausgewählt") oMyCombobox.SelectedIndex = oMyCombobox.FindStringExact(oValueFromSource) LOGGER.Debug($"oMyComboBox {oMyCombobox.Name} .SelectedIndex: {oMyCombobox.SelectedIndex}") End If End If End If LOGGER.Debug("") Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndexValues(Combobox: " & oMyCombobox.Name & "): " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType) LOGGER.Info(">> Indexname windream: " & oIndexName) errormessage = "Unvorhergesehener Fehler bei FillIndexValues(Combobox: " & oMyCombobox.Name & "): " & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() End Try Case "System.Windows.Forms.DataGridView" oControlType = "DataGridView" Dim dgv As DataGridView = oControl If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Then LOGGER.Debug("Indexwert soll nicht geladen werden.") Exit Select End If LOGGER.Debug($"getting wmValue for Index {oSourceIndexName}...") Dim wertWD = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then Select Case oTyp 'Tabellendarstellung Case "TABLE" Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = " & oControlId) Dim SpaltenWerte As String() LOGGER.Debug($"{dt.Rows.Count} Columns configured for control {oControlId}.") If dt.Rows.Count > 1 Then For Each Zeile As Object In wertWD LOGGER.Debug($"vektorrow Value {Zeile.ToString}...") SpaltenWerte = Split(Zeile, Delimiter) Select Case dt.Rows.Count Case 1 dgv.Rows.Add(New String() {Zeile.ToString}) Case 2 If SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), ""}) End If Case 3 If SpaltenWerte.Length = 3 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) ElseIf SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), "", ""}) End If Case 4 If SpaltenWerte.Length = 4 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) ElseIf SpaltenWerte.Length = 3 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) ElseIf SpaltenWerte.Length = 2 Then dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) Else dgv.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) End If End Select Next End If Case Else 'es handelt sich um ein einfaches Vektorfeld mit einem Wert For Each obj As Object In wertWD If obj Is Nothing = False Then dgv.Rows.Add(New String() {obj.ToString}) End If Next End Select End If End If End If Case "DevExpress.XtraGrid.GridControl" oControlType = "DataGridView" Dim dgv As GridControl = oControl If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then If oLoadIndex = False Then LOGGER.Debug("Indexwert soll nicht geladen werden.") Exit Select End If LOGGER.Debug($"getting wmValue for Index {oSourceIndexName}...") ' Dim wertWD = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) oValueFromSource = GetVariableValuefromSource(oSourceIndexName) If oValueFromSource Is Nothing = False Then Dim omytype = oValueFromSource.GetType.ToString 'Es wird gegen ein Vektorfeld nachindexiert If omytype.Contains("System.Object") Or omytype = "System.Data.DataTable" Or omytype = "System.String" Then Select Case oTyp 'Tabellendarstellung Case "TABLE" Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = " & oControlId) Dim SpaltenWerte As String() LOGGER.Debug($"{dt.Rows.Count} Columns configured for control {oControlId}.") If dt.Rows.Count >= 1 Then Dim oDataSource As DataTable = dgv.DataSource oDataSource.Rows.Clear() If IDB_ACTIVE = False Then For Each Zeile As Object In oValueFromSource LOGGER.Debug($"vektorrow Value {Zeile.ToString}...") SpaltenWerte = Split(Zeile, Delimiter) Select Case dt.Rows.Count Case 1 If SpaltenWerte.Length = 2 Then End If oDataSource.Rows.Add(New String() {Zeile.ToString}) 'dgv.Rows.Add(New String() {Zeile.ToString}) Case 2 If SpaltenWerte.Length = 2 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) Else oDataSource.Rows.Add(New String() {SpaltenWerte(0), ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), ""}) End If Case 3 If SpaltenWerte.Length = 3 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) ElseIf SpaltenWerte.Length = 2 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) Else oDataSource.Rows.Add(New String() {SpaltenWerte(0), "", ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), "", ""}) End If Case 4 If SpaltenWerte.Length = 4 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) ElseIf SpaltenWerte.Length = 3 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) ElseIf SpaltenWerte.Length = 2 Then oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) Else oDataSource.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) 'dgv.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) End If End Select Next Else If omytype = "System.String" Then SpaltenWerte = Split(oValueFromSource.ToString, Delimiter) Select Case SpaltenWerte.Length Case 2 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) Case 3 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) Case 4 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) End Select ElseIf omytype = "System.Data.DataTable" Then Dim oMyDatatable As DataTable = oValueFromSource For Each oRow As DataRow In oMyDatatable.Rows LOGGER.Debug($"IDB ROW Vector {oRow.Item(0).ToString}...") SpaltenWerte = Split(oRow.Item(0).ToString, Delimiter) Select Case SpaltenWerte.Length Case 2 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) Case 3 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) Case 4 oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) End Select 'Select Case oMyDatatable.Rows.Count ' Case 1 ' oDataSource.Rows.Add(New String() {oRow.Item(0).ToString}) ' 'dgv.Rows.Add(New String() {Zeile.ToString}) ' Case 2 ' If SpaltenWerte.Length = 2 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1)}) ' Else ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), ""}) ' End If ' Case 3 ' If SpaltenWerte.Length = 3 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2)}) ' ElseIf SpaltenWerte.Length = 2 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), ""}) ' Else ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), "", ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), "", ""}) ' End If ' Case 4 ' If SpaltenWerte.Length = 4 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), SpaltenWerte(3)}) ' ElseIf SpaltenWerte.Length = 3 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), SpaltenWerte(2), ""}) ' ElseIf SpaltenWerte.Length = 2 Then ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), SpaltenWerte(1), "", ""}) ' Else ' oDataSource.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) ' 'dgv.Rows.Add(New String() {SpaltenWerte(0), "", "", ""}) ' End If 'End Select Next End If End If End If Case Else 'es handelt sich um ein einfaches Vektorfeld mit einem Wert Dim oDataSource As DataTable = dgv.DataSource For Each obj As Object In oValueFromSource If obj Is Nothing = False Then oDataSource.Rows.Add(New String() {obj.ToString}) 'dgv.Rows.Add(New String() {obj.ToString}) End If Next End Select End If Else If first = False Then Dim oDataSource As DataTable = dgv.DataSource If oDataSource.Rows.Count > 0 Then oDataSource.Rows.Clear() End If End If End If End If Case "System.Windows.Forms.CheckBox" LOGGER.Debug("Loading checkbox.") oControlType = "CheckBox" If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then Dim chk As CheckBox = oControl If oLoadIndex = False Or oSourceIndexName = "DD PM-ONLY FOR DISPLAY" Then LOGGER.Debug("Indexwert soll nicht geladen werden.") Else If oDefaultValue <> String.Empty Then Dim result = False _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue If Boolean.TryParse(oDefaultValue, result) Then chk.Checked = result Exit Select End If End If End If LOGGER.Debug("Loading Bool-Value from Windream.") If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) Else Try LOGGER.Debug($"..Now GetVariableValue({oSourceIndexName})...") oValueFromSource = GetVariableValuefromSource(oSourceIndexName) Catch ex As Exception LOGGER.Warn($"Could not get the windreamValue for CheckboxIndex: {oSourceIndexName} [{ex.Message}]") End Try End If If oValueFromSource Is Nothing Then LOGGER.Info(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Check defaultvalue") chk.Checked = False Else LOGGER.Debug("Index value loaded: " & oValueFromSource.ToString) _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString If oValueFromSource.ToString = "" Then LOGGER.Info(">> Versuch, default Value zu laden") If oDefaultValue <> String.Empty Then Dim result = False If Boolean.TryParse(oDefaultValue, result) Then LOGGER.Info(">> defaultValue wurde geladen") chk.Checked = result Else chk.Checked = False End If Else LOGGER.Info(">> defaultValue war leer") chk.Checked = False End If Else Dim _value If oValueFromSource.ToString = "System.Object[]" Then LOGGER.Debug("CheckBoxValue with VectorField: " & oSourceIndexName) If oValueFromSource.length = 1 Then _value = oValueFromSource(0) Else ' LOGGER.Info(" >> Vectorfield " & oSourceIndexName & "' contains more then one value - First value will be used") _value = oValueFromSource(0) End If Else LOGGER.Debug("Value is not nothing and also not System.Object[]...") _value = oValueFromSource End If Try Select Case CBool(_value) Case True LOGGER.Info(">> CBool(_value) = True") chk.Checked = True Case Else LOGGER.Info(">> CBool(_value) = False") chk.Checked = False End Select Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Unvorhergesehener Fehler bei CBool(wertWD) - CheckBox: " & ex.Message & vbNewLine & "Wert WD: " & oValueFromSource.ToString, True) chk.Checked = False End Try End If End If End If Case "DigitalData.Controls.LookupGrid.LookupControl2" Try Dim oLookup As LookupControl2 = oControl oValueFromSource = GetVariableValuefromSource(oSourceIndexName) 'Dim oWindreamValue = CURRENT_WMFILE.GetVariableValue(oSourceIndexName) Try oLookup.SelectedValues = Nothing oLookup.SelectedValues = New List(Of String) Catch ex As Exception End Try If Not IsNothing(oValueFromSource) Then Dim oMyType = oValueFromSource.GetType.ToString If oMyType.Contains("System.Object") Or oMyType = "System.Data.DataTable" Then Dim oArrlist As New List(Of String) If IDB_ACTIVE = False Then For Each oVectorRow As Object In oValueFromSource Dim Ocontent = oVectorRow.ToString oArrlist.Add(Ocontent) Next Else Dim myDT As DataTable = oValueFromSource For Each oVectorRow As DataRow In myDT.Rows Dim Ocontent = oVectorRow.Item(0) oArrlist.Add(Ocontent) Next End If oLookup.SelectedValues = oArrlist _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString Else Dim oArrlist As New List(Of String) oArrlist.Add(oValueFromSource.ToString) oLookup.SelectedValues = oArrlist _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString End If Else If Not IsNothing(oLookup.SelectedValues) Then If oLookup.SelectedValues.Count = 0 And oDefaultValue <> String.Empty Then Dim oValues As List(Of String) = oDefaultValue.Split(",").ToList() oLookup.SelectedValues = oValues End If End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" - Unvorhergesehener Unexpected error in AddVorschlag_ComboBox - Indexname: " & oIndexName & " - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Add LookupControl2:") End Try Case "System.Windows.Forms.DateTimePicker" oControlType = "DateTimePicker" Dim DTP As DateTimePicker = oControl If oSourceIndexName = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & oControl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If oSourceIndexName Is Nothing = False Then Try If oSourceIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then LOGGER.Debug("DATE über PM-Vektor holen") oValueFromSource = ReturnVektor_IndexValue(oSourceIndexName) LOGGER.Info(">> DTP is """) Else oValueFromSource = GetVariableValuefromSource(oSourceIndexName) End If If oValueFromSource Is Nothing Then oValueFromSource = "" Dim tempdate As Date = CDate("01.01.0001 00:00:00") If oValueFromSource.ToString.Length > 0 Then Try tempdate = CDate(oValueFromSource) LOGGER.Debug("DATE konnte umgewandelt werden") Catch ex As Exception LOGGER.Error(ex) ValueDTP = tempdate LOGGER.Debug("DATE wurde auf heute gesetzt") End Try DTP.Text = tempdate Else LOGGER.Debug("DATE ist leer") ValueDTP = tempdate DTP.Text = tempdate End If _CURRENT_INDEX_ARRAY(oCount, 1) = oValueFromSource.ToString Catch ex As Exception LOGGER.Error(ex) errormessage = "Unvorhergesehener Fehler bei DTP: " & vbNewLine & ex.Message LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndex DTP: " & ex.Message & vbNewLine & "Wert WD: " & oValueFromSource.ToString & vbNewLine & "Indexname: " & oSourceIndexName, True) frmError.ShowDialog() LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndex DTP: " & ex.Message, True) End Try End If 'Case Else ' MsgBox(Type) End Select oCount += 1 Next set_foreground() If first_control Is Nothing = False Then first_control.Focus() 'Flag setzen das Indexe geladen sind _Indexe_Loaded = True Load_Additional_Searches() Else MsgBox("Für dieses Profil wurde noch keine Eingabemaske definiert!" & vbNewLine & "Informieren Sie Ihren PM-Administrator!" & vbNewLine & "Das Fenster wird geschlossen!", MsgBoxStyle.Exclamation, "Achtung:") Me.Close() End If 'Catch ex As Exception ' LOGGER.Error(ex) ' errormessage = "Unvorhergesehener Fehler bei FillIndexValues:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" ' My.Settings.Save() ' frmError.ShowDialog() ' LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndexValues: " & ex.Message, True) ' LOGGER.Info(">> Controltype: " & oControlType) ' LOGGER.Info(">> Indexname windream: " & oIndexName) ' LOGGER.Info(">> Stacktrace: " & ex.StackTrace) 'End Try End Sub Private Sub frmValidation_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown ' Refresh_FileList() Load_Next_Document(True) _dependingControl_in_action = False FormLoaded = True End Sub Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click btnSave.Enabled = False Abschluss() btnSave.Enabled = True End Sub Sub CloseWDDocview() Try Dim oFileName = New FileInfo(CURRENT_WMFILE.aPath) Dim oProcesses As Process() = Process.GetProcesses() Dim oViewerNames As New List(Of String) From { "WMPViewX", "WMPViewXNG" } For Each p In oProcesses If oViewerNames.Contains(p.ProcessName) Then p.Kill() End If Next Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" ### FEHLER in CloseDocView") LOGGER.Info("### " & ex.Message & " ###") End Try 'Try ' If VIEWER_ALL = "docview" Then ' DocView.CloseView(CURRENT_WMFILE.aPath, 0) ' End If 'Catch ex As Exception ' LOGGER.Error(ex) ' LOGGER.Info(" ### FEHLER in CloseDocView") ' LOGGER.Info("### " & ex.Message & " ###") 'End Try End Sub Sub Abschluss() btnSave.Enabled = False LOGGER.Debug("Abschluss für Dok: " & CURRENT_DOC_PATH & " gestartet") 'Eingaben auf Form überprüfen If Check_UpdateIndexe() = False Then 'lblerror.Visible = False 'Try Dim oErrorOcurred As Boolean = False TBPM_PROFILE_FINAL_INDEXINGTableAdapter.Fill(FinalIndexDataSet.TBPM_PROFILE_FINAL_INDEXING, CURRENT_ProfilName) Dim oDTFinalIndexes As DataTable = FinalIndexDataSet.TBPM_PROFILE_FINAL_INDEXING If oDTFinalIndexes.Rows.Count > 0 Then 'Jetzt finale Indexe setzen LOGGER.Debug("FINAL INDEXING STARTING...") For Each oFinalIndexRow As DataRow In oDTFinalIndexes.Rows Dim oValue As String = oFinalIndexRow.Item("VALUE").ToString Dim oIndexType = 0 If IDB_ACTIVE = False Then oIndexType = WINDREAM.GetTypeOfIndex(oFinalIndexRow.Item("INDEXNAME")) End If If oValue.ToUpper = "SQL-Command".ToUpper Then '###### Indexierung mit variablen SQL ### LOGGER.Debug("Indexierung mit dynamischem SQL!") Dim oSQLCommand = oFinalIndexRow.Item("SQL_COMMAND") LOGGER.Debug("SQL_COMMAND before ReplaceAllValues: " & oSQLCommand) oSQLCommand = clsPatterns.ReplaceAllValues(oSQLCommand, pnldesigner, CURRENT_WMFILE, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL, USER_ID, CURRENT_CLICKED_PROFILE_ID) 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 LOGGER.Debug("SQL_COMMAND after ReplaceAllValues: " & oSQLCommand) Dim dynamic_value = ClassDatabase.Execute_Scalar(oSQLCommand, CONNECTION_STRING, True) If Not IsNothing(dynamic_value) Then LOGGER.Debug("DYNAMIC VALUE IS: " & dynamic_value.ToString) oValue = dynamic_value Else LOGGER.Info("ATTENTION: DYNAMIC VALUE IS NOTHING!") End If End If Else If oValue.StartsWith("v") Then Select Case oFinalIndexRow.Item("VALUE").ToString Case "vDate" oValue = Now.ToShortDateString Case "vUserName" oValue = USER_USERNAME Case Else oValue = oFinalIndexRow.Item("VALUE") End Select End If End If If oErrorOcurred Then Exit For End If Dim oResult() As String ReDim Preserve oResult(0) oResult(0) = oValue LOGGER.Debug($"oIndexType {oIndexType.ToString}") If oIndexType > 4000 And oIndexType < 5000 Then 'If dr.Item("INDEXNAME").ToString.StartsWith("[%VKT") Then ' Dim PM_String = Return_PM_VEKTOR(value, dr.Item("INDEXNAME")) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oValue, oFinalIndexRow.Item("INDEXNAME"), oFinalIndexRow.Item("PREVENT_DUPLICATES"), oFinalIndexRow.Item("ALLOW_NEW_VALUES")) = False Then LOGGER.Debug("FINALER Vektorindex '" & oFinalIndexRow.Item("INDEXNAME").ToString & "' WURDE ERFOLGREICH GESETZT") Else errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True End If Else LOGGER.Debug("Now the final indexing...") Dim oFIResult As Boolean = False If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oFinalIndexRow.Item("INDEXNAME"), oResult) = True Then oFIResult = True LOGGER.Debug("FINALER INDEX '" & oFinalIndexRow.Item("INDEXNAME") & "' WURDE ERFOLGREICH GESETZT") 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim logstr = Return_LOGString(oValue, "DDFINALINDEX", oFinalIndexRow.Item("INDEXNAME")) WMIndexVectofield(logstr, PROFIL_LOGINDEX) End If End If Else If IDBData.SetVariableValue(oFinalIndexRow.Item("INDEXNAME"), oValue) = True Then oFIResult = True LOGGER.Debug("final index '" & oFinalIndexRow.Item("INDEXNAME") & "' was written to IDB") If PROFIL_LOGINDEX <> "" Then Dim logstr = Return_LOGString(oValue, "DDFINALINDEX", oFinalIndexRow.Item("INDEXNAME")) oFIResult = IDBData.SetVariableValue(PROFIL_LOGINDEX, logstr) End If 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 ''Wenn kein Fehler nach der finalen Indexierung gesetzt wurde If oErrorOcurred = False Then 'Das Dokument freigeben und als editiert markieren Dim sql = String.Format("UPDATE TBPM_PROFILE_FILES SET IN_WORK = 0, WORK_USER = '{0}', EDIT = 1 WHERE GUID = {1}", USER_USERNAME, CURRENT_DOC_GUID) ClassDatabase.Execute_non_Query(sql) 'TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", Document_ID) ''Das Dokument 'TBPM_PROFILE_FILESTableAdapter.CmdSetEdit(Document_ID) Dim WORK_HISTORY_ENTRY = Nothing Try WORK_HISTORY_ENTRY = CURRENT_DT_PROFILE.Rows(0).Item("WORK_HISTORY_ENTRY") If IsDBNull(WORK_HISTORY_ENTRY) Then WORK_HISTORY_ENTRY = Nothing End If Catch ex As Exception LOGGER.Error(ex) WORK_HISTORY_ENTRY = Nothing End Try If Not IsNothing(WORK_HISTORY_ENTRY) Then If WORK_HISTORY_ENTRY <> String.Empty Then Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" ' einen Regulären Ausdruck laden Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg) ' die Vorkommen im SQL-String auslesen Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(WORK_HISTORY_ENTRY) '#### ' alle Vorkommen innerhalbd er Namenkonvention durchlaufen For Each element As System.Text.RegularExpressions.Match In elemente Try LOGGER.Debug("element in RegeX WORK_HISTORY_ENTRY: " & element.Value) Dim CTRL_ID = element.Value.Substring(2, element.Value.Length - 3) CTRL_ID = CTRL_ID.Replace("CTRLID", "") Dim value_from_control If IsNumeric(CTRL_ID) Then For Each oControl As Control In Me.pnldesigner.Controls Try If IsNothing(DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid) Then Continue For End If Catch ex As Exception Continue For End Try If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = CTRL_ID Then '###### Dim Type As String = oControl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" Try value_from_control = oControl.Text Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = oControl Try value_from_control = cmb.Text Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = oControl Try value_from_control = dtp.Value.ToString Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = oControl Try value_from_control = chk.Checked Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try End Select End If Next End If If Not IsNothing(value_from_control) And value_from_control <> String.Empty Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace(element.Value, value_from_control) End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info("Unexpected Error in Checking control values for WORK_HISTORY_ENTRY - ERROR: " & ex.Message) End Try Next If WORK_HISTORY_ENTRY.ToString.Contains("@DATE") Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace("@DATE", Now.ToShortDateString) End If If WORK_HISTORY_ENTRY.ToString.Contains("@USERNAME") Then WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace("@USERNAME", USER_USERNAME) End If Else WORK_HISTORY_ENTRY = "" End If End If Dim ins = String.Format("INSERT INTO TBPM_FILES_WORK_HISTORY (PROFIL_ID, DOC_ID,WORKED_BY,WORKED_WHERE,STATUS_COMMENT) VALUES ({0},{1},'{2}','{3}','{4}')", CURRENT_ProfilGUID, CURRENT_DOC_ID, USER_USERNAME, Environment.MachineName, WORK_HISTORY_ENTRY) ClassDatabase.Execute_non_Query(ins) Close_document_viewer() If WMDocPathWindows.ToLower.EndsWith(".pdf") Then If Not IsNothing(WORK_HISTORY_ENTRY) Then If CBool(CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_WORK_HISTORY_ENTRY")) = True Then sql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE GUID = (SELECT MAX(GUID) FROM TBPM_FILES_WORK_HISTORY WHERE PROFIL_ID = {0} AND DOC_ID = {1})", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRY As DataTable = ClassDatabase.Return_Datatable(sql, True) 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 value = CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_ALL_WORK_HISTORY_ENTRIES") If CBool(value) = True Then sql = String.Format("SELECT * FROM TBPM_FILES_WORK_HISTORY WHERE DOC_ID = {1} ORDER BY GUID", CURRENT_ProfilGUID, CURRENT_DOC_ID) Dim DT_ENTRIES As DataTable = ClassDatabase.Return_Datatable(sql, True) If Not IsNothing(DT_ENTRIES) Then If DT_ENTRIES.Rows.Count > 0 Then Dim AnnotationString As String = "" For Each rw As DataRow In DT_ENTRIES.Rows AnnotationString = AnnotationString & rw.Item("WORKED_WHEN") & " " & rw.Item("WORKED_BY") & ": " & rw.Item("STATUS_COMMENT") & vbNewLine Next ClassAnnotation.Annotate_PDF("Workflow History:", AnnotationString, 0, False, 10, 40) End If End If End If End If End If 'wenn Move2Folder aktiviert wurde If Move2Folder <> "" Then idxerr_message = allgFunk.Move2Folder(WMDocPathWindows, Move2Folder, CURRENT_ProfilGUID, _windream) If idxerr_message <> "" Then errormessage = "Fehler bei Move2Folder:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() oErrorOcurred = True End If End If 'Validierungsfile löschen wenn vorhanden 'allgFunk.Delete_xffres(WMDocPathWindows, _windream) 'LOGGER.Debug("Delete_xffres ausgeführt") LOGGER.Debug("All Input clear") Anzahl_validierte_Dok += 1 'tstrlbl_Info.Text = "Anzahl Dateien: " & TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(PROFIL_ID) LOGGER.Debug("Anzahl hochgesetzt") LOGGER.Debug("Validierung erfolgreich abgeschlossen") LOGGER.Info("") If CURRENT_JUMP_DOC_GUID <> 0 Then Me.Close() Else 'Das nächste Dokument laden Load_Next_Document(False) set_foreground() If first_control Is Nothing = False Then first_control.Focus() End If End If 'Catch ex As Exception ' LOGGER.Error(ex) ' errormessage = "Unexpected error in Finish:" & ex.Message ' My.Settings.Save() ' frmError.ShowDialog() ' LOGGER.Info("Unexpected error in Finish: " & ex.Message, True) 'End Try Else 'lblerror.Visible = True 'lblerror.Text = errmessage errormessage = oErrorMessage frmError.ShowDialog() End If btnSave.Enabled = True End Sub Function Check_Missing(control As Control, typ As String) Select Case typ Case "txt" If control.Text = String.Empty Then Return True End If Return False End Select End Function Function Return_PM_VEKTOR(input As String, VKTBezeichner As String) Dim PM_String As String Try Dim Bezeichner As String = VKTBezeichner.Replace("[%VKT", "") PM_String = "DD-PM" & Delimiter & Bezeichner & Delimiter & input & Delimiter & USER_USERNAME & Delimiter & Now.ToString Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Fehler 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{Delimiter}{indexname}{Delimiter}{input}{Delimiter}{USER_USERNAME}{Delimiter}{Now.ToString}" Else PM_String = $"DD-PMLog-CHG{Delimiter}{indexname}{Delimiter}NEW: [{input}] - OLD: [{old}]{Delimiter}{USER_USERNAME}{Delimiter}{Now.ToString}" End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Fehler in Return_LOGString: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Private Function WMIndexVectofield(input As String, NameVKTIndex As String, Optional PreventDuplicates As Boolean = False, Optional AllowAddNewValues As Boolean = True, Optional IndexBehaviour As String = "Add") Dim oOldValue As Object = CURRENT_WMFILE.GetVariableValue(NameVKTIndex) Dim oValueList As New List(Of Object) Dim oNewValue As Object() Dim oMissing As Boolean = False If oOldValue IsNot Nothing AndAlso TypeOf oOldValue Is Object Then ' If new values are allowed, add the old values first If AllowAddNewValues Then oValueList = DirectCast(oOldValue, Object()).ToList() End If ' Add the new value oValueList.Add(input) Else ' Just add input as the only value oValueList.Add(input) End If If PreventDuplicates Then oValueList = oValueList. Distinct(). ToList() End If oNewValue = oValueList.ToArray() If oNewValue.Length > 0 Then 'Jetzt die Datei indexieren If Indexiere_File(CURRENT_WMFILE, NameVKTIndex, oNewValue) = False Then oMissing = True oErrorMessage = "Fehler beim Indexieren 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() Dim oControlName Dim oControlId As String Try Dim oMissing As Boolean = False 'Jedes Control auf panel durchlaufen For Each oControl As Control In Me.pnldesigner.Controls 'Der input der Box,Cmb muss jedes mal geleert werden Dim oMyInput As String = "" 'Jedes Control in Konfig Tab durchlaufn For Each dr As DataRow In DTVWCONTROL_INDEX.Rows If dr.Item("CTRL_TYPE") = "LBL" Or dr.Item("CTRL_TYPE") = "LINE" Then Continue For End If 'Den Indexnamen auslesen Dim oIndexName As String = dr.Item("INDEX_NAME") Dim oIsRequired As Boolean = CBool(dr.Item("VALIDATION")) Dim oSQLCheckCommand As String = IIf(IsDBNull(dr.Item("SQL_UEBERPRUEFUNG")), "", dr.Item("SQL_UEBERPRUEFUNG")) Dim oIsReadOnly As Boolean = CBool(dr.Item("READ_ONLY")) Dim oControlType As String = dr.Item("CTRL_TYPE") oControlId = dr.Item("GUID") Dim oRegexMatch As String = NotNull(dr.Item("REGEX_MATCH"), String.Empty) Dim oRegexMessage As String = NotNull(dr.Item("REGEX_MESSAGE_DE"), String.Empty) oControlName = dr.Item("CTRL_NAME") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist If dr.Item("CTRL_NAME") = oControl.Name And (oIsReadOnly = False Or oSQLCheckCommand <> "") And oIndexName <> "DD PM-ONLY FOR DISPLAY" Then LOGGER.Debug("Indexierung für Control (" & oControlId & ") '" & oControlName & "' gestartet. Indexname '" & oIndexName & "'") If oIndexName = "" Then LOGGER.Info(" >> Indexname is unexpected empty.") Continue For End If Dim Type As String = oControl.GetType.ToString Select Case Type Case "DigitalData.Controls.LookupGrid.LookupControl2" Try Dim lookup As LookupControl2 = oControl If lookup.SelectedValues.Count = 0 And oIsRequired = True Then oMissing = True oErrorMessage = $"Kein Auswahl getroffen in LookupGrid '{oControl.Name}'" oControl.BackColor = Color.Red Exit For Else If lookup.MultiSelect = True Then Dim Zeilen As Integer = lookup.SelectedValues.Count 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If Zeilen > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each value As String In lookup.SelectedValues If value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = value ZeilenGrid += 1 End If Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrorMessage = "Fehler beim Indexieren von LookupGrid - ERROR: " & idxerr_message Exit For End If Else Dim oMyDT = DT_FOR_ARRAY(myVektorArr) If IDBData.SetVariableValue(oIndexName, oMyDT, True) = False Then oMissing = True oErrorMessage = "Error while indexing IDB-Object LookupGrid" Exit For End If End If 'Jetzt die Datei indexieren 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 oErrorMessage = "Fehler beim Indexieren von LookupGrid - ERROR: " & idxerr_message Exit For End If End If End If Else oMyInput = lookup.SelectedValues.FirstOrDefault() If IsNothing(oMyInput) And oIsRequired = True Then oMissing = True oErrorMessage = $"Could not get FirstOrDefault-Value of LookUpGrid! - LookUPGridName: {lookup.Name}" Exit For ElseIf IsNothing(oMyInput) And oIsRequired = False Then Continue For End If 'den aktuellen Wert in windream auslesen Dim oValueFromObject If oIndexName.StartsWith("[%VKT") Then oValueFromObject = ReturnVektor_IndexValue(oIndexName) Else oValueFromObject = GetVariableValuefromSource(oIndexName) If Not IsNothing(oValueFromObject) Then If IDB_ACTIVE = False Then If oValueFromObject.ToString = "System.Object[]" Then If oValueFromObject.Length = 1 Then oValueFromObject = oValueFromObject(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oValueFromObject = oValueFromObject(0) End If End If End If Else oValueFromObject = "" End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If IsNothing(oValueFromObject) Or oValueFromObject <> oMyInput Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrorMessage = "Fehler beim Indexieren Textbox als VEKTOR - ERROR: " & idxerr_message 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 oErrorMessage = "Fehler beim Indexieren Textbox - ERROR: " & idxerr_message Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then Exit For End If End If 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim oLogStr = Return_LOGString(oMyInput, oValueFromObject, oIndexName) If IDB_ACTIVE = False Then WMIndexVectofield(oLogStr, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogStr) End If End If End If End If End If End If End If Catch ex As Exception LOGGER.Error(ex) End Try Case "System.Windows.Forms.TextBox" Try If oRegexMatch <> String.Empty AndAlso Not Regex.IsMatch(oControl.Text, oRegexMatch) Then oMissing = True If USER_LANGUAGE <> "de-DE" Then oErrorMessage = "Wrong input in textbox '" & oControl.Name & "'" Else oErrorMessage = "Falsche Eingabe in Textbox '" & oControl.Name & "'" End If If oRegexMessage <> String.Empty Then oErrorMessage &= ":" & vbCrLf & oRegexMessage End If oControl.BackColor = Color.Red Exit For End If 'Als erstes überprüfen ob überhaupt etwas eingetragen worden ist If Check_Missing(oControl, "txt") = True And oIsRequired = True Then 'NICHTS EINGETRAGEN oMissing = True If USER_LANGUAGE <> "de-DE" Then oErrorMessage = "Missing input in textbox '" & oControl.Name & "'" Else oErrorMessage = "Fehlende Eingabe in Textbox '" & oControl.Name & "'" End If oControl.BackColor = Color.Red Exit For Else oMyInput = oControl.Text 'den aktuellen Wert in windream auslesen Dim oSourceValue = GetVariableValuefromSource(oIndexName) If oIndexName.StartsWith("[%VKT") Then oSourceValue = ReturnVektor_IndexValue(oIndexName) Else 'wertWD = CURRENT_WMFILE.GetVariableValue(oIndexName) If Not IsNothing(oSourceValue) Then If oSourceValue.ToString = "System.Object[]" Then If oSourceValue.Length = 1 Then oSourceValue = oSourceValue(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oSourceValue = oSourceValue(0) End If End If Else oSourceValue = "" End If End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If IsNothing(oSourceValue) Or oSourceValue <> oMyInput Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrorMessage = "Fehler beim Indexieren Textbox als VEKTOR - ERROR: " & idxerr_message 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 oErrorMessage = "Fehler beim Indexieren Textbox - ERROR: " & idxerr_message Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then Exit For End If End If If PROFIL_LOGINDEX <> "" Then Dim oMyLogString = Return_LOGString(oMyInput, oSourceValue, oIndexName) If IDB_ACTIVE = False Then WMIndexVectofield(oMyLogString, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, oMyLogString) End If End If End If End If End If Catch ex As Exception LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox("Unvorhergesehener Fehler in Check_UpdateIndexe TextBox: " & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:") LOGGER.Info("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) Return True End Try Case "System.Windows.Forms.ComboBox" Try LOGGER.Debug($"Working on Combobox...") Dim cmb As ComboBox = oControl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If cmb.SelectedIndex = -1 And oIsRequired = True Then oMissing = True oErrorMessage = "Please Choose an entry out of ComboBox '" & cmb.Name & "'" Exit For 'ElseIf cmb.SelectedIndex <> -1 Then Else 'Änderung 28.08.2018: Ein leerer Wert in der Combobox wird in den Index geschrieben oMyInput = cmb.Text LOGGER.Debug($"inputvalue Combobox: {cmb.Text}") Dim oWMValue 'den aktuellen Wert in windream auslesen If oIndexName.StartsWith("[%VKT") Then oWMValue = ReturnVektor_IndexValue(oIndexName) Else oWMValue = GetVariableValuefromSource(oIndexName) End If LOGGER.Debug($"Got a WMValue...") If IsNothing(oWMValue) Then LOGGER.Debug($"WMValue is nothing...Value EmptyString will be used") oWMValue = String.Empty End If Dim oIndexType As String = "Index" Try If oWMValue.ToString = "System.Object[]" Then oIndexType = "Vector" End If Catch ex As Exception LOGGER.Debug($"Exception while oWMValue.ToString = System.Object[]...") End Try If oIndexType = "Vector" Then LOGGER.Debug($"Control with ID{oControlId} is a vectorfield...") If oWMValue.Length = 1 Then oWMValue = oWMValue(0).ToString Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") oWMValue = oWMValue(0).ToString End If Else LOGGER.Debug($"WMValue is a regular item...") Dim oitsadifference As Boolean = False Try If oWMValue.ToString <> oMyInput.ToString Then oitsadifference = True End If Catch ex As Exception LOGGER.Warn($"Could not convert the WMValue of Control with ID{oControlId}...") LOGGER.Error(ex.Message) oitsadifference = True End Try 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oitsadifference = True Then LOGGER.Debug($"Index with ID{oControlId} will now be indexed...") 'Wenn der Wert in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrorMessage = "Fehler beim Indexieren Combobox als VEKTOR - ERROR: " & idxerr_message 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 oErrorMessage = "Fehler beim Indexieren Combobox - ERROR: " & idxerr_message Exit For End If Else If IDBData.SetVariableValue(oIndexName, oMyInput) = False Then cmb.DroppedDown = True oMissing = True oErrorMessage = "Error indexing combobox idb" Exit For End If End If 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim ologStr = Return_LOGString(oMyInput, oWMValue, oIndexName) If IDB_ACTIVE = False Then WMIndexVectofield(ologStr, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, ologStr) End If End If End If Else LOGGER.Debug($"oitsadifference = False...Index with ID{oControlId} will not be indexed...") 'Wenn der Wert in ein Vektorfeld geschrieben wird End If End If End If Catch ex As Exception LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox($"Unvorhergesehener Fehler in Check_UpdateIndexe Combobox : ID{oControlId} " & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Error:") LOGGER.Info($"Unvorhergesehener Fehler in Check_UpdateIndexe Combobox : ID{oControlId}" & ex.Message) Return True End Try Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = oControl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And dtp.Value.ToString = String.Empty Then oMissing = True oErrorMessage = "Please Choose DateValue for field'" & dtp.Name & "'" Exit For ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then oMyInput = CDate(dtp.Value) 'den aktuellen Wert in windream auslesen ' Dim wertWD As String = CURRENT_WMFILE.GetVariableValue(_IDXName) Dim oObjectValue If oIndexName.StartsWith("[%VKT") Then oObjectValue = ReturnVektor_IndexValue(oIndexName) Else oObjectValue = GetVariableValuefromSource(oIndexName) End If If IsNothing(oObjectValue) Then oObjectValue = CDate("01.01.1900") End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oObjectValue <> oMyInput Then 'Wenn der WErt in ein Vektorfeld geschrieben wird If oIndexName.StartsWith("[%VKT") Then 'Input = die String komponente als String oMyInput = Return_PM_VEKTOR(oMyInput, oIndexName) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrorMessage = "Fehler beim Indexieren DatePicker als VEKTOR - ERROR: " & idxerr_message 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 oErrorMessage = "Fehler beim Indexieren DatePicker- ERROR: " & idxerr_message Exit For End If Else If IDBData.SetVariableValue(oIndexName, oObjectValue) = False Then oMissing = True oErrorMessage = "Error indexing datepicker idb" Exit For End If End If If PROFIL_LOGINDEX <> "" Then Dim oLogstr = Return_LOGString(oMyInput, oObjectValue, oIndexName) If IDB_ACTIVE = False Then WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) End If End If End If Else LOGGER.Debug("Value WD ('" & oObjectValue.ToString & "') = Input-value ('" & oMyInput.ToString & "')") End If Else LOGGER.Debug("DateValue is 01.01.0001 00:00:00") End If Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = oControl oMyInput = chk.Checked.ToString 'If chk.Checked = False And oIsRequired = True Then ' oMissing = True ' oErrorMessage = "Option '" & chk.Name & "' is required." ' Exit For 'End If 'den aktuellen Wert in windream auslesen Dim WertWD As String Dim oBoolValue As Boolean If oIndexName.StartsWith("[%VKT") Then WertWD = ReturnVektor_IndexValue(oIndexName) If WertWD = "" Then oBoolValue = False Else oBoolValue = CBool(WertWD) End If Else Dim _Value Dim oObjectCheck = GetVariableValuefromSource(oIndexName) If IsNothing(oObjectCheck) Then oBoolValue = False Else If oObjectCheck.ToString = "System.Object[]" Then If oObjectCheck.Length = 1 Then _Value = oObjectCheck(0) Else ' LOGGER.Info(" >> Vectorfield " & oIndexName & "' contains more then one value - First value will be used") _Value = oObjectCheck(0) End If Else _Value = oObjectCheck End If oBoolValue = CBool(_Value) End If End If ' Dim Bool_WD = CBool(CURRENT_WMFILE.GetVariableValue(_IDXName)) 'wenn Wert in Windream <> der Eingabe darf indexiert werden If oBoolValue <> chk.Checked Then Dim result() As String ReDim Preserve result(0) If chk.Checked Then result(0) = 1 Else result(0) = 0 End If If oIndexName.StartsWith("[%VKT") Then 'Input = die String komponente mit Boolean als String oMyInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexName) 'Hier muss nun separat als Vektorfeld indexiert werden If WMIndexVectofield(oMyInput, PROFIL_VEKTORINDEX) = True Then oMissing = True oErrorMessage = "Fehler beim Indexieren Checkbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, result) = False Then oMissing = True oErrorMessage = "Fehler beim Indexieren Checkbox - ERROR: " & idxerr_message Exit For End If Else If IDBData.SetVariableValue(oIndexName, chk.Checked.ToString) Then oErrorMessage = "error indexing checkboxidb" Exit For End If End If If PROFIL_LOGINDEX <> "" Then Dim oLogstr = Return_LOGString(CBool(result(0)).ToString, WertWD, oIndexName) If IDB_ACTIVE = False Then WMIndexVectofield(oLogstr, PROFIL_LOGINDEX) Else IDBData.SetVariableValue(PROFIL_LOGINDEX, oLogstr) End If End If End If End If Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = oControl Dim Zeilen As Integer = 0 For Each row As DataGridViewRow In dgv.Rows Dim exists = False ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then Zeilen += 1 End If Next 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And Zeilen = 0 Then oMissing = True oErrorMessage = "Fehlende Eingabe in Vektorfeld '" & dgv.Name & "'" Exit For ElseIf Zeilen > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each row As DataGridViewRow In dgv.Rows Dim exists = False Select Case oControlType Case "TABLE" ' MsgBox(row.Cells(0).Value.GetType.ToString) Dim str As String If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) For i = 0 To row.Cells.Count - 1 Select Case i Case 0 str = row.Cells(i).Value Case Else str = str & Delimiter & row.Cells(i).Value End Select Next 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = str ZeilenGrid += 1 End If Case Else ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Cells(0).Value Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = row.Cells(0).Value.ToString ZeilenGrid += 1 End If End Select Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrorMessage = "Fehler beim Indexieren Vektorfeld - ERROR: " & idxerr_message 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 oErrorMessage = "Error indexing Datagridview idb" Exit For End If End If End If 'Jetzt die Datei indexieren End If Case "DevExpress.XtraGrid.GridControl" Dim dgv As GridControl = oControl Dim Zeilen As Integer = dgv.DataSource.Rows.Count 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If oIsRequired = True And Zeilen = 0 Then oMissing = True oErrorMessage = "Fehlende Eingabe in Tabelle '" & dgv.Name & "'" oControl.BackColor = Color.Red Exit For ElseIf Zeilen > 0 Then Dim ZeilenGrid As Integer = 0 Dim myVektorArr As String() 'Jeden Werte des Datagridviews durchlaufen For Each row As DataRow In dgv.DataSource.Rows Dim exists = False Select Case oControlType Case "TABLE" ' MsgBox(row.Cells(0).Value.GetType.ToString) Dim str As String = String.Empty If row.Item(0) <> String.Empty Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) Dim oValueList As New List(Of String) For Each item In row.ItemArray item = NotNull(item, String.Empty) If TypeOf item IsNot String Then item.ToString() oValueList.Add(item) Next str = String.Join(Delimiter, oValueList.ToArray) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = str ZeilenGrid += 1 End If Case Else ' MsgBox(row.Cells(0).Value.GetType.ToString) If row.Item(0) Is Nothing = False Then 'Das Array anpassen ReDim Preserve myVektorArr(ZeilenGrid) 'Den Wert im Array speichern myVektorArr(ZeilenGrid) = row.Item(0).Value.ToString ZeilenGrid += 1 End If End Select Next If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, myVektorArr) = False Then oMissing = True oErrorMessage = $"Error while indexing table (1) {dgv.Name} - ERROR: " & idxerr_message Exit For End If Else Dim oMyDT = DT_FOR_ARRAY(myVektorArr) If oMyDT.Rows.Count > 0 Then If IDBData.SetVariableValue(oIndexName, oMyDT, True) = False Then oMissing = True oErrorMessage = $"Error while indexing table IDB (1) {dgv.Name} - ERROR: " & idxerr_message Exit For End If End If End If Else Dim oValue As New List(Of Object) From {String.Empty} If IDB_ACTIVE = False Then If Indexiere_File(CURRENT_WMFILE, oIndexName, oValue.ToArray) = False Then oMissing = True 'oErrorMessage = "Fehler beim Indexieren der Tabelle - ERROR: " & idxerr_message oErrorMessage = $"Error while indexing table (2) {dgv.Name} - ERROR: " & idxerr_message Exit For End If End If End If End Select End If 'End If für Control und ReadOnly = False Next ' If Error happened in inner For, exit the outer as well If oMissing = True Then Exit For End If Next Return oMissing Catch ex As Exception LOGGER.Warn($"Unexpected error in Check_UpdateIndexe - ControlID: {oControlId},{oControlName}") LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox($"Unvorhergesehener Fehler in Check_UpdateIndexe ControlID,Name: {oControlId},{oControlName}" & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:") LOGGER.Info("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) Return True End Try End Function Private Function Indexiere_File(_dok As WINDREAMLib.WMObject, idxxname As String, idxvalue As Object) As Boolean Dim File_indexiert As Boolean = False idxerr_message = "" Try 'Die Arrays vorbereiten Dim arrIndex() As String = Nothing Dim arrValue() As String = Nothing arrIndex = Nothing arrValue = Nothing 'Den Indexnamen übergeben ReDim Preserve arrIndex(0) arrIndex(0) = idxxname 'Das Array der Idnexwerte überprüfen If idxvalue Is Nothing = False Then If idxvalue.Length() > 1 Then LOGGER.Debug("Indexing Index '" & idxxname & "' with Arrayvalue") Dim anzahl As Integer = 0 For Each indexvalue As String In idxvalue ReDim Preserve arrValue(anzahl) arrValue(anzahl) = indexvalue anzahl += 1 Next Else LOGGER.Debug("Indexing Index '" & idxxname & "' with value '" & idxvalue(0) & "'") ReDim Preserve arrValue(0) arrValue(0) = idxvalue(0).ToString End If 'Jetzt das eigentliche Indexieren der Datei 'File_indexiert = Me._windreamPM.RunIndexing(_dok, arrIndex, arrValue) File_indexiert = WINDREAM.RunIndexing(_dok, arrIndex, arrValue) If File_indexiert = False Then allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler beim Indexieren der Datei: " & _dok.aName & " - ERROR: " & idxerr_message, USER_USERNAME) End If Return File_indexiert End If Catch ex As Exception LOGGER.Error(ex) allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Unvorhergesehener Fehler beim Indexieren der Datei: " & _dok.aName & " - ERROR: " & ex.Message, USER_USERNAME) idxerr_message = "unvorhergesehener Fehler in Indexiere_File: " & ex.Message.ToString LOGGER.Info(">> Unvorhergesehener Fehler bei Indexiere_File: " & ex.Message.ToString, True) Return False End Try End Function Private Sub btnfinal_Click(sender As System.Object, e As System.EventArgs) Abschluss() End Sub Function GetConnectionString(id As Integer) Try Dim connectionString As String Dim DTConnection As DataTable DTConnection = DD_DMSLiteDataSet.TBDD_CONNECTION Dim drConnection As DataRow For Each drConnection In DTConnection.Rows If drConnection.Item("GUID") = id Then Select Case drConnection.Item("SQL_PROVIDER") Case "SqlClient.SqlConnection" connectionString = "%MSData Source=" & drConnection.Item("SERVER") & ";Initial Catalog= " & drConnection.Item("DATENBANK") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";" Case "Oracle" connectionString = "%ORProvider=OraOLEDB.Oracle;Data Source=" & drConnection.Item("SERVER") & ";User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";OLEDB.NET=True;" ' connectionString = "%ORData Source=" & drConnection.Item("SERVER") & ";Persist Security Info=True;User Id=" & drConnection.Item("USERNAME") & ";Password=" & drConnection.Item("PASSWORD") & ";Unicode=True" Case Else LOGGER.Info(" - ConnectionType '" & drConnection.Item("SQL_PROVIDER") & "' nicht integriert") MsgBox("ConnectionType '" & drConnection.Item("SQL_PROVIDER") & "' nicht integriert", MsgBoxStyle.Critical, "Bitte Konfiguration Connection überprüfen!") End Select End If Next Return connectionString Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" - Unvorhergesehener Fehler bei GetConnectionString - Fehler: " & vbNewLine & ex.Message) MsgBox(ex.Message, MsgBoxStyle.Critical, "Fehler bei GetConnectionString:") Return "" End Try End Function Private Sub btnNavigatorfirst_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "first" End If End Sub Private Sub btnNavigatorprevious_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "previous" End If End Sub Private Sub btnNavigatornext_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "next" End If End Sub Private Sub btnNavigatorlast_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then navStep = "last" End If End Sub Private Sub frmValidation_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown If e.Button = Windows.Forms.MouseButtons.Left Then navStep = Nothing End If End Sub Sub Datei_ueberspringen() Try LOGGER.Debug("Dokument überspringen") Close_document_viewer() LOGGER.Debug("Doc Viewer geschlossen") 'Das Dokument freigeben TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", CURRENT_DOC_GUID) Dim oSQL = $"EXECUTE PRPM_FILES_NOT_INDEXED '{USER_USERNAME}',{CURRENT_ProfilGUID},'{WMDocPathWindows}',{CURRENT_DOC_GUID}" ClassDatabase.Execute_non_Query(oSQL) LOGGER.Debug($"Skipped DocGUID {CURRENT_DOC_GUID}") LOGGER.Info("") Load_Next_Document(False) Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Überspringen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private 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 Close_document_viewer() 'Aus der Tabelle löschen TBPM_PROFILE_FILESTableAdapter.CmdDelete(CURRENT_DOC_GUID) Dim resul = allgFunk.Delete_xffres(WMDocPathWindows, _windream) If resul = Nothing Or resul = True Then If Delete_File() = True Then 'MsgBox("Die Datei wurde erfolgreich aus windream gelöscht!" & vbNewLine & "Es wird nun die nächste Datei angezeigt!", MsgBoxStyle.Information, "Erfolgsmeldung:") Load_Next_Document(False) End If End If End If Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Löschen windream-Datei:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Function Delete_File() 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() End If CURRENT_WMFILE.Delete() LOGGER.Info(">> Manuelles Löschen: Datei " & CURRENT_WMFILE.aName & " erfolgreich gelöscht") Return True Catch ex As Exception LOGGER.Error(ex) MsgBox("Das windream-Objekt konnte nicht gelöscht werden!" & vbNewLine & vbNewLine & "Fehlermeldung:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Info(" windream-Objekt konnte nicht gelöscht werden - Fehlermeldung: " & ex.Message, True) Return False End Try End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(" Fehler bei Delete_File", True) LOGGER.Info(">> Fehlermeldung: " & ex.Message) Return False End Try End Function Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Private Const SEE_MASK_FLAG_NO_UI = &H400 Public Const SW_SHOW As Short = 5 Public Sub New() MyBase.New ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. _frmValidatorSearch = frmValidatorSearch End Sub Public Shared Function ShellExecuteEx(ByRef lpExecInfo As SHELLEXECUTEINFO) As Boolean End Function Public Structure SHELLEXECUTEINFO Public cbSize As Integer Public fMask As Integer Public hwnd As IntPtr Public lpVerb As String Public lpFile As String Public lpParameters As String Public lpDirectory As String Dim nShow As Integer Dim hInstApp As IntPtr Dim lpIDList As IntPtr Public lpClass As String Public hkeyClass As IntPtr Public dwHotKey As Integer Public hIcon As IntPtr Public hProcess As IntPtr End Structure Private Sub frmValidation_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd If WMDocPathWindows Is Nothing = False Then Select Case Path.GetExtension(WMDocPathWindows).ToLower Case ".pdf" Select Case VIEWER_PDF Case "internal" My.Settings.frmValidation_Size_PDFViewer = Me.Size Case "pdfxchange" My.Settings.frmValidatorSize = Me.Size Case "sumatra" My.Settings.frmValidatorSize = Me.Size Case "system" My.Settings.frmValidatorSize = Me.Size End Select Case ".msg" My.Settings.frmValidation_Size_Email = Me.Size Case Else My.Settings.frmValidatorSize = Me.Size End Select My.Settings.Save() End If End Sub Private Sub Splitter1_LocationChanged(sender As Object, e As EventArgs) My.Settings.Save() End Sub Private Sub PdfViewer1_DocumentChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfDocumentChangedEventArgs) Handles PdfViewer1.DocumentChanged PDF_Pagenumber() End Sub Private Sub PdfViewer1_CurrentPageChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfCurrentPageChangedEventArgs) Handles PdfViewer1.CurrentPageChanged PDF_Pagenumber() End Sub Sub PDF_Pagenumber() Try pdfstatuslblPageNumber.Text = "Page " & PdfViewer1.CurrentPageNumber & "/" & PdfViewer1.PageCount Catch ex As Exception LOGGER.Error(ex) End Try End Sub Private Sub MinimumToolStripMenuItem_Click(sender As Object, e As EventArgs) PdfViewer1.ZoomFactor = 20 End Sub Private Sub ToolStripDropDownButton1_Click(sender As Object, e As EventArgs) Handles ToolStripDropDownButton1.Click PdfViewer1.ZoomFactor = 20 End Sub Private Sub frmValidator_KeyUp(sender As Object, e As KeyEventArgs) Handles MyBase.KeyUp If e.KeyCode = Keys.F4 Then Datei_ueberspringen() End If '(e.Control AndAlso e.KeyCode = Keys.S) Then ' btnSave.Enabled = False 'Abschluss() 'btnSave.Enabled = True 'Else End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButtonJumpFile.Click Datei_ueberspringen() End Sub Private Sub ToolStripButtonDeleteFile_Click(sender As Object, e As EventArgs) Handles ToolStripButtonDeleteFile.Click delete_active_File() End Sub Private Sub ToolStripButtonAnnotation_Click(sender As Object, e As EventArgs) Handles ToolStripButtonAnnotation.Click PdfViewer1.CloseDocument() Close_PDF_Viewer(WMDocPathWindows) Application.DoEvents() frmAnnotations.ShowDialog() load_viewer() End Sub Private Sub frmValidator_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing End Sub Private Sub frmValidator_Resize(sender As Object, e As EventArgs) Handles Me.Resize End Sub Private Sub InfoToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles InfoToolStripMenuItem.Click frmFileInfo.ShowDialog() End Sub Private Sub EigenschaftenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles EigenschaftenToolStripMenuItem.Click If WMDocPathWindows <> "" Then 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("Fehler in Datei-Eigenschaften öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) End If End If Cursor = Cursors.Default End Sub Private Sub DateiÖffnenToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles DateiÖffnenToolStripMenuItem1.Click Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(WMDocPathWindows) Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() LOGGER.Info(" - Datei wurde geöffnet!") Catch ex As Exception LOGGER.Error(ex) MsgBox("Fehler bei Datei öffnen:" & vbNewLine & ex.Message, MsgBoxStyle.Critical) LOGGER.Info("Fehler bei Datei öffnen: " & ex.Message, True) End Try End Sub Private Sub ToolStripButtonSearchesReload_Click(sender As Object, e As EventArgs) Handles ToolStripButtonSearchesReload.Click Load_Additional_Searches() End Sub Private Sub btnSave_MouseHover(sender As Object, e As EventArgs) Handles btnSave.MouseHover 'Dim msg = "strg & s für speichern" 'If USER_LANGUAGE <> "de-DE" Then ' msg = "ctrl & s for saving" 'End If 'ToolTip1.Show(msg, btnSave) End Sub Private Sub frmValidator_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown End Sub End Class