Imports WINDREAMLib Imports System.Threading Imports System.Runtime.InteropServices Imports System.Management Imports System.Globalization Imports Oracle.ManagedDataAccess.Client Imports Independentsoft Imports System.IO Imports DevExpress.Pdf Imports System.Text.RegularExpressions Imports System.ComponentModel Imports DD_LIB_Standards Imports DigitalData.Controls.LookupGrid Imports System.Data.SqlClient Imports DevExpress.XtraGrid 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 Dim aktivesDokument As WMObject 'speichert die DocumentDaten Private navStep As String = Nothing Public Shared Windream_Document_Path As String Public Shared Filesystem_Document_Path 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 errmessage 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 Private _ValidatorSearch As frmValidatorSearch 'You need a reference to Form1 Private _dependingControl_in_action 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_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(Windream_Document_Path).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() Catch ex As Exception LOGGER.Error(ex) End Try Try TBPM_FILES_USER_NOT_INDEXEDTableAdapter.CmdDelete(Environment.UserName) 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, Environment.UserName) End Try End If If VIEWER_ALL = "docview" Then CloseWDDocview() End If If VIEWER_PDF = "system" Then Kill_PDFAcrobat() Else If pdfxchange = True Or sumatra = True Then Close_PDF_Viewer(Windream_Document_Path) 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(Environment.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_windream() Try WINDREAM = New ClassPMWindream() WINDREAM.Create_Session() LOGGER.Debug(" >> Windream initiiert", False) 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, Environment.UserName) LOGGER.Info(">> Fehler in Init_windream: " & ex.Message, True) Return False 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 RibbonControl1.Minimized = True 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 _step = 1 TBPM_FILES_USER_NOT_INDEXEDTableAdapter.Connection.ConnectionString = CONNECTION_STRING 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 VWPM_CONTROL_INDEXTableAdapter.Connection.ConnectionString = CONNECTION_STRING TBPM_CONTROL_TABLETableAdapter.Connection.ConnectionString = CONNECTION_STRING _step = 2 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", False) 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, Environment.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 & " (F1)" Else btnSave.Text = "Validierung speichern - Nächstes Dokument" & " (F1)" End If Else btnSave.Text = "Validierung speichern - Nächstes Dokument" & " (F1)" End If LOGGER.Debug(" >> Final profile Text geladen", False) 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, Environment.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", False) LOGGER.Info(" >> WD_Search: " & WD_Search, False) LOGGER.Info(" >> finalProfile: " & finalProfile, False) LOGGER.Info(" >> Move2Folder: " & Move2Folder, False) LOGGER.Info(" >> Right_Delete: " & USER_RIGHT_FILE_DELETE, False) End If PROFIL_sortbynewest = CURRENT_DT_PROFILE.Rows(0).Item("SORT_BY_LATEST") LOGGER.Debug(" >> PROFIL_sortbynewest: " & PROFIL_sortbynewest.ToString, False) '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, False) Load_Controls() End If End If If Not IsNothing(CURRENT_DT_PROFILE_SEARCHES_RT) Then If CURRENT_DT_PROFILE_SEARCHES_RT.Rows.Count > 0 Then For Each _searchRow As DataRow In CURRENT_DT_PROFILE_SEARCHES_RT.Rows Next 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, Environment.UserName) LOGGER.Info(">> Fehler in LOADING(2) Profile-Data: " & ex.Message, True) End Try 'Me.lblerror.Visible = False End Sub Sub LoadSimpleData(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) sql = clsPatterns.ReplaceInternalValues(sql) LOGGER.Debug(">>> sql after ReplaceInternalValues: " & sql, False) 'sql = ClassPatterns.ReplaceInternalValues(sqlStatement) dt = ClassDatabase.Return_Datatable(sql) 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 comboxBox As ComboBox = control Dim list As New List(Of String) For Each _row As DataRow In dt.Rows list.Add(_row.Item(0)) Next comboxBox.DataSource = list 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 Sub Load_Controls() Try pnldesigner.Controls.Clear() 'Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX TBPM_PROFILE_CONTROLSTableAdapter.FillByProfil(DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS, CURRENT_ProfilGUID) Dim oCount As Integer = 0 Dim oDTProfileControl As DataTable = DD_DMSLiteDataSet.TBPM_PROFILE_CONTROLS For Each oControlRow As DataRow In oDTProfileControl.Rows Dim ctrl As Control Select Case oControlRow.Item("CTRL_TYPE").ToString.ToUpper Case "TXT" LOGGER.Debug(" >> Versuch TXT zu laden", False) Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(oControlRow, False) LOGGER.Debug(" >> TXT wurde geladen", False) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp ctrl = txt Case "LBL" LOGGER.Debug(" >> Versuch LBL zu laden", False) ctrl = ClassControlCreator.CreateExistingLabel(oControlRow, False) Case "CMB" LOGGER.Debug(" >> Versuch CMB zu laden", False) Dim cmb = ClassControlCreator.CreateExistingCombobox(oControlRow, False) AddHandler cmb.SelectedValueChanged, AddressOf OnCmbselectedIndex #Region "CONTROL LIST" Dim ControlID = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetGUID(CURRENT_ProfilGUID, cmb.Name) LOGGER.Debug(" >> In add_ComboBox - GUID: " & ControlID, False) If ControlID > 0 Then LOGGER.Debug(" >>ControlID > 0", False) Dim ConID = Me.TBPM_PROFILE_CONTROLSTableAdapter.cmdgetConnectionID(ControlID) If ConID Is Nothing = False Then Dim commandsql = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) LOGGER.Debug(" >> ConID Is Nothing = False", False) If ConID > 0 And commandsql <> "" Then LOGGER.Debug(" >> CConID > 0 And TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID)", False) 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, False) 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", False) 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 = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetSQL(ControlID) 'sql = ClassPatterns.ReplaceAllValues(sql, pnldesigner, aktivesDokument) '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, False) 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", False) End If Else LOGGER.Debug(" >> AListe Handling", False) Dim AListe As String = TBPM_PROFILE_CONTROLSTableAdapter.cmdGetChoiceListName(ControlID) LOGGER.Debug(" >> In add_ComboBox - AListe: " & AListe, False) 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 ctrl = cmb 'add_ComboBox(dr.Item("GUID"), dr.Item("CTRL_NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), CInt(dr.Item("WIDTH")), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "DTP" LOGGER.Debug(" >> Versuch DTP zu laden", False) ctrl = ClassControlCreator.CreateExistingDatepicker(oControlRow, False) 'add_DTP(dr.Item("GUID"), dr.Item("NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), CInt(dr.Item("WIDTH")), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "DGV" LOGGER.Debug(" >> Versuch DGV zu laden", False) Dim dgv = ClassControlCreator.CreateExistingDataGridView(oControlRow, False) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating ctrl = dgv Case "LOOKUP" LOGGER.Debug(" >> Versuch LOOKUP zu laden", False) 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 = oControlRow.Item("MULTISELECT") If NotNull(oControlRow.Item("DEFAULT_VALUE"), "") <> "" Then lookup.SelectedValues = New List(Of String) From {oControlRow.Item("DEFAULT_VALUE")} End If ctrl = lookup 'add_DGV(dr.Item("GUID"), dr.Item("CTRL_NAME"), dr.Item("HEIGHT"), dr.Item("WIDTH"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) 'dr.Item("INDEX_NAME"), Case "CHK" LOGGER.Debug(" >> Versuch Checkbox zu laden", False) ctrl = ClassControlCreator.CreateExisingCheckbox(oControlRow, False) 'add_Checkbox(dr.Item("GUID"), dr.Item("CTRL_NAME"), dr.Item("CTRL_TEXT"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("READ_ONLY"), dr.Item("LOAD_IDX_VALUE")) Case "TABLE" LOGGER.Debug(" >> Versuch Tabelle zu laden", False) 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() ctrl = ClassControlCreator.CreateExistingTable(oControlRow, columns, False) 'add_TABLE(dr.Item("GUID"), dr.Item("CTRL_NAME"), CInt(dr.Item("X_LOC")), CInt(dr.Item("Y_LOC")), dr.Item("WIDTH"), CInt(dr.Item("HEIGHT")), dr.Item("READ_ONLY")) Case "LINE" LOGGER.Debug(" >> Versuch Linie zu laden", False) ctrl = ClassControlCreator.CreateExistingLine(oControlRow, False) End Select If TypeOf ctrl IsNot Label Then If first_control Is Nothing Then first_control = ctrl End If last_control = ctrl End If pnldesigner.Controls.Add(ctrl) 'LoadSimpleData(ctrl, oControlRow.Item("GUID")) Next LOGGER.Debug(" >> Controls geladen", False) LOGGER.Info("", False) 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, Environment.UserName) LOGGER.Info("Unvorhergesehener Fehler bei Load_Controls:" & ex.Message) LOGGER.Info("", False) 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 box.BackColor = Color.Lime box.SelectAll() End Sub Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs) Dim box As TextBox = sender box.BackColor = Color.White End Sub Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs) 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 = 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, aktivesDokument, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL) LOGGER.Debug(">>> sql after ReplaceAllValues: " & sql, False) '' 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, False) ' 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}") 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 = 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_CS(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 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 = 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, aktivesDokument, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL) _Step = 3 LOGGER.Debug(">>> sql after ReplaceAllValues: " & sql, False) '' 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, False) ' 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}") 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_CS(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}") End If End If End Sub Private Function CheckValueExists(ByVal control As Control) Try Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX For Each dr As DataRow In dt.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!", False) 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 Windream_Document_Path.ToLower.EndsWith(".pdf") = True Then Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(Filesystem_Document_Path) 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 Next_GUID(Filepath As String, ProfilId As Integer, OrderByNewest As Boolean) As Integer Dim oFilePath = ReplaceWindreamDriveLetter(Filepath).ToUpper() Dim oSQL = $" SELECT GUID FROM TBPM_PROFILE_FILES WHERE PROFIL_ID = {CURRENT_ProfilGUID} AND EDIT = 0 AND IN_WORK = 0 AND UPPER(REPLACE(FILE_PATH, 'W:','\\windream\objects')) <> '{oFilePath}' AND UPPER(REPLACE(FILE_PATH, 'W:','\\windream\objects')) NOT IN ( SELECT UPPER(FILE_PATH) FROM TBPM_FILES_USER_NOT_INDEXED WHERE (PROFIL_ID = {ProfilId}) AND (UPPER(USR_NAME) = UPPER('{Environment.UserName}')) ) {IIf(OrderByNewest, " ORDER BY DMS_ERSTELLT_DATE DESC", "")} " Return ClassDatabase.Execute_Scalar(oSQL, CONNECTION_STRING, True) End Function Function Get_Next_GUID() As Integer Try Dim newGUID As Integer LOGGER.Debug(" >> Old Document_Path: " & OLD_Document_Path, False) 'If PROFIL_sortbynewest = True Then ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdgetNextFile_GUID_Newest(CURRENT_ProfilGUID, OLD_Document_Path, Environment.UserName) 'Else ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdGetNextFile_GUID(CURRENT_ProfilGUID, OLD_Document_Path, Environment.UserName) 'End If newGUID = Next_GUID(OLD_Document_Path, CURRENT_ProfilGUID, PROFIL_sortbynewest) Windream_Document_Path = "" CURRENT_DOC_PATH = "" If newGUID > 0 Then LOGGER.Debug(" >> newGUID: " & newGUID.ToString, False) Windream_Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) Windream_Document_Path = Windream_Document_Path.Replace("W:", "\\windream\objects") Windream_Document_Path = Windream_Document_Path.Replace("K:", "\\windream\objects") Filesystem_Document_Path = GetFilesystemDocumentPath(Windream_Document_Path) CURRENT_DOC_PATH = Windream_Document_Path LOGGER.Debug(" >> Document_Path: " & Windream_Document_Path, False) LOGGER.Debug(" >> Überprüfen ob File existiert?", False) Dim i As Integer = 0 Do While allgFunk.file_exists(Windream_Document_Path, _windream) = False And newGUID <> 0 i = i + 1 If i > 800 Then allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Get_Next_GUID - Datei nicht vorhanden!", Environment.UserName) LOGGER.Info(" >> ACHTUNG: Ausnahme in GetNextGUID - Datei nicht vorhanden", False) Dim Del = "DELETE FROM TBPM_PROFILE_FILES where GUID = " & newGUID ClassDatabase.Execute_non_Query(Del, True) errmessage = "Die windream-Datei existiert nicht!" Windream_Document_Path = "" CURRENT_DOC_PATH = "" Return 0 End If Loop OLD_Document_Path = Windream_Document_Path 'If PROFIL_sortbynewest Then ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdgetNextFile_GUID_Newest(PROFIL_ID, Document_Path, Environment.UserName) ' Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) 'Else ' newGUID = TBPM_PROFILE_FILESTableAdapter.cmdGetNextFile_GUID(PROFIL_ID, Document_Path, Environment.UserName) ' Document_Path = TBPM_PROFILE_FILESTableAdapter.CmdGetFilePath_2_GUID(newGUID) 'End If Else LOGGER.Info(" >> ACHTUNG: Ausnahme in GetNextGUID - Es konnte keine GUID abgerufen werden!", False) newGUID = 0 End If Return newGUID Catch ex As Exception LOGGER.Error(ex) errmessage = "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 = DT.Rows(0).Item("GUID") AnzDoks = DT.Rows.Count Else AnzDoks = 1 Windream_Document_Path = 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(Windream_Document_Path) End If If aktivesDokument Is Nothing = False Then If aktivesDokument.aLocked Then aktivesDokument.Save() ' unlock the windream object aktivesDokument.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 Function GetFilesystemDocumentPath(WindreamPath As String) Return Path.Combine(CURRENT_DT_CONFIG.Rows.Item(0).Item("WM_REL_PATH"), Windream_Document_Path) End Function Sub Load_Next_Document(first As Boolean) aktivesDokument = Nothing LOGGER.Debug(" >> aktivesDokument nothing gesetzt", False) activate_controls(False) errmessage = "" Windream_Document_Path = "" Filesystem_Document_Path = "" CURRENT_HTML_DOC = "" 'Me.lblerror.Visible = False _Indexe_Loaded = False LOGGER.Debug(" >> In Load_Next_Document", False) Try If first = True Then LOGGER.Debug(" >> First Document", False) aktivesDokument = Nothing Else LOGGER.Debug(" >> Following Document ", False) 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 If CURRENT_JUMP_DOC_GUID = 0 Then CURRENT_DOC_GUID = Get_Next_GUID() Else Windream_Document_Path = CURRENT_DOC_PATH Filesystem_Document_Path = GetFilesystemDocumentPath(Windream_Document_Path) End If LOGGER.Debug(" >> Dokument-GUID: '" & CURRENT_DOC_GUID.ToString & "'", False) If CURRENT_DOC_GUID > 0 Then 'Beschriftung des Navigators 'lblNavigator_anzDok.Text = position & " of " & Anzahl_ValDoks & " files" If Windream_Document_Path <> String.Empty Then ' >> >> >> >> >> >>##### Das Dokument in Bearbeitung nehmen ########################### TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(True, Environment.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 '" & Windream_Document_Path & "' gestartet", False) Try aktivesDokument = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, WINDREAM.NormalizePath(Windream_Document_Path)) Catch ex As Exception LOGGER.Error(ex) allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Fehler bei Erzeugen windream-Objekt - DocGUID: " & CURRENT_DOC_GUID & " - ERROR: " & ex.Message, Environment.UserName) LOGGER.Info("Fehler bei Erzeugen windream-Objekt in (LoadNextDokument): " & ex.Message) LOGGER.Info("Error Number: " & Err.Number.ToString) Dim _err1 As Boolean = False 'Nochmaliger Versuch windream zu initialiseren If Init_windream() = True Then Try aktivesDokument = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, Windream_Document_Path) Catch ex1 As Exception LOGGER.Info("Fehler bei 2. Versuch windream-Objekt: " & ex1.Message) errmessage = "1-Es besteht ein Problem beim Anmelden an windream - Bitte wenden Sie sich an Digital Data!" _err1 = True End Try Else errmessage = "2-Es besteht ein Problem beim Anmelden an windream - Bitte wenden Sie sich an Digital Data!" _err1 = True End If If _err1 = True Then errormessage = errmessage frmError.ShowDialog() Exit Sub End If End Try LOGGER.Debug(" >> Windream-Dokument geladen und gelockt", False) errmessage = Windream_get_Doc_info() LOGGER.Debug(" >> Windream-Dok Info geholt", False) If errmessage = "" Then Me.grpbxMailBody.Visible = False Me.grpBetreff.Visible = False load_viewer() If Windream_Document_Path.ToLower.EndsWith(".pdf") Then ToolStripButtonAnnotation.Visible = True Else ToolStripButtonAnnotation.Visible = False End If LOGGER.Debug(" >> Viewer geladen", False) FillIndexValues(first) For Each oControl As Control In pnldesigner.Controls LoadSimpleData(oControl, oControl.Tag) Next LOGGER.Debug(" >> Indexmaske geladen", False) LOGGER.Debug("", False) 'Nun im Vektoprindex loggen das das Profil geladen wurde 'If PROFIL_VEKTORINDEX <> "" Then ' Dim Profilstring = "DD-PM" & Delimiter & "Profil: '" & PROFIL_NAME & "'" & Delimiter & Environment.UserName & Delimiter & Now.ToString ' If Indexiere_VektorfeldPM(Profilstring, PROFIL_VEKTORINDEX) = False Then ' If LogErrorsOnly = False Then LOGGER.Info(" >> Profilname erfolgreich in Vektorfeld PM geschrieben", False) ' '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 & "In Profil: '" & CURRENT_ProfilName & "' geladen" & Delimiter & Environment.UserName & Delimiter & Now.ToString If Indexiere_VektorfeldPM(Profilstring, PROFIL_LOGINDEX) = False Then LOGGER.Debug(" >> Profilname erfolgreich in Vektorfeld LOG geschrieben", False) 'Else ' errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message ' My.Settings.Save() ' frmError.ShowDialog() ' _error = True End If End If activate_controls(True) Else errormessage = errmessage frmError.ShowDialog() End If Else errormessage = errmessage frmError.ShowDialog() End If Else If errmessage <> "" Then errormessage = errmessage frmError.ShowDialog() Else LOGGER.Info(" >> Ende des Profils - Kein weiteres Dokument!", False) LOGGER.Info("", False) 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, Environment.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() If VIEWER_ALL = "uviewer" Then pdfxchange = False sumatra = False If Filesystem_Document_Path.ToLower.EndsWith(".msg") Then Show_Email() Else ShowFile_UniversalViewer(Filesystem_Document_Path) End If ElseIf VIEWER_ALL = "docview" Then PdfControls_visible(False) If Filesystem_Document_Path.ToLower.EndsWith(".pdf") And VIEWER_PDF <> "none" Then Select Case VIEWER_PDF Case "internal" SplitContainer1.Panel2Collapsed = False PdfViewer1.LoadDocument(Filesystem_Document_Path) LOGGER.Debug(" >> Internal Viewer Path: " & Filesystem_Document_Path, False) 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(Filesystem_Document_Path) pdfxchange = True sumatra = False System.Threading.Thread.Sleep(1000) Me.Size = My.Settings.frmValidatorSize Case "sumatra" SplitContainer1.Panel2Collapsed = True Open_Sumatra(Filesystem_Document_Path) 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 Filesystem_Document_Path.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 = aktivesDokument.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 = aktivesDokument.aPath.ToString DocView.ViewFile(viewer_string) End If End Sub Sub Show_Email() Try Me.grpBetreff.Dock = DockStyle.Top Me.grpbxMailBody.Dock = DockStyle.Fill Dim msg_email As New Msg.Message(Windream_Document_Path) '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 CURRENT_DOC_CREATION_DATE = aktivesDokument.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, False) 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 = aktivesDokument.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, False) Try CURRENT_DOC_CREATION_TIME = aktivesDokument.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Catch ex As Exception LOGGER.Error(ex) 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 CURRENT_DOC_CREATION_TIME = aktivesDokument.GetVariableValue(INDEX_DMS_ERSTELLT_ZEIT) Else 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, False) 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 = aktivesDokument.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 Sub FillIndexValues(first As Boolean) Dim oControlType As String Dim oIndexName As String Try If DD_DMSLiteDataSet.VWPM_CONTROL_INDEX.Rows.Count > 0 Then Dim oCount As Integer = 0 For Each oControl As Control In Me.pnldesigner.Controls Dim oControlId = oControl.Tag Dim oControlRow = (From form In DD_DMSLiteDataSet.VWPM_CONTROL_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 oWMIndexName 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 = oWMIndexName Dim oLoadIndex As Boolean = oControlRow.Item("LOAD_IDX_VALUE") LOGGER.Debug(" >> INDEX: " & oWMIndexName & " - CONTROLNAME: " & oControl.Name & " - LOAD IDXVALUES: " & oLoadIndex.ToString, False) _CURRENT_INDEX_ARRAY(oCount, 0) = oWMIndexName Select Case oType Case "System.Windows.Forms.TextBox" Try oControlType = "Textbox" If oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then If oLoadIndex = False Or oWMIndexName = "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.", False) Exit Select End If Dim wertWD If oWMIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(oWMIndexName) Else wertWD = aktivesDokument.GetVariableValue(oWMIndexName) If wertWD Is Nothing Then wertWD = "" Else If wertWD.ToString = "System.Object[]" Then LOGGER.Debug(" >> TextBox with VektorField: " & oWMIndexName, False) If wertWD.length = 1 Then wertWD = wertWD(0) _CURRENT_INDEX_ARRAY(oCount, 1) = wertWD(0) Else ' LOGGER.Info(" >> Vectorfield " & oWMIndexName & "' contains more then one value - First value will be used", False) wertWD = wertWD(0) _CURRENT_INDEX_ARRAY(oCount, 1) = wertWD(0) End If End If End If End If oControl.Text = NotNull(wertWD, oDefaultValue) _CURRENT_INDEX_ARRAY(oCount, 1) = NotNull(wertWD, oDefaultValue) End If Catch ex As Exception LOGGER.Error(ex) errormessage = "Unvorhergesehener Fehler bei FillIndexValues TextBox:" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndexValuesTextBox: " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType, False) LOGGER.Info(">> Indexname windream: " & oIndexName, False) Exit Sub End Try Case "System.Windows.Forms.ComboBox" oControlType = "ComboBox" Dim cmb As ComboBox = oControl Try If oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then If oLoadIndex = False Or oWMIndexName = "DD PM-ONLY FOR DISPLAY" Then If oDefaultValue = String.Empty Then cmb.SelectedIndex = -1 Else cmb.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue End If LOGGER.Debug(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If Dim wertWD If oWMIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(oWMIndexName) Else wertWD = aktivesDokument.GetVariableValue(oWMIndexName) End If If wertWD Is Nothing Then LOGGER.Debug($" >> Indexwert aus index {oWMIndexName}: Nothing", False) If oDefaultValue = String.Empty Then LOGGER.Debug($" >> Indexwert-defaultValue wurde nicht gefunden", False) cmb.SelectedIndex = -1 Else LOGGER.Debug($" >> Indexwert-defaultValue wird geladen", False) cmb.Text = oDefaultValue _CURRENT_INDEX_ARRAY(oCount, 1) = oDefaultValue 'cmb.SelectedIndex = cmb.FindStringExact(defaultValue) End If Else LOGGER.Debug($" >> Indexwert aus index {oWMIndexName}: {wertWD}", False) LOGGER.Debug($" >> Items in Combobox: {cmb.Items.Count}", False) LOGGER.Debug($" >> Index Wert wurde gesetzt", False) cmb.Text = wertWD _CURRENT_INDEX_ARRAY(oCount, 1) = wertWD 'If cmb.Items.Count = 0 Then ' If LogErrorsOnly = False Then LOGGER.Info($" >> Index Wert wurde gesetzt", False) ' cmb.Text = wertWD 'Else ' If LogErrorsOnly = False Then LOGGER.Info($" >> Index Wert wurde ausgewählt", False) ' cmb.SelectedIndex = cmb.FindStringExact(wertWD) 'End If End If End If Catch ex As Exception LOGGER.Error(ex) LOGGER.Info(">> Unvorhergesehener Fehler bei FillIndexValues(Combobox: " & cmb.Name & "): " & ex.Message, True) LOGGER.Info(">> Controltype: " & oControlType, False) LOGGER.Info(">> Indexname windream: " & oIndexName, False) errormessage = "Unvorhergesehener Fehler bei FillIndexValues(Combobox: " & cmb.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 oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then If oLoadIndex = False Then LOGGER.Debug(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If LOGGER.Debug($" >> getting wmValue for Index {oWMIndexName}...", False) Dim wertWD = aktivesDokument.GetVariableValue(oWMIndexName) 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}.", False) If dt.Rows.Count > 1 Then For Each Zeile As Object In wertWD LOGGER.Debug($" >> vektorrow Value {Zeile.ToString}...", False) 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 oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then If oLoadIndex = False Then LOGGER.Debug(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If LOGGER.Debug($" >> getting wmValue for Index {oWMIndexName}...", False) Dim wertWD = aktivesDokument.GetVariableValue(oWMIndexName) 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}.", False) If dt.Rows.Count > 1 Then Dim oDataSource As DataTable = dgv.DataSource oDataSource.Rows.Clear() For Each Zeile As Object In wertWD LOGGER.Debug($" >> vektorrow Value {Zeile.ToString}...", False) SpaltenWerte = Split(Zeile, Delimiter) Select Case dt.Rows.Count Case 1 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 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 wertWD 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.", False) oControlType = "CheckBox" If oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then Dim chk As CheckBox = oControl If oLoadIndex = False Or oWMIndexName = "DD PM-ONLY FOR DISPLAY" Then LOGGER.Debug(" >> Indexwert soll nicht geladen werden.", False) If oDefaultValue <> String.Empty Then Dim result = False _CURRENT_INDEX_ARRAY(oCount, 1) = "False" If Boolean.TryParse(oDefaultValue, result) Then chk.Checked = result End If End If Exit Select End If LOGGER.Debug(" >> Loading Index value from Windream.", False) Dim wertWD If oWMIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then wertWD = ReturnVektor_IndexValue(oWMIndexName) Else wertWD = aktivesDokument.GetVariableValue(oWMIndexName) End If If wertWD Is Nothing Then LOGGER.Info(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & oIndexName & "' ist nothing. Check defaultvalue", False) chk.Checked = False Else LOGGER.Debug(" >> Index value loaded: " & wertWD.ToString, False) _CURRENT_INDEX_ARRAY(oCount, 1) = wertWD.ToString If wertWD.ToString = "" Then LOGGER.Info(">> Versuch, default Value zu laden", False) If oDefaultValue <> String.Empty Then Dim result = False If Boolean.TryParse(oDefaultValue, result) Then LOGGER.Info(">> defaultValue wurde geladen", False) chk.Checked = result Else chk.Checked = False End If Else LOGGER.Info(">> defaultValue war leer", False) chk.Checked = False End If Else Dim _value If wertWD.ToString = "System.Object[]" Then LOGGER.Debug(" >> CheckBoxValue with VektorField: " & oWMIndexName, False) If wertWD.length = 1 Then _value = wertWD(0) Else ' LOGGER.Info(" >> Vectorfield " & oWMIndexName & "' contains more then one value - First value will be used", False) _value = wertWD(0) End If Else _value = wertWD End If Try Select Case CBool(_value) Case True LOGGER.Info(">> CBool(_value) = True", False) chk.Checked = True Case Else LOGGER.Info(">> CBool(_value) = False", 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: " & wertWD.ToString, True) chk.Checked = False End Try End If End If End If Case "DigitalData.Controls.LookupGrid.LookupControl2" Try Dim oLookup As LookupControl2 = oControl Dim oWindreamValue = aktivesDokument.GetVariableValue(oWMIndexName) If IsNothing(oWindreamValue) Then oLookup.SelectedValues = New List(Of String) _CURRENT_INDEX_ARRAY(oCount, 1) = String.Empty ElseIf oWindreamValue.GetType.ToString.Contains("System.Object") Then Dim oArrlist As New List(Of String) For Each oVectorRow As Object In oWindreamValue oArrlist.Add(oVectorRow.ToString) Next oLookup.SelectedValues = oArrlist _CURRENT_INDEX_ARRAY(oCount, 1) = oWindreamValue.ToString 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 oWMIndexName = "" 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 oWMIndexName Is Nothing = False Then Dim wertWD Try If oWMIndexName.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then LOGGER.Debug(" >> DATE über PM-Vektor holen", False) wertWD = ReturnVektor_IndexValue(oWMIndexName) LOGGER.Info(">> DTP is """, False) Else wertWD = aktivesDokument.GetVariableValue(oWMIndexName) End If If wertWD Is Nothing Then wertWD = "" Dim tempdate As Date = CDate("01.01.0001 00:00:00") If wertWD.ToString.Length > 0 Then Try tempdate = CDate(wertWD) LOGGER.Debug(" >> DATE konnte umgewandelt werden", False) Catch ex As Exception LOGGER.Error(ex) ValueDTP = tempdate LOGGER.Debug(" >> DATE wurde auf heute gesetzt", False) End Try DTP.Text = tempdate Else LOGGER.Debug(" >> DATE ist leer", False) ValueDTP = tempdate DTP.Text = tempdate End If _CURRENT_INDEX_ARRAY(oCount, 1) = wertWD.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: " & wertWD.ToString & vbNewLine & "Indexname: " & oWMIndexName, 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 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, False) LOGGER.Info(">> Indexname windream: " & oIndexName, False) LOGGER.Info(">> Stacktrace: " & ex.StackTrace, False) End Try End Sub Private Sub frmValidation_Shown(sender As Object, e As System.EventArgs) Handles Me.Shown Refresh_FileList() Load_Next_Document(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 If VIEWER_ALL = "docview" Then If aktivesDokument.aPath.EndsWith("pdf") = False Or VIEWER_PDF = "none" Then If DocView Is Nothing = False Then DocView.CloseView(aktivesDokument.aPath, 0) End If Else If DocView Is Nothing = False Then DocView.CloseView(aktivesDokument.aPath, 0) End If End If 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: " & aktivesDokument.aName & " gestartet", False) 'Eingaben auf Form überprüfen If Check_UpdateIndexe() = False Then 'lblerror.Visible = False Try Dim _error As Boolean = False 'If ClassFinalizeDoc.Write_Final_Metadata(aktivesDokument) = False Then ' _error = True 'End If Me.TBPM_PROFILE_FINAL_INDEXINGTableAdapter.Fill(Me.FinalIndexDataSet.TBPM_PROFILE_FINAL_INDEXING, CURRENT_ProfilName) Dim dtfinal As DataTable = FinalIndexDataSet.TBPM_PROFILE_FINAL_INDEXING If dtfinal.Rows.Count > 0 Then 'Jetzt finale Indexe setzen LOGGER.Debug(" >> Finale(r) Index(e) für Dok: " & aktivesDokument.aName & " soll gesetzt werden", False) For Each dr As DataRow In dtfinal.Rows Dim value As String = dr.Item("VALUE").ToString If value.ToUpper = "SQL-Command".ToUpper Then '###### Indexierung mit variablen SQL ### LOGGER.Debug(" >> Indexierung mit dynamischem SQL!", False) Dim SQL_COMMAND = dr.Item("SQL_COMMAND") LOGGER.Debug(" >> SQL_COMMAND before ReplaceAllValues: " & SQL_COMMAND, False) SQL_COMMAND = clsPatterns.ReplaceAllValues(SQL_COMMAND, pnldesigner, aktivesDokument, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL) LOGGER.Debug(" >> SQL_COMMAND after ReplaceAllValues: " & SQL_COMMAND, False) Dim dynamic_value = ClassDatabase.Execute_Scalar(SQL_COMMAND, CONNECTION_STRING, True) If Not IsNothing(dynamic_value) Then LOGGER.Debug("DYNAMIC VALUE IS: " & dynamic_value.ToString, False) value = dynamic_value Else LOGGER.Info("ATTENTION: DYNAMIC VALUE IS NOTHING!") End If Else If value.StartsWith("v") Then Select Case dr.Item("VALUE").ToString Case "vDate" value = Now.ToShortDateString Case "vUserName" value = Environment.UserName Case Else value = dr.Item("VALUE") End Select End If End If Dim result() As String ReDim Preserve result(0) result(0) = value Dim oIndexType = WINDREAM.GetTypeOfIndex(dr.Item("INDEXNAME")) LOGGER.Debug($" >> oIndexType {oIndexType.ToString}", False) 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 Indexiere_VektorfeldPM(value, dr.Item("INDEXNAME"), dr.Item("PREVENT_DUPLICATES"), dr.Item("ALLOW_NEW_VALUES")) = False Then LOGGER.Debug(" >> FINALER INDEX '" & dr.Item("INDEXNAME").ToString & "' WURDE ERFOLGREICH GESETZT", False) Else errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If Else LOGGER.Debug(" >> Jetzt das indexieren", False) If Indexiere_File(aktivesDokument, dr.Item("INDEXNAME"), result) = True Then LOGGER.Debug(" >> FINALER INDEX '" & dr.Item("INDEXNAME") & "' WURDE ERFOLGREICH GESETZT", False) LOGGER.Debug("") 'Nun das Logging If PROFIL_LOGINDEX <> "" Then Dim logstr = Return_LOGString(value, "DDFINALINDEX", dr.Item("INDEXNAME")) Indexiere_VektorfeldPM(logstr, PROFIL_LOGINDEX) End If Else errormessage = "Fehler beim finalen Indexieren:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If End If If _error = True Then Exit For End If Next End If ''Wenn kein Fehler nach der finalen Indexierung gesetzt wurde If _error = False Then LOGGER.Debug(" >> Tabelle updaten und co", False) '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}", Environment.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, False) Dim CTRL_ID = element.Value.Substring(2, element.Value.Length - 3) CTRL_ID = CTRL_ID.Replace("CTRLID", "") Dim value_from_control For Each inctrl As Control In Me.pnldesigner.Controls If IsNothing(inctrl.Tag) Then Continue For End If If inctrl.Tag = CTRL_ID Then '###### Dim Type As String = inctrl.GetType.ToString Select Case Type Case "System.Windows.Forms.TextBox" Try value_from_control = inctrl.Text Catch ex As Exception LOGGER.Error(ex) value_from_control = String.Empty End Try Case "System.Windows.Forms.ComboBox" Dim cmb As ComboBox = inctrl 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 = inctrl 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 = inctrl 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 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.ToString.Replace("@DATE", Now.ToShortDateString) End If If WORK_HISTORY_ENTRY.ToString.Contains("@USERNAME") Then WORK_HISTORY_ENTRY.ToString.Replace("@USERNAME", Environment.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, Environment.UserName, Environment.MachineName, WORK_HISTORY_ENTRY) ClassDatabase.Execute_non_Query(ins) Close_document_viewer() If Windream_Document_Path.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) 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, 10, 40) End If End If End If End If End If 'wenn Move2Folder aktiviert wurde If Move2Folder <> "" Then idxerr_message = allgFunk.Move2Folder(Windream_Document_Path, Move2Folder, CURRENT_ProfilGUID, _windream) If idxerr_message <> "" Then errormessage = "Fehler bei Move2Folder:" & vbNewLine & idxerr_message My.Settings.Save() frmError.ShowDialog() _error = True End If End If 'Validierungsfile löschen wenn vorhanden allgFunk.Delete_xffres(Windream_Document_Path, _windream) LOGGER.Debug(" >> Delete_xffres ausgeführt", False) LOGGER.Debug(" >> All Input clear", False) Anzahl_validierte_Dok += 1 'tstrlbl_Info.Text = "Anzahl Dateien: " & TBPM_PROFILE_FILESTableAdapter.cmdGet_Anzahl(PROFIL_ID) LOGGER.Debug(" >> Anzahl hochgesetzt", False) LOGGER.Debug(" >> Validierung erfolgreich abgeschlossen", False) LOGGER.Info("", False) 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 = "Unvorhergesehener Fehler bei Abschluss:" & ex.Message My.Settings.Save() frmError.ShowDialog() LOGGER.Info(">> Unvorhergesehener Fehler bei Abschluss: " & ex.Message, True) End Try Else 'lblerror.Visible = True 'lblerror.Text = errmessage errormessage = errmessage 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 & Environment.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 & Environment.UserName & Delimiter & Now.ToString Else PM_String = "DD-PMlog-CHG" & Delimiter & indexname & Delimiter & "NEW: '" & input & "' - OLD: '" & old & "'" & Delimiter & Environment.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 Indexiere_VektorfeldPM(input As String, NameVKTIndex As String, Optional PreventDuplicates As Boolean = False, Optional AllowAddNewValues As Boolean = True) Dim oOldValue As Object = aktivesDokument.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(aktivesDokument, NameVKTIndex, oNewValue) = False Then oMissing = True errmessage = "Fehler beim Indexieren Vektorfeld '" & NameVKTIndex & "' - ERROR: " & idxerr_message End If End If Return oMissing End Function Function Check_UpdateIndexe() Try Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX Dim missing As Boolean = False 'Jedes Control auf panel durchlaufen For Each inctrl As Control In Me.pnldesigner.Controls 'Der input der Box,Cmb muss jedes mal geleert werden Dim input As String = "" 'Jedes Control in Konfig Tab durchlaufn For Each dr As DataRow In dt.Rows If dr.Item("CTRL_TYPE") = "LBL" Or dr.Item("CTRL_TYPE") = "LINE" Then Continue For End If 'Den Indexnamen auslesen Dim _IDXName As String = dr.Item("INDEX_NAME") Dim _MUSSEINGABE As Boolean = CBool(dr.Item("VALIDATION")) Dim _SQL As String = IIf(IsDBNull(dr.Item("SQL_UEBERPRUEFUNG")), "", dr.Item("SQL_UEBERPRUEFUNG")) Dim _READ_ONLY As Boolean = CBool(dr.Item("READ_ONLY")) Dim Typ As String = dr.Item("CTRL_TYPE") Dim CONTROL_ID As String = dr.Item("GUID") Dim ctrl = dr.Item("CTRL_NAME") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist If dr.Item("CTRL_NAME") = inctrl.Name And (_READ_ONLY = False Or _SQL <> "") And _IDXName <> "DD PM-ONLY FOR DISPLAY" Then LOGGER.Debug(" >> Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & _IDXName & "'", False) If _IDXName = "" Then LOGGER.Info(" >> Indexname is unexpected empty.", False) Continue For End If Dim Type As String = inctrl.GetType.ToString Select Case Type Case "DigitalData.Controls.LookupGrid.LookupControl2" Try Dim lookup As LookupControl2 = inctrl If lookup.SelectedValues.Count = 0 And _MUSSEINGABE = True Then missing = True errmessage = $"No value selected in control '{inctrl.Name}'" inctrl.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 'Jetzt die Datei indexieren If Indexiere_File(aktivesDokument, _IDXName, myVektorArr) = False Then missing = True errmessage = "Fehler beim Indexieren Vektorfeld - ERROR: " & idxerr_message Exit For End If End If Else input = lookup.SelectedValues.FirstOrDefault() 'den aktuellen Wert in windream auslesen Dim wertWD If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) If Not IsNothing(wertWD) Then If wertWD.ToString = "System.Object[]" Then If wertWD.Length = 1 Then wertWD = wertWD(0) Else ' LOGGER.Info(" >> Vectorfield " & _IDXName & "' contains more then one value - First value will be used", False) wertWD = wertWD(0) End If End If Else wertWD = "" End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If IsNothing(wertWD) Or wertWD <> input Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Textbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren Textbox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) 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 'Als erstes überprüfen ob überhaupt etwas eingetragen worden ist If Check_Missing(inctrl, "txt") = True And _MUSSEINGABE = True Then 'NICHTS EINGETRAGEN missing = True errmessage = "Missing input in textbox '" & inctrl.Name & "'" inctrl.BackColor = Color.Red Exit For Else input = inctrl.Text 'den aktuellen Wert in windream auslesen Dim wertWD If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) If Not IsNothing(wertWD) Then If wertWD.ToString = "System.Object[]" Then If wertWD.Length = 1 Then wertWD = wertWD(0) Else ' LOGGER.Info(" >> Vectorfield " & _IDXName & "' contains more then one value - First value will be used", False) wertWD = wertWD(0) End If End If Else wertWD = "" End If End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If IsNothing(wertWD) Or wertWD <> input Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Textbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren Textbox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) 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" Dim cmb As ComboBox = inctrl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If cmb.SelectedIndex = -1 And _MUSSEINGABE = True Then missing = True errmessage = "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 input = cmb.Text Dim wertWD As String 'den aktuellen Wert in windream auslesen If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If wertWD <> input Then 'Wenn der Wert in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Combobox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If Indexiere_File(aktivesDokument, _IDXName, result) = False Then cmb.DroppedDown = True missing = True errmessage = "Fehler beim Indexieren Combobox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If End If End If Case "System.Windows.Forms.DateTimePicker" Dim dtp As DateTimePicker = inctrl 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If _MUSSEINGABE = True And dtp.Value.ToString = String.Empty Then missing = True errmessage = "Please Choose DateValue for field'" & dtp.Name & "'" Exit For ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then input = CDate(dtp.Value) 'den aktuellen Wert in windream auslesen ' Dim wertWD As String = aktivesDokument.GetVariableValue(_IDXName) Dim wertWD As String If _IDXName.StartsWith("[%VKT") Then wertWD = ReturnVektor_IndexValue(_IDXName) Else wertWD = aktivesDokument.GetVariableValue(_IDXName) End If If IsNothing(wertWD) Then wertWD = CDate("01.01.1900") End If 'wenn Wert in Windream <> der Eingabe darf indexiert werden If wertWD <> input Then 'Wenn der WErt in ein Vektorfeld geschrieben wird If _IDXName.StartsWith("[%VKT") Then 'Input = die String komponente als String input = Return_PM_VEKTOR(input, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren DatePicker als VEKTOR - ERROR: " & idxerr_message Exit For End If Else Dim result() ReDim Preserve result(0) result(0) = CDate(input) 'MsgBox(_IDXName) If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren DatePicker- ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, wertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If Else LOGGER.Debug(" >> Value WD ('" & wertWD.ToString & "') = Input-value ('" & input.ToString & "')", False) End If Else LOGGER.Debug(" >> DateValue is 01.01.0001 00:00:00", False) End If Case "System.Windows.Forms.CheckBox" Dim chk As CheckBox = inctrl input = chk.Checked.ToString If chk.Checked = False And _MUSSEINGABE = True Then missing = True errmessage = "Option '" & chk.Name & "' is required." Exit For End If 'den aktuellen Wert in windream auslesen Dim WertWD As String Dim Bool_WD As Boolean If _IDXName.StartsWith("[%VKT") Then WertWD = ReturnVektor_IndexValue(_IDXName) If WertWD = "" Then Bool_WD = False Else Bool_WD = CBool(WertWD) End If Else Dim _Value Dim ValueWD = aktivesDokument.GetVariableValue(_IDXName) If IsNothing(ValueWD) Then Bool_WD = False Else If ValueWD.ToString = "System.Object[]" Then If ValueWD.Length = 1 Then _Value = ValueWD(0) Else ' LOGGER.Info(" >> Vectorfield " & _IDXName & "' contains more then one value - First value will be used", False) _Value = ValueWD(0) End If Else _Value = ValueWD End If Bool_WD = CBool(_Value) End If End If ' Dim Bool_WD = CBool(aktivesDokument.GetVariableValue(_IDXName)) 'wenn Wert in Windream <> der Eingabe darf indexiert werden If Bool_WD <> 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 _IDXName.StartsWith("[%VKT") Then 'Input = die String komponente mit Boolean als String input = Return_PM_VEKTOR(chk.Checked.ToString, _IDXName) 'Hier muss nun separat als Vektorfeld indexiert werden If Indexiere_VektorfeldPM(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Fehler beim Indexieren Checkbox als VEKTOR - ERROR: " & idxerr_message Exit For End If Else If Indexiere_File(aktivesDokument, _IDXName, result) = False Then missing = True errmessage = "Fehler beim Indexieren Checkbox - ERROR: " & idxerr_message Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(CBool(result(0)).ToString, WertWD, _IDXName) Indexiere_VektorfeldPM(input, PROFIL_LOGINDEX) End If End If End If End If Case "System.Windows.Forms.DataGridView" Dim dgv As DataGridView = inctrl 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 _MUSSEINGABE = True And Zeilen = 0 Then missing = True errmessage = "Missing input in vectorfield'" & 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 Typ 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 'Jetzt die Datei indexieren If Indexiere_File(aktivesDokument, _IDXName, myVektorArr) = False Then missing = True errmessage = "Fehler beim Indexieren Vektorfeld - ERROR: " & idxerr_message Exit For End If End If Case "DevExpress.XtraGrid.GridControl" Dim dgv As GridControl = inctrl Dim Zeilen As Integer = dgv.DataSource.Rows.Count 'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss If _MUSSEINGABE = True And Zeilen = 0 Then missing = True errmessage = "Missing input in vectorfield'" & 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 DataRow In dgv.DataSource.Rows Dim exists = False Select Case Typ 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 'Jetzt die Datei indexieren If Indexiere_File(aktivesDokument, _IDXName, myVektorArr) = False Then missing = True errmessage = "Fehler beim Indexieren Vektorfeld - ERROR: " & idxerr_message Exit For End If End If End Select End If 'End If für Control und ReadOnly = False Next Next Return missing Catch ex As Exception LOGGER.Error(ex) Dim st As New StackTrace(True) st = New StackTrace(ex, True) MsgBox("Unvorhergesehener Fehler in Check_UpdateIndexe: " & 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) 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", False) 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) & "'", False) 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, Environment.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, Environment.UserName) idxerr_message = "unvorhergesehener Fehler in Indexiere_File: " & ex.Message.ToString LOGGER.Info(">> Unvorhergesehener Fehler bei Indexiere_File: " & ex.Message.ToString, True) Return Err() 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", False) 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 Private Sub DateiÖffnenToolStripMenuItem_Click(sender As System.Object, e As System.EventArgs) Handles DateiÖffnenToolStripMenuItem.Click Try Dim Proc As New System.Diagnostics.Process Dim psi As New ProcessStartInfo(Filesystem_Document_Path) Proc.EnableRaisingEvents = True Proc.StartInfo = psi Proc.Start() LOGGER.Info(" - Datei wurde geöffnet!", False) 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 Sub Datei_ueberspringen() Try LOGGER.Debug(" >> Dokument überspringen", False) Close_document_viewer() LOGGER.Debug(" >> Doc Viewer geschlossen", False) 'Das Dokument freigeben TBPM_PROFILE_FILESTableAdapter.CmdSETWORK(False, "", CURRENT_DOC_GUID) If TBPM_FILES_USER_NOT_INDEXEDTableAdapter.FileExists(Environment.UserName, CURRENT_ProfilGUID, Windream_Document_Path) = 0 Then TBPM_FILES_USER_NOT_INDEXEDTableAdapter.cmdInsert(Environment.UserName, CURRENT_ProfilGUID, Windream_Document_Path) End If LOGGER.Debug(" >> Dokument freigegeben", False) LOGGER.Info("", False) 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(Filesystem_Document_Path, _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 aktivesDokument Is Nothing = False Then Close_document_viewer() Me.PdfViewer1.DocumentFilePath = "" Try If aktivesDokument.aLocked Then ' unlock the windream object aktivesDokument.unlock() End If aktivesDokument.Delete() LOGGER.Info(">> Manuelles Löschen: Datei " & aktivesDokument.aName & " erfolgreich gelöscht", False) 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, False) Return False End Try End Function Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Private Const SEE_MASK_FLAG_NO_UI = &H400 Public Const SW_SHOW As Short = 5 Public Shared Function ShellExecuteEx(ByRef lpExecInfo As SHELLEXECUTEINFO) As Boolean End Function Public Structure SHELLEXECUTEINFO Public cbSize As Integer Public fMask As Integer Public hwnd As IntPtr Public lpVerb As String Public lpFile As String Public lpParameters As String Public lpDirectory As String Dim nShow As Integer Dim hInstApp As IntPtr Dim lpIDList As IntPtr Public lpClass As String Public hkeyClass As IntPtr Public dwHotKey As Integer Public hIcon As IntPtr Public hProcess As IntPtr End Structure Private Sub DateieigenschaftenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateieigenschaftenToolStripMenuItem.Click If Windream_Document_Path <> "" Then Cursor = Cursors.WaitCursor Dim oShellExecuteInfo As New SHELLEXECUTEINFO oShellExecuteInfo.cbSize = Marshal.SizeOf(oShellExecuteInfo) oShellExecuteInfo.lpVerb = "properties" oShellExecuteInfo.lpFile = Filesystem_Document_Path 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 frmValidation_ResizeEnd(sender As Object, e As EventArgs) Handles Me.ResizeEnd If Windream_Document_Path Is Nothing = False Then Select Case Path.GetExtension(Windream_Document_Path).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 PdfViewer1_ZoomChanged(sender As Object, e As DevExpress.XtraPdfViewer.PdfZoomChangedEventArgs) Handles PdfViewer1.ZoomChanged 'SaveMySettingsValue("PDFViewer_ZoomMode", PdfViewer1.ZoomFactor) VIEWER_ZOOM_LEVEL = PdfViewer1.ZoomFactor CONFIG.Config.PDFViewerZoomLevel = VIEWER_ZOOM_LEVEL CONFIG.Save() 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.F1 Then btnSave.Enabled = False Abschluss() btnSave.Enabled = True ElseIf e.KeyCode = Keys.F4 Then Datei_ueberspringen() End If 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(Windream_Document_Path) 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 DateiInfoToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DateiInfoToolStripMenuItem.Click frmFileInfo.ShowDialog() End Sub Private Sub RefreshAdditionalSearchToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles RefreshAdditionalSearchToolStripMenuItem.Click _ValidatorSearch.RefreshTab1() End Sub End Class