Imports WINDREAMLib Imports Oracle.ManagedDataAccess.Client Imports System.ComponentModel Imports DD_LIB_Standards Public Class frmMassValidator Dim DT_PROFILE_CONTROLS As DataTable Private Delimiter As String Private PROFIL_VEKTORINDEX As String Private PROFIL_LOGINDEX As String Private WM_SEARCH As String Private FINAL_PROFILE As String Private MOVE2Folder As String Private me_closing As Boolean = False Private CTRLS_Loaded As Boolean = False Private FORM_Shown As Boolean = False Private _dependingControl_in_action As Boolean = False Private errmessage As String Private _windream As New ClassWindream_allgemein Private _windreamPM As New ClassPMWindream Private _allgFunk As New ClassAllgemeineFunktionen Dim viewer_string As String Dim pdfxchange As Boolean = False Dim sumatra As Boolean = False Dim WMObject As WMObject Private Sub frmMassValidator_Load(sender As Object, e As EventArgs) Handles Me.Load FORM_Shown = False Try _windream = New ClassWindream_allgemein _windream.Init() If LogErrorsOnly = False Then ClassLogger.Add("windream initialized frmMassValidator", False) Catch ex As Exception MsgBox("Error Init_windream:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") ClassLogger.Add(">> Fehler in Init_windream: " & ex.Message, True) Exit Sub End Try If My.Settings.frmMassValidatorposition.IsEmpty = False Then If My.Settings.frmMassValidatorposition.X > 0 And My.Settings.frmMassValidatorposition.Y > 0 Then Location = My.Settings.frmMassValidatorposition End If End If If My.Settings.frmMassValidatorSize.IsEmpty = False Then Size = My.Settings.frmMassValidatorSize End If Try DT_PROFILE_CONTROLS = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_PROFILE_CONTROLS WHERE CTRL_TYPE <> 'TABLE' AND SQL_UEBERPRUEFUNG NOT LIKE '%WMI%' AND PROFIL_ID = " & CURRENT_ProfilGUID) If LogErrorsOnly = False Then ClassLogger.Add(" >> Profile Data geladen", False) Catch ex As Exception MsgBox("Error LOADING profile-data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") ClassLogger.Add(">> Fehler in LOADING profile-data: " & ex.Message, True) Me.Close() End Try ' Try Delimiter = CURRENT_DT_CONFIG.Rows(0).Item("VEKTOR_DELIMITER") If CURRENT_DT_PROFILE.Rows.Count = 0 Then ClassLogger.Add(">> 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 wurden mehr als 1 Profil zurückgegeben!!", MsgBoxStyle.Critical, "Achtung:") Me.Close() Else If CURRENT_DT_PROFILE.Rows.Count = 1 Then For Each dr 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 WM_SEARCH = dr.Item("WD_SEARCH") FINAL_PROFILE = dr.Item("FINAL_PROFILE") MOVE2Folder = IIf(IsDBNull(dr.Item("MOVE2Folder")), "", dr.Item("MOVE2Folder")) tslblCountDocs.Text = "#Documents for MassChange: " & CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Profildaten gespeichert", False) ClassLogger.Add(" >> WD_Search: " & WM_SEARCH, False) ClassLogger.Add(" >> finalProfile: " & FINAL_PROFILE, False) ClassLogger.Add(" >> Move2Folder: " & MOVE2Folder, False) End If Load_Controls() End If End If 'Catch ex As Exception ' MsgBox("Error SAVING Profile-Data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:") ' ClassLogger.Add(">> Fehler in SAVING Profile-Data: " & ex.Message, True) 'End Try 'Me.lblerror.Visible = False If CURRENT_USER_LANGUAGE <> "de-DE" Then btnSave.Text = String.Format("Finish all documents (#{0})", CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count.ToString) Else btnSave.Text = String.Format("Alle Dokumente (#{0}) abschliessen.", CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count.ToString) End If End Sub Sub Load_Controls() ' Try pnldesigner.Controls.Clear() 'Dim dt As DataTable = DD_DMSLiteDataSet.VWPM_CONTROL_INDEX For Each dr As DataRow In DT_PROFILE_CONTROLS.Rows Dim ctrl As Control Select Case dr.Item("CTRL_TYPE").ToString.ToUpper Case "TXT" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch TXT zu laden", False) Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(dr, False) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp ctrl = txt Case "LBL" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch LBL zu laden", False) ctrl = ClassControlCreator.CreateExistingLabel(dr, False) Case "CMB" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch CMB zu laden", False) Dim cmb = ClassControlCreator.CreateExistingCombobox(dr, False) AddHandler cmb.SelectedValueChanged, AddressOf OnCmbselectedIndex #Region "CONTROL LIST" If ClassControlCreator.GET_CONTROL_PROPERTIES(DT_PROFILE_CONTROLS, cmb.Name) = 0 Then MsgBox("Unexpected Error in getting control-properties (CMB load) - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If Dim CURR_SQL_PROVIDER As String If CURRENT_CONTROL_ID > 0 Then If CURR_CON_ID > 0 Then Dim commandsql = CURR_SELECT_CONTROL If commandsql <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> ConID > 0 And commandsql <> ''", False) Dim connectionString As String Dim ConRow As DataRow() = ClassControlCreator.GET_CONNECTION_INFO(CURR_CON_ID) If ConRow Is Nothing Then MsgBox("Unexpected Error in getting Coninfo (CMB load) - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If For Each row As DataRow In ConRow Select Case row("SQL_PROVIDER").ToString.ToLower Case "ms-sql" CURR_SQL_PROVIDER = "ms-sql" If row("USERNAME") = "WINAUTH" Then connectionString = "Data Source=" & row("SERVER") & ";Initial Catalog=" & row("DATENBANK") & ";Trusted_Connection=True;" Else connectionString = "Data Source=" & row("SERVER") & ";Initial Catalog= " & row("DATENBANK") & ";User Id=" & row("USERNAME") & ";Password=" & row("PASSWORD") & ";" End If If LogErrorsOnly = False Then ClassLogger.Add(" >> ConnString Sql-Server: " & connectionString) Case "oracle" CURR_SQL_PROVIDER = "oracle" Dim conn As New OracleConnectionStringBuilder Dim connstr As String If row("SERVER") <> "" And row("DATENBANK").GetType.ToString <> "system.dbnull" Then connstr = "Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HOST=" & row("SERVER") & ")(PORT=1521)))(CONNECT_DATA=(SERVER=DEDICATED)(SERVICE_NAME=" & row("DATENBANK") & ")));User Id=" & row("USERNAME") & ";Password=" & row("PASSWORD") & ";" Else conn.DataSource = row("SERVER") conn.UserID = row("USERNAME") conn.Password = row("PASSWORD") conn.PersistSecurityInfo = True conn.ConnectionTimeout = 120 connstr = conn.ConnectionString End If connectionString = connstr Case Else ClassLogger.Add("ConnectionString-Type not integrated", False) MsgBox("ConnectionString-Type not integrated", MsgBoxStyle.Critical) Exit Sub End Select Next If connectionString Is Nothing = False And CURR_SQL_PROVIDER = "ms-sql" 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 'sql = ClassPatterns.ReplaceAllValues(sql, pnldesigner, aktivesDokument) If clsPatterns.HasOnlySimplePatterns(CURR_SELECT_CONTROL) Then CURR_SELECT_CONTROL = clsPatterns.ReplaceInternalValues(CURR_SELECT_CONTROL) CURR_SELECT_CONTROL = clsPatterns.ReplaceControlValues(CURR_SELECT_CONTROL, pnldesigner) sqlCnn = New SqlClient.SqlConnection(connectionString) ' Try sqlCnn.Open() sqlCmd = New SqlClient.SqlCommand(CURR_SELECT_CONTROL, sqlCnn) adapter.SelectCommand = sqlCmd adapter.Fill(NewDataset) 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 ClassLogger.Add("Unexpected Error in running depending sql-command: " & ex.Message) Clipboard.SetText("Error: " & ex.Message & vbNewLine & "SQL: " & CURR_SELECT_CONTROL) MsgBox(ex.Message, MsgBoxStyle.Critical, "Unexpected Error in running depending sql-command:") End Try End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> Else Row 571", False) End If Else If CURR_CHOICE_LIST <> "" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> In add_ComboBox - AListe: " & CURR_CHOICE_LIST, False) Dim liste = _windream.GetValuesfromAuswahlliste(CURR_CHOICE_LIST) 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, CURR_CHOICE_LIST) End If 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 Case "DTP" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch DTP zu laden", False) ctrl = ClassControlCreator.CreateExistingDatepicker(dr, False) Case "DGV" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch DGV zu laden", False) Dim dgv = ClassControlCreator.CreateExistingDataGridView(dr, False) AddHandler dgv.RowValidating, AddressOf onDGVRowValidating ctrl = dgv Case "CHK" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Checkbox zu laden", False) ctrl = ClassControlCreator.CreateExisingCheckbox(dr, False) 'Case "TABLE" ' If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Tabelle zu laden", False) ' For Each c As DataColumn In DT_PROFILE_CONTROLS.Columns ' '... = c.ColumnName ' Next ' Dim columns As List(Of DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow) = (From r As DD_DMSLiteDataSet.TBPM_CONTROL_TABLERow In DT_PROFILE_CONTROLS ' Where r.CONTROL_ID = dr.Item("GUID") ' Select r).ToList() ' ctrl = ClassControlCreator.CreateExistingTable(dr, columns, False) Case "LINE" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch Linie zu laden", False) ctrl = ClassControlCreator.CreateExistingLine(dr, 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, dr.Item("GUID")) Next If LogErrorsOnly = False Then ClassLogger.Add(" >> Controls geladen", False) ClassLogger.Add("", False) CTRLS_Loaded = True FillIndexValues() 'Catch ex As Exception ' If LogErrorsOnly = False Then MsgBox("Error Load_Controls: " & ex.Message, MsgBoxStyle.Critical, "Attention error:") ' ' allgFunk.Insert_LogEntry(CURRENT_ProfilGUID, "Error Load_Controls: " & ex.Message, Environment.UserName) ' ClassLogger.Add("Unvorhergesehener Fehler bei Load_Controls:" & ex.Message) ' ClassLogger.Add("", False) 'End Try End Sub Sub FillIndexValues() Dim controltype As String Dim indexname As String Dim resultvalue 'Try For Each inctrl As Control In Me.pnldesigner.Controls Dim CONTROL_ID = inctrl.Tag Dim controlRow = (From form In DT_PROFILE_CONTROLS.AsEnumerable' DD_DMSLiteDataSet.VWPM_CONTROL_INDEX.AsEnumerable() Select form Where form.Item("GUID") = CONTROL_ID).Single() Dim Type As String = inctrl.GetType.ToString Dim Typ As String = controlRow.Item("CTRL_TYPE") If Typ = "LBL" Or Typ = "LINE" Then Continue For End If Dim idxname As String = controlRow.Item("INDEX_NAME") ' Wenn kein defaultValue existiert, leeren String setzen Dim defaultValue As String = NotNull(controlRow.Item("DEFAULT_VALUE"), String.Empty) indexname = idxname Dim LoadIDX As Boolean = controlRow.Item("LOAD_IDX_VALUE") If LogErrorsOnly = False Then ClassLogger.Add(" >> INDEX: " & idxname & " - CONTROLNAME: " & inctrl.Name & " - LOAD IDXVALUES: " & LoadIDX.ToString, False) Dim wertWD Select Case Type Case "System.Windows.Forms.TextBox" Try controltype = "Textbox" If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Or idxname = "DD PM-ONLY FOR DISPLAY" Then ' Wenn kein Index exisitiert, defaultValue laden inctrl.Text = defaultValue If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If wertWD = GetWM_Value_Multiple_Docs(idxname) If wertWD = "" And defaultValue <> "" Then inctrl.Text = defaultValue Else inctrl.Text = NotNull(wertWD, defaultValue) End If End If Catch ex As Exception errormessage = "Unexpected error in FillIndexValues TextBox(MI):" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" My.Settings.Save() frmError.ShowDialog() ClassLogger.Add(">> Unexpected error in FillIndexValues TextBox(MI): " & ex.Message, True) ClassLogger.Add(">> Controltype: " & controltype, False) ClassLogger.Add(">> Indexname windream: " & indexname, False) Exit Sub End Try Case "System.Windows.Forms.ComboBox" controltype = "ComboBox" Dim cmb As ComboBox = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Then If defaultValue = String.Empty Then cmb.SelectedIndex = -1 Else cmb.Text = defaultValue End If If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If wertWD = GetWM_Value_Multiple_Docs(idxname) If wertWD Is Nothing Or wertWD = "" Then If defaultValue = String.Empty Then cmb.SelectedIndex = -1 Else cmb.SelectedIndex = cmb.FindStringExact(defaultValue) End If Else cmb.SelectedIndex = cmb.FindStringExact(wertWD) End If End If Case "System.Windows.Forms.DataGridView" controltype = "DataGridView" Dim dgv As DataGridView = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then If LoadIDX = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) Exit Select End If wertWD = GetWM_Value_Multiple_Docs(idxname) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then Select Case Typ 'Tabellendarstellung Case "TABLE" Dim dt As DataTable = ClassDatabase.Return_Datatable("SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = " & CONTROL_ID) Dim SpaltenWerte As String() If dt.Rows.Count > 1 Then For Each Zeile As Object In wertWD SpaltenWerte = Split(Zeile, Delimiter) Select Case dt.Rows.Count 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 "System.Windows.Forms.CheckBox" controltype = "CheckBox" If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If If idxname Is Nothing = False Then Dim chk As CheckBox = inctrl If LoadIDX = False Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) If defaultValue <> String.Empty Then Dim result If Boolean.TryParse(defaultValue, result) Then chk.Checked = result End If End If Exit Select End If wertWD = GetWM_Value_Multiple_Docs(idxname) If wertWD Is Nothing Then ClassLogger.Add(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & indexname & "' ist nothing. Check defaultvalue", False) chk.Checked = False Else If wertWD.ToString = "" Then If defaultValue <> String.Empty Then Dim result If Boolean.TryParse(defaultValue, result) Then chk.Checked = result Else : chk.Checked = False End If Else chk.Checked = False End If Else Dim _value If wertWD.ToString = "System.Object[]" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> CheckBoxValue with VektorField: " & idxname, False) If wertWD.length = 1 Then _value = wertWD(0) Else ' ClassLogger.Add(" >> Vectorfield " & idxname & "' 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 chk.Checked = True Case Else chk.Checked = False End Select Catch ex As Exception ClassLogger.Add(">> 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 "System.Windows.Forms.DateTimePicker" controltype = "DateTimePicker" Dim DTP As DateTimePicker = inctrl If idxname = "" Then MsgBox("Achtung fehlerhafte Konfiguration:" & vbNewLine & "Für das Control " & inctrl.Name & " wurde KEIN INDEX hinterlegt!" & vbNewLine & "Bitte prüfen Sie den Formulardesigner!", MsgBoxStyle.Critical) Exit For End If End Select Next 'Catch ex As Exception ' errormessage = "Unexpected Error in FillIndexValues(MI):" & vbNewLine & ex.Message & vbNewLine & "Check Logfile" ' My.Settings.Save() ' frmError.ShowDialog() ' ClassLogger.Add(">> Unexpected Error in FillIndexValues(MIs: " & ex.Message, True) ' ClassLogger.Add(">> Controltype: " & controltype, False) ' ClassLogger.Add(">> Indexname windream: " & indexname, False) 'End Try End Sub Private Function GetWM_Value_Multiple_Docs(idxname As String) Try Dim valueAllOver = "" Dim tempIndexValue = "" Dim idoccount As Integer = 1 For Each docrow As DataRow In CURRENT_DT_MASS_CHANGE_DOCS.Rows Dim WMDOC As WMObject Try WMDOC = _windream.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, docrow.Item("FULL_PATH").ToString.Substring(2)) Catch ex As Exception ClassLogger.Add("error while creating WMObject in (textCheckIndex): " & ex.Message) Exit For End Try If Not IsNothing(WMDOC) Then CURRENT_WMFILE = WMDOC If idxname.StartsWith("[%VKT") And PROFIL_VEKTORINDEX <> "" Then tempIndexValue = ReturnVektor_IndexValue(idxname, WMDOC) Else tempIndexValue = WMDOC.GetVariableValue(idxname) If IsNothing(tempIndexValue) Then tempIndexValue = "" If tempIndexValue.ToString = "System.Object[]" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> TextBox with VektorField: " & idxname, False) If tempIndexValue.Length = 1 Then tempIndexValue = tempIndexValue(0) Else ' ClassLogger.Add(" >> Vectorfield " & idxname & "' contains more then one value - First value will be used", False) tempIndexValue = tempIndexValue(0) End If End If End If If idoccount = 1 Then valueAllOver = tempIndexValue Else If valueAllOver <> tempIndexValue Then If CURRENT_USER_LANGUAGE <> "de-DE" Then valueAllOver = "(Different values)" Else valueAllOver = "(Untersch. Werte)" End If End If End If idoccount += 1 End If Next Return valueAllOver Catch ex As Exception ClassLogger.Add("Unexpected error in GetWM_Value_Multiple_Docs: " & ex.Message, True) Return "Unexp. error in GetWM_Value_Multiple_Docs" End Try End Function Private Function ReturnVektor_IndexValue(VKTBezeichner As String, WMFile As WMObject) 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 = WMFile.GetVariableValue(PROFIL_VEKTORINDEX) If wertWD Is Nothing = False Then 'Es wird gegen ein Vektorfeld nachindexiert If wertWD.GetType.ToString.Contains("System.Object") Then 'es handelt sich um ein Vektorfeld - Zuweisen der Indexwerte des Vektorfeldes zu Array For Each obj As Object In wertWD If obj Is Nothing = False Then ReDim Preserve Sort_Arr(i) Sort_Arr(i) = obj.ToString() i += 1 End If Next 'Das Ergebnis-Array nun Rückwärts sortieren, um die letzte Änderung zu finden For Each _string As Object In Sort_Arr.Reverse() Dim DDPM_String As String = _string.ToString() ' Dim VektorArray() = Split(DDPM_String, Delimiter) If VektorArray(1).ToString.ToLower = name.ToLower Then value = VektorArray(2) Exit For End If Next End If End If If value Is Nothing Then value = "" Return value Catch ex As Exception MsgBox("Unexpected Error in ReturnVektor_IndexValue(MV): " & vbNewLine & ex.Message, MsgBoxStyle.Critical) ClassLogger.Add("Unexpected Error in ReturnVektor_IndexValue(MV): " & ex.Message) Return "" End Try End Function 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 CTRLS_Loaded = True And FORM_Shown = True Then If (e.KeyCode = Keys.Return) Or (e.KeyCode = Keys.Tab) Or (e.KeyCode = Keys.Enter) Then Try If ClassControlCreator.GET_CONTROL_PROPERTIES(DT_PROFILE_CONTROLS, box.Name) = 0 Then MsgBox("Unexpected Error in getting control-properties - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If If ClassControlCreator.GET_DEPENDING_CONTROLS(DT_PROFILE_CONTROLS, box.Name) = False Then MsgBox("Unexpected Error in getting dependent controls - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If For Each ROW As DataRow In CURR_DT_DEPENDING_CONTROLS.Rows 'Try Dim displayboxname = ROW.Item(Name).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, WMObject, CURRENT_USER_PRENAME, CURRENT_USER_SURNAME, CURRENT_USER_SHORTNAME, CURRENT_USER_EMAIL) _dependingControl_in_action = True Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _dependingControl_in_action = False End If 'Catch ex As Exception ' ClassLogger.Add("Unexpected Error in displaying SQL-result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) 'End Try Next Catch ex As Exception ClassLogger.Add("Unexpected Error in Eventhandler OnTextBoxKeyUp - ERROR: " & ex.Message) End Try 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) If IsNothing(cmbpanel) Then Exit Sub End If cmbpanel.DataSource = Nothing cmbpanel.DataSource = resultDT cmbpanel.DisplayMember = resultDT.Columns(0).ColumnName cmbpanel.ValueMember = resultDT.Columns(0).ColumnName 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 ' ClassLogger.Add("Unexpected Ersror in Depending_Control_Set_Result - ERROR: " & ex.Message) ' MsgBox("Unexpected error in Depending_Control_Set_Result: " & ex.Message, MsgBoxStyle.Critical) 'End Try End Sub Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs) Dim cmb As ComboBox = sender If cmb.SelectedIndex <> -1 And CTRLS_Loaded = True And FORM_Shown = True Then ' Try If ClassControlCreator.GET_CONTROL_PROPERTIES(DT_PROFILE_CONTROLS, cmb.Name) = 0 Then MsgBox("Unexpected Error in getting control-properties CMB - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If If ClassControlCreator.GET_DEPENDING_CONTROLS(DT_PROFILE_CONTROLS, cmb.Name) = False Then MsgBox("Unexpected Error in getting dependent controls CMB- Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If If _dependingControl_in_action = True Or CURR_DT_DEPENDING_CONTROLS Is Nothing Then Exit Sub End If For Each ROW As DataRow In CURR_DT_DEPENDING_CONTROLS.Rows 'Try Dim displayboxname = ROW.Item("NAME").ToString If Not IsDBNull(ROW.Item("CONNECTION_ID")) And Not IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")) Then Dim sql_Statement = ROW.Item("SQL_UEBERPRUEFUNG") sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, WMObject, CURRENT_USER_PRENAME, CURRENT_USER_SURNAME, CURRENT_USER_SHORTNAME, CURRENT_USER_EMAIL) _dependingControl_in_action = True Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) _dependingControl_in_action = False End If 'Catch ex As Exception ' ClassLogger.Add("Unexpected Error in displaying SQL-result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) 'End Try Next 'Catch ex As Exception ' ClassLogger.Add("Unexpected Error in Eventhandler OnCmbselectedIndex - ERROR: " & ex.Message) 'End Try SendKeys.Send("{TAB}") End If End Sub Public Sub onDGVRowValidating(ByVal sender As Object, ByVal e As DataGridViewCellCancelEventArgs) Dim dgv As DataGridView = sender Try If ClassControlCreator.GET_CONTROL_PROPERTIES(DT_PROFILE_CONTROLS, dgv.Name) = 0 Then MsgBox("Unexpected Error in getting control-properties DGV - Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If If ClassControlCreator.GET_DEPENDING_CONTROLS(DT_PROFILE_CONTROLS, dgv.Name) = False Then MsgBox("Unexpected Error in getting dependent controls DGV- Check the log and inform Your sysadmin!", MsgBoxStyle.Critical) Exit Sub End If If Not IsNothing(CURR_DT_DEPENDING_CONTROLS) And CURR_DT_DEPENDING_CONTROLS.Rows.Count > 0 Then For Each ROW As DataRow In CURR_DT_DEPENDING_CONTROLS.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 ClassLogger.Add("Unexpected Error in Display SQL result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If Catch ex As Exception ClassLogger.Add("Unexpected Error in Eventhandler Variable SQL Result - ERROR: " & ex.Message) End Try End Sub Sub LoadSimpleData(control As Control, controlId As Integer) 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") sql = clsPatterns.ReplaceInternalValues(sqlStatement) dt = ClassDatabase.Return_Datatable(sql) If IsNothing(dt) Then MsgBox($"SQL-Query for control {control.Name} is invalid.") Exit Sub End If If TypeOf control Is TextBox Then Dim firstRow As DataRow = dt.Rows(0) Dim value = firstRow.Item(0) control.Text = value ElseIf TypeOf control Is ComboBox Then 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 ElseIf TypeOf control Is DataGridView Then Dim dataGridView As DataGridView = control dataGridView.DataSource = dt End If Next End Sub Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click Abschluss() End Sub Sub Abschluss() btnSave.Enabled = False 'Eingaben auf Form überprüfen If Check_UpdateIndexe() = False Then Dim workedFiles As Integer For Each docrow As DataRow In CURRENT_DT_MASS_CHANGE_DOCS.Rows CURRENT_DOC_ID = docrow.Item("DOC_ID") CURRENT_DOC_GUID = docrow.Item("DOC_GUID") Dim WMDOC As WMObject Try WMDOC = _windream.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, docrow.Item("FULL_PATH").ToString.Substring(2)) Catch ex As Exception ClassLogger.Add("error while creating WMObject in (IndexVKTMultipleFiles): " & ex.Message) Exit For End Try If Not IsNothing(WMDOC) Then CURRENT_WMFILE = WMDOC If ClassFinalizeDoc.Write_Final_Metadata = True Then 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) If ClassDatabase.Execute_non_Query(sql) = True Then workedFiles += 1 End If End If 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 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> 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 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 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 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 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 ClassLogger.Add("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 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) '####### ANNOTIEREN WENN KONFIGURIERT ####### If docrow.Item("FULL_PATH").ToString.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 Dim 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 Dim 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 KONFIGURIERT IST####### If MOVE2Folder <> "" Then Dim idxerr_message = _allgFunk.Move2Folder(docrow.Item("FULL_PATH").ToString, MOVE2Folder, CURRENT_ProfilGUID) If idxerr_message <> "" Then MsgBox("Error in Move2Folder - Check the log And inform Your sysadmin", MsgBoxStyle.Critical) End If End If End If End If Next 'Wenn kein Fehler nach der finalen Indexierung gesetzt wurde If workedFiles = CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count Then If CURRENT_USER_LANGUAGE = "de-DE" Then MsgBox(String.Format("{0} Dateien wurden abgeschlossen!", workedFiles), MsgBoxStyle.Information, "Erfolgsmeldung:") ElseIf CURRENT_USER_LANGUAGE = "en-US" Then MsgBox(String.Format("{0} files have been worked successfully!", workedFiles), MsgBoxStyle.Information, "Success:") End If Else If CURRENT_USER_LANGUAGE = "de-DE" Then MsgBox(String.Format("{0} von {1} Dateien wurden abgeschlossen! Bitte prüfen Sie das Log und informieren Ihren Sysadmin.", workedFiles, CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count), MsgBoxStyle.Information, "Achtung:") ElseIf CURRENT_USER_LANGUAGE = "en-US" Then MsgBox(String.Format("{0} of {1} files have been worked successfully - Check the log And inform Your sysadmin!", workedFiles, CURRENT_DT_MASS_CHANGE_DOCS.Rows.Count), MsgBoxStyle.Information, "Attention:") End If End If Me.Close() 'Catch ex As Exception ' errormessage = "Unvorhergesehener Fehler bei Abschluss:" & ex.Message ' My.Settings.Save() ' frmError.ShowDialog() ' ClassLogger.Add(">> 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_UpdateIndexe() ' Try 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_PROFILE_CONTROLS.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 _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("NAME") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist If dr.Item("NAME") = inctrl.Name And (_READ_ONLY = False Or dr.Item("SQL_UEBERPRUEFUNG") <> "") And _IDXName <> "DD PM-ONLY FOR DISPLAY" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & _IDXName & "'", False) If _IDXName = "" Then ClassLogger.Add(" >> Indexname is unexpected empty.", False) Continue For End If Dim Type As String = inctrl.GetType.ToString Select Case Type 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 '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 IndexVKTMultipleFiles(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Error while indexing Textbox with VEKTOR - Check the log and inform Your sysadmin" Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If IndexMultipleFiles(_IDXName, result) = False Then missing = True errmessage = "error while indexing Textbox - Check the log and inform Your sysadmin" Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, input, _IDXName) IndexVKTMultipleFiles(input, PROFIL_LOGINDEX) End If End If End If End If Catch ex As Exception 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:") ClassLogger.Add("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 input = cmb.Text '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 IndexVKTMultipleFiles(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Error while indexing Combobox with VEKTOR - Check the log and inform Your sysadmin" Exit For End If Else Dim result() As String ReDim Preserve result(0) result(0) = input If IndexMultipleFiles(_IDXName, result) = False Then cmb.DroppedDown = True missing = True errmessage = "error while indexing Combobox - Check the log and inform Your sysadmin" Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, input, _IDXName) IndexVKTMultipleFiles(input, PROFIL_LOGINDEX) 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) '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 IndexVKTMultipleFiles(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Error while indexing DatePicker with VEKTOR - Check the log and inform Your sysadmin" Exit For End If Else Dim result() ReDim Preserve result(0) result(0) = CDate(input) 'MsgBox(_IDXName) If IndexMultipleFiles(_IDXName, result) = False Then missing = True errmessage = "Error while indexing DatePicker - Check the log and inform Your sysadmin" Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(input, input, _IDXName) IndexVKTMultipleFiles(input, PROFIL_LOGINDEX) End If End If End If Else If LogErrorsOnly = False Then ClassLogger.Add(" >> 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 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 IndexVKTMultipleFiles(input, PROFIL_VEKTORINDEX) = True Then missing = True errmessage = "Error while indexing Checkbox with VEKTOR - Check the log and inform Your sysadmin" Exit For End If Else If IndexMultipleFiles(_IDXName, result) = False Then missing = True errmessage = "error while indexing Checkbox - Check the log and inform Your sysadmin" Exit For Else 'Nun das Logging If PROFIL_LOGINDEX <> "" Then input = Return_LOGString(CBool(result(0)).ToString, result(0).ToString, _IDXName) IndexVKTMultipleFiles(input, PROFIL_LOGINDEX) 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 IndexMultipleFiles(_IDXName, myVektorArr) = False Then missing = True errmessage = "error while indexing Vektorfeld - Check the log and inform Your sysadmin" 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 ' 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:") ' ClassLogger.Add("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True) ' Return True 'End Try End Function Function Check_Missing(control As Control, typ As String) Select Case typ Case "txt" If control.Text = String.Empty Or control.Text = "(Different values)" Or control.Text = "(Untersch. Werte)" Then Return True End If Return False End Select End Function Private Function IndexMultipleFiles(idxxname As String, idxvalue As Object) Dim _allfine As Boolean = True Try For Each docrow As DataRow In CURRENT_DT_MASS_CHANGE_DOCS.Rows Dim WMDOC As WMObject Try WMDOC = _windream.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, docrow.Item("FULL_PATH").ToString.Substring(2)) Catch ex As Exception ClassLogger.Add("error while creating WMObject in (IndexMultipleFiles): " & ex.Message) _allfine = False Exit For End 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> 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 If Me._windreamPM.RunIndexing(WMDOC, arrIndex, arrValue) = False Then _allfine = False Exit For End If End If Next Return _allfine Catch ex As Exception ClassLogger.Add("Unexpected error in IndexMultipleFiles: " & ex.Message.ToString, True) Return False End Try End Function Private Function IndexVKTMultipleFiles(input As String, NameVKTIndex As String) Dim _allfine As Boolean = True Dim missing As Boolean = False For Each docrow As DataRow In CURRENT_DT_MASS_CHANGE_DOCS.Rows Dim WMDOC As WMObject Try WMDOC = _windream.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, docrow.Item("FULL_PATH").ToString.Substring(2)) Catch ex As Exception ClassLogger.Add("error while creating WMObject in (IndexVKTMultipleFiles): " & ex.Message) _allfine = False missing = True Exit For End Try Dim Anzahl As Integer = 0 Dim myInputArr As String() 'Jeden Wert des Vektorfeldes durchlaufen Dim wertWD = WMDOC.GetVariableValue(NameVKTIndex) 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 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'Den Wert im Array speichern myInputArr(Anzahl) = obj.ToString Anzahl += 1 End If Next End If 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'und den letzten Wert übergeben myInputArr(Anzahl) = input Else 'Das Array anpassen ReDim Preserve myInputArr(Anzahl) 'und den letzten Wert übergeben myInputArr(Anzahl) = input End If If myInputArr.Length > 0 Then 'Jetzt die Datei indexieren If IndexSinglefile(WMDOC, NameVKTIndex, myInputArr) = False Then missing = True End If End If Next Return missing End Function Private Function IndexSinglefile(_dok As WINDREAMLib.WMObject, idxxname As String, idxvalue As Object) Dim File_indexiert As Boolean = False 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> 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 If LogErrorsOnly = False Then ClassLogger.Add(" >> 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) Return File_indexiert End If Catch ex As Exception ClassLogger.Add("Unexpected Error in IndexSinglefile: " & ex.Message.ToString, True) Return Err() End Try 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 ClassLogger.Add(">> 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 & "'" & Delimiter & Environment.UserName & Delimiter & Now.ToString End If Catch ex As Exception ClassLogger.Add(">> Fehler in Return_LOGString: " & ex.Message, True) PM_String = "DD-PM ERROR: " & ex.Message End Try Return PM_String End Function Private Sub frmMassValidator_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing My.Settings.frmMassValidatorSize = Me.Size My.Settings.frmMassValidatorposition = Me.Location My.Settings.Save() End Sub Private Sub frmMassValidator_Shown(sender As Object, e As EventArgs) Handles Me.Shown FORM_Shown = True End Sub Private Sub frmMassValidator_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing 'If Viewer = "docview" Then ' CloseWDDocview() 'End If 'If vpdfviewer = "system" Then ' Kill_PDFAcrobat() 'Else ' If pdfxchange = True Or sumatra = True Then ' Close_PDF_Viewer(Document_Path) ' End If ' KillU_Viewer() 'End If End Sub End Class