TaskFlow/app/TaskFlow/frmMassValidator.vb
2025-09-09 17:30:01 +02:00

1931 lines
104 KiB
VB.net

Imports WINDREAMLib
Imports Oracle.ManagedDataAccess.Client
Imports System.ComponentModel
Imports DigitalData.Controls.LookupGrid
Imports DigitalData.Modules.Language.Utils
Imports System.IO
Imports DigitalData.Modules.EDMI.API.DatabaseWithFallback
Imports DigitalData.Modules.EDMI.API.Constants
Imports DevExpress.XtraEditors
Public Class frmMassValidator
Private DTCONTROLS As DataTable
Private Delimiter As String
Private PROFIL_VEKTORINDEX As String
Private PROFIL_LOGINDEX As String
Private WM_SEARCH As String
Private WMDocFileString As String
Private WMDocPathWindows 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 ControlCreator As ClassControlCreator
Private oErrorMessage 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
' 05.10.18: Nutzung des Globalen Windream Objekts WINDREAM
'_windream = New ClassWindream_allgemein
'_windream.Create_Session()
'_windreamPM = New ClassPMWindream()
'_windreamPM.Create_Session()
ControlCreator = New ClassControlCreator(LOGCONFIG)
LOGGER.Debug("windream initialized frmMassValidator")
Catch ex As Exception
LOGGER.Error(ex)
MsgBox("Error Init_windream:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
LOGGER.Info(">> 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
DTCONTROLS = DatabaseFallback.GetDatatableECM($"SELECT [dbo].[FNPM_LANGUAGE_CONTROL_TEXT] (NAME,{USER_LANGUAGE},CTRL_TYPE,CTRL_TEXT) CTRL_CAPTION_LANG,* FROM TBPM_PROFILE_CONTROLS WHERE SQL_UEBERPRUEFUNG NOT LIKE '%WMI%' AND PROFIL_ID = {CURRENT_ProfilGUID} ORDER BY Y_LOC, X_LOC") ', "MV_Load1")
LOGGER.Debug("Profile Data geladen")
Catch ex As Exception
LOGGER.Error(ex)
MsgBox("Error LOADING profile-data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
LOGGER.Info(">> Fehler in LOADING profile-data: " & ex.Message, True)
Me.Close()
End Try
' Try
Delimiter = BASEDATA_DT_CONFIG.Rows(0).Item("VEKTOR_DELIMITER")
If CURRENT_DT_PROFILE.Rows.Count = 0 Then
LOGGER.Info(">> Profildaten konnten nicht geladen werden - Übergebenes Profil: : " & CURRENT_ProfilName, True)
MsgBox("Profiledata not passed.", MsgBoxStyle.Critical, "Attention:")
Me.Close()
End If
If CURRENT_DT_PROFILE.Rows.Count > 1 Then
MsgBox("More than one profile in results!", MsgBoxStyle.Critical, "Attention:")
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")
CURRENT_PROFILE_LOG_INDEX = PROFIL_LOGINDEX
Me.Text = "Flow Task - " & 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 DEBUG = False Then
LOGGER.Info(" >> Profildaten gespeichert")
LOGGER.Info(" >> WD_Search: " & WM_SEARCH)
LOGGER.Info(" >> finalProfile: " & FINAL_PROFILE)
LOGGER.Info(" >> Move2Folder: " & MOVE2Folder)
End If
Load_Controls()
End If
End If
'Catch ex As Exception
' MsgBox("Error SAVING Profile-Data:" & vbNewLine & ex.Message, MsgBoxStyle.Critical, "Attention:")
' LOGGER.Info(">> Fehler in SAVING Profile-Data: " & ex.Message, True)
'End Try
'Me.lblerror.Visible = False
If 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()
Dim oLastControl As String
Try
pnldesigner.Controls.Clear()
Dim oCount = 0
For Each oControlRow As DataRow In DTCONTROLS.Rows
Dim oControl As Control
oLastControl = $"CtrlName {oControlRow.Item("NAME")}, CtrlIndexname: {oControlRow.Item("INDEX_NAME")}"
Select Case oControlRow.Item("CTRL_TYPE").ToString.ToUpper
Case ClassControlCreator.PREFIX_TEXTBOX
LOGGER.Debug("Versuch TXT zu laden")
Dim txt As TextEdit = ControlCreator.CreateExistingTextbox(oControlRow, False)
AddHandler txt.GotFocus, AddressOf OnTextBoxFocus
AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus
AddHandler txt.KeyUp, AddressOf OnTextBoxKeyUp
oControl = txt
Case "LBL"
LOGGER.Debug("Versuch LBL zu laden")
oControl = ControlCreator.CreateExistingLabel(oControlRow, False)
Case "CMB"
LOGGER.Debug("Versuch CMB zu laden")
If oControlRow.Item("READ_ONLY") Then
Dim cmbReadonly = ControlCreator.CreateExistingTextbox(oControlRow, False)
oControl = cmbReadonly
Else
Dim cmb = ControlCreator.CreateExistingCombobox(oControlRow, False)
AddHandler cmb.SelectedValueChanged, AddressOf OnCmbselectedIndex
#Region "CONTROL LIST"
If ControlCreator.GET_CONTROL_PROPERTIES(DTCONTROLS, 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
LOGGER.Debug("ConID > 0 And commandsql <> ''")
Dim connectionString As String
Dim ConRow As DataRow() = ControlCreator.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
LOGGER.Debug("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
LOGGER.Info("ConnectionString-Type not integrated")
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, True)
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
LOGGER.Error(ex)
LOGGER.Info("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
LOGGER.Debug("Else Row 571")
End If
Else
If CURR_CHOICE_LIST <> "" Then
LOGGER.Debug("In add_ComboBox - AListe: " & CURR_CHOICE_LIST)
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
oControl = cmb
End If
Case "DTP"
LOGGER.Debug("Versuch DTP zu laden")
oControl = ControlCreator.CreateExistingDatepicker(oControlRow, False)
Case "DGV"
LOGGER.Debug("Versuch DGV zu laden")
Dim dgv = ControlCreator.CreateExistingDataGridView(oControlRow, False)
AddHandler dgv.RowValidating, AddressOf onDGVRowValidating
oControl = dgv
Case "CHK"
LOGGER.Debug("Versuch Checkbox zu laden")
oControl = ControlCreator.CreateExisingCheckbox(oControlRow, False)
Case "LINE"
LOGGER.Debug("Versuch Linie zu laden")
oControl = ControlCreator.CreateExistingLine(oControlRow, False)
Case "LOOKUP"
Dim oMultiselect = oControlRow.Item("MULTISELECT")
Dim oReadonly = oControlRow.Item("READ_ONLY")
If oMultiselect = False And oReadonly = True Then
Dim lookupReadonly = ControlCreator.CreateExistingTextbox(oControlRow, False)
oControl = lookupReadonly
Else
Dim lookup As LookupControl3 = ControlCreator.CreateExistingLookupControl(oControlRow, False)
lookup.Properties.PreventDuplicates = oControlRow.Item("VKT_PREVENT_MULTIPLE_VALUES")
lookup.Properties.AllowAddNewValues = oControlRow.Item("VKT_ADD_ITEM")
lookup.Properties.MultiSelect = oMultiselect
If NotNull(oControlRow.Item("DEFAULT_VALUE"), "") <> "" Then
lookup.Properties.SelectedValues = New List(Of String) From {oControlRow.Item("DEFAULT_VALUE")}
End If
oControl = lookup
'Wenn Multiselect false dann prüfen ob abhängiges Control
If CBool(oControlRow.Item("MULTISELECT")) = False Then
Dim filteredData As DataTable = DTCONTROLS.Clone()
Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oControl.Name}%'"
DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges)
If filteredData.Rows.Count = 1 Then
'AddHandler lookup.EditValueChanged, AddressOf onLookUp1
AddHandler lookup.Properties.SelectedValuesChanged, AddressOf onLookUp1
End If
End If
AddHandler lookup.GotFocus, Sub(sender As Control, e As EventArgs)
If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then
lookup.BackColor = Color.LightSteelBlue
End If
End Sub
AddHandler lookup.LostFocus, Sub(sender As Control, e As EventArgs)
If DirectCast(lookup.Tag, ClassControlCreator.ControlMetadata).ReadOnly = False Then
lookup.BackColor = Color.White
End If
End Sub
End If
Case "TABLE"
LOGGER.Debug("Versuch Tabelle zu laden")
Dim oDTMyColumns As DataTable = DatabaseFallback.GetDatatableECM($"SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = {oControlRow.Item("GUID")} ORDER BY SEQUENCE") ', "MV_LoadControls1")
oControl = ControlCreator.CreateExistingGridControl(oControlRow, oDTMyColumns, False)
End Select
If oControl IsNot Nothing AndAlso TypeOf oControl IsNot Label Then
oControl.TabIndex = oCount
End If
pnldesigner.Controls.Add(oControl)
oCount += 1
Next
LOGGER.Debug("Controls geladen")
CTRLS_Loaded = True
FillIndexValues()
For Each oControl As Control In pnldesigner.Controls
LoadSimpleData(oControl, DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid)
Next
Catch ex As Exception
LOGGER.Warn($"Unexpexted Error in Load_Controls [{oLastControl}] - ex.Message")
End Try
End Sub
Public Sub onLookUp1(sender As Object, SelectedValues As List(Of String))
If FORM_Shown = False Then
Exit Sub
End If
Dim oLookup As LookupControl3 = sender
Try
If Not IsNothing(SelectedValues) Then
If SelectedValues.Count = 1 Then
Dim oLOOKUPValue = SelectedValues.Item(0)
Dim oLOOKUPName = oLookup.Name
Dim oControlID = DirectCast(oLookup.Tag, ClassControlCreator.ControlMetadata).Guid
Dim filteredData As DataTable = DTCONTROLS.Clone()
Dim oExpression = $"SQL_UEBERPRUEFUNG like '%#CTRL#{oLOOKUPName}%'"
DTCONTROLS.Select(oExpression).CopyToDataTable(filteredData, LoadOption.PreserveChanges)
If filteredData.Rows.Count = 1 Then
Dim oDEPENDING_GUID = filteredData.Rows(0).Item("GUID")
Dim oDEPENDING_CtrlName = filteredData.Rows(0).Item("NAME")
If _dependingControl_in_action = True Then
Exit Sub
End If
If Not IsDBNull(filteredData.Rows(0).Item("CONNECTION_ID")) And Not IsDBNull(filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG")) Then
Dim oSqlCommand = IIf(IsDBNull(filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG")), "", filteredData.Rows(0).Item("SQL_UEBERPRUEFUNG"))
oSqlCommand = clsPatterns.ReplaceAllValues(oSqlCommand, pnldesigner, True)
LOGGER.Debug(">>> sql after ReplaceAllValues: " & oSqlCommand)
_dependingControl_in_action = True
Dim oDTDEPENDING_RESULT As DataTable = DatabaseFallback.GetDatatableECM(oSqlCommand) ', "MV_OnLookUp1")
Try
Dim oDependingLookup As LookupControl3 = pnldesigner.Controls.Find(oDEPENDING_CtrlName, False).FirstOrDefault()
For Each oControl As Control In pnldesigner.Controls
If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = oDEPENDING_GUID Then
Dim oDependingLookup1 As LookupControl3 = oControl
oDependingLookup1.Properties.DataSource = oDTDEPENDING_RESULT
_dependingControl_in_action = False
Exit For
End If
Next
Catch ex As Exception
LOGGER.Warn($"Could not get the lookupconbtrol for name {oDEPENDING_CtrlName}: " & ex.Message)
_dependingControl_in_action = False
End Try
SendKeys.Send("{TAB}")
End If
End If
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
End Try
End Sub
Sub FillIndexValues()
Dim controltype As String
Dim indexname As String
Try
For Each oControl As Control In Me.pnldesigner.Controls
Dim CONTROL_ID = DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid
Dim controlRow = (From form In DTCONTROLS.AsEnumerable' DD_DMSLiteDataSet.VWPM_CONTROL_INDEX.AsEnumerable()
Select form
Where form.Item("GUID") = CONTROL_ID).Single()
Dim Type As String = oControl.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")
LOGGER.Debug("INDEX: " & idxname & " - CONTROLNAME: " & oControl.Name & " - LOAD IDXVALUES: " & LoadIDX.ToString)
Dim wertWD
Select Case oControl.GetType
Case GetType(DevExpress.XtraEditors.TextEdit)
Try
controltype = "Textbox"
If idxname = "" Then
MsgBox("wrong config:" & vbNewLine & "there is no attribute for control: " & oControl.Name & vbNewLine & "Please check formdesigner as Admin!", 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
oControl.Text = defaultValue
LOGGER.Debug("Indexwert soll nicht geladen werden.")
Exit Select
End If
wertWD = GetWM_Value_Multiple_Docs(idxname)
If wertWD = "" And defaultValue <> "" Then
oControl.Text = defaultValue
Else
oControl.Text = NotNull(wertWD, defaultValue)
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
errormessage = "Unexpected error in FillIndexValues TextBox(MI):" & vbNewLine & ex.Message & vbNewLine & "Check Logfile"
My.Settings.Save()
frmError.ShowDialog()
LOGGER.Info(">> Unexpected error in FillIndexValues TextBox(MI): " & ex.Message, True)
LOGGER.Info(">> Controltype: " & controltype)
LOGGER.Info(">> Indexname windream: " & indexname)
Exit Sub
End Try
Case GetType(System.Windows.Forms.ComboBox)
controltype = "ComboBox"
Dim cmb As Windows.Forms.ComboBox = oControl
If idxname = "" Then
MsgBox("wrong config:" & vbNewLine & "there is no attribute for control: " & oControl.Name & vbNewLine & "Please check formdesigner as Admin!", 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
LOGGER.Debug("Indexwert soll nicht geladen werden.")
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 GetType(System.Windows.Forms.DataGridView)
controltype = "DataGridView"
Dim dgv As DataGridView = oControl
If idxname = "" Then
MsgBox("wrong config:" & vbNewLine & "there is no attribute for control: " & oControl.Name & vbNewLine & "Please check formdesigner as Admin!", MsgBoxStyle.Critical)
Exit For
End If
If idxname Is Nothing = False Then
If LoadIDX = False Then
LOGGER.Debug("Indexwert soll nicht geladen werden.")
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 = DatabaseFallback.GetDatatableECM($"SELECT * FROM TBPM_CONTROL_TABLE WHERE CONTROL_ID = {CONTROL_ID} ORDER BY SEQUENCE") ', "MV_FillIndexValues")
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 GetType(System.Windows.Forms.CheckBox)
controltype = "CheckBox"
If idxname = "" Then
MsgBox("wrong config:" & vbNewLine & "there is no attribute for control: " & oControl.Name & vbNewLine & "Please check formdesigner as Admin!", MsgBoxStyle.Critical)
Exit For
End If
If idxname Is Nothing = False Then
Dim chk As CheckBox = oControl
If LoadIDX = False Then
LOGGER.Debug("Indexwert soll nicht geladen werden.")
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
LOGGER.Info(">> Zurückgegebener Wert des Wertes für Checkbox mit Indexname '" & indexname & "' ist nothing. Check defaultvalue")
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
LOGGER.Debug("CheckBoxValue with VektorField: " & idxname)
If wertWD.length = 1 Then
_value = wertWD(0)
Else '
LOGGER.Info(" >> Vectorfield " & idxname & "' contains more then one value - First value will be used")
_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
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 GetType(System.Windows.Forms.DateTimePicker)
controltype = "DateTimePicker"
Dim DTP As DateTimePicker = oControl
If idxname = "" Then
MsgBox("wrong config:" & vbNewLine & "there is no attribute for control: " & oControl.Name & vbNewLine & "Please check formdesigner as Admin!", MsgBoxStyle.Critical)
Exit For
End If
Case GetType(DigitalData.Controls.LookupGrid.LookupControl3)
Try
Dim oLookup As LookupControl3 = oControl
Dim oWindreamValue = GetWM_Value_Multiple_Docs(idxname)
If Not IsNothing(oWindreamValue) Then
If 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.Properties.SelectedValues = oArrlist
Else
Dim oArrlist As New List(Of String)
oArrlist.Add(oWindreamValue.ToString)
oLookup.Properties.SelectedValues = oArrlist
End If
Else
If Not IsNothing(oLookup.Properties.SelectedValues) Then
If oLookup.Properties.SelectedValues.Count = 0 And defaultValue <> String.Empty Then
Dim oValues As List(Of String) = defaultValue.Split(",").ToList()
oLookup.Properties.SelectedValues = oValues
End If
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(" - Unvorhergesehener Unexpected error in AddLookupGrid - Indexname: " & idxname & " - Fehler: " & vbNewLine & ex.Message)
MsgBox(ex.Message, MsgBoxStyle.Critical, "Unvorhergesehener Unexpected error in Add LookupControl3:")
End Try
End Select
Next
Catch ex As Exception
LOGGER.Error(ex)
errormessage = "Unexpected Error in FillIndexValues(MI):" & vbNewLine & ex.Message & vbNewLine & "Check Logfile"
My.Settings.Save()
frmError.ShowDialog()
LOGGER.Info(">> Unexpected Error in FillIndexValues(MIs: " & ex.Message, True)
LOGGER.Info(">> Controltype: " & controltype)
LOGGER.Info(">> Indexname windream: " & indexname)
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"))
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
Try
tempIndexValue = WMDOC.GetVariableValue(idxname)
Catch ex As Exception
End Try
If IsNothing(tempIndexValue) Then tempIndexValue = ""
If tempIndexValue.ToString = "System.Object[]" Then
LOGGER.Debug("VektorField: " & idxname)
If tempIndexValue.Length = 1 Then
tempIndexValue = tempIndexValue(0)
Else '
LOGGER.Info(" >> Vectorfield " & idxname & "' contains more then one value - First value will be used")
tempIndexValue = tempIndexValue(0)
End If
End If
End If
If idoccount = 1 Then
valueAllOver = tempIndexValue
Else
If valueAllOver <> tempIndexValue Then
If 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
LOGGER.Error(ex)
LOGGER.Info("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
LOGGER.Error(ex)
MsgBox("Unexpected Error in ReturnVektor_IndexValue(MV): " & vbNewLine & ex.Message, MsgBoxStyle.Critical)
LOGGER.Info("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 TextEdit = sender
box.BackColor = Color.LightSteelBlue
box.SelectAll()
End Sub
Public Sub OnTextBoxLostFocus(sender As System.Object, e As System.EventArgs)
Dim box As TextEdit = sender
box.BackColor = Color.White
End Sub
Public Sub OnTextBoxKeyUp(sender As Object, e As KeyEventArgs)
Dim box As TextEdit = 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 ControlCreator.GET_CONTROL_PROPERTIES(DTCONTROLS, 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 ControlCreator.GetDependingControls(DTCONTROLS, 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, True)
_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.Info("Unexpected Error in displaying SQL-result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message)
End Try
Next
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
LOGGER.Debug("Setting Values for Control [{0}]", displayboxname)
'Dim oResultTable As DataTable = ClassDatabase.Return_Datatable_ConId(sqlCommand, sqlConnection)
Dim oResultTable As DataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(sqlCommand, DatabaseType.ECM) With {
.ConnectionId = sqlConnection
})
If Not IsNothing(oResultTable) Then
LOGGER.Debug("Result Table has [{0}] rows", oResultTable.Rows.Count)
LOGGER.Debug("Result Table has [{0}] columns", oResultTable.Columns.Count)
'Ist das Control ein Control was mehrfachwerte enthalten kann
If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_LOOKUP) Or displayboxname.StartsWith(ClassControlCreator.PREFIX_TABLE) Then
LOGGER.Debug("Control is Multivalue")
If displayboxname.StartsWith(ClassControlCreator.PREFIX_COMBOBOX) Then
LOGGER.Debug("Filling Combobox with Results")
Dim oCombobox As Windows.Forms.ComboBox = pnldesigner.Controls(displayboxname)
If IsNothing(oCombobox) Then
Exit Sub
End If
LOGGER.Debug("Control exists, setting results.")
oCombobox.DataSource = Nothing
oCombobox.DataSource = oResultTable
oCombobox.DisplayMember = oResultTable.Columns(0).ColumnName
oCombobox.ValueMember = oResultTable.Columns(0).ColumnName
ElseIf displayboxname.StartsWith(ClassControlCreator.PREFIX_LOOKUP) Then
LOGGER.Debug("Filling Lookup Control with Results")
Dim oLookup As LookupControl3 = pnldesigner.Controls(displayboxname)
If IsNothing(oLookup) Then
Exit Sub
End If
LOGGER.Debug("Control exists, setting results.")
oLookup.Properties.DataSource = Nothing
oLookup.Properties.DataSource = oResultTable
Else
'not implemented
LOGGER.Warn("Depending_Control_Set_Result for [{0}] NOT IMPLEMENTED", displayboxname)
End If
Else
If oResultTable.Rows.Count = 1 Then
pnldesigner.Controls(displayboxname).Text = oResultTable.Rows(0).Item(0).ToString
Else
pnldesigner.Controls(displayboxname).Text = "RESULT = resultDT.Rows.Count <> 1"
LOGGER.Info(">> Datatable-SQL: " & sqlCommand)
End If
End If
Else
LOGGER.Warn("Result Table is nothing!")
End If
Catch ex As Exception
LOGGER.Info("Unexpected Ersror in Depending_Control_Set_Result - ERROR: " & ex.Message)
MsgBox("Unexpected error in Depending_Control_Set_Result: " & ex.Message, MsgBoxStyle.Critical)
End Try
End Sub
Public Sub OnCmbselectedIndex(sender As System.Object, e As System.EventArgs)
Dim cmb As Windows.Forms.ComboBox = sender
If cmb.SelectedIndex <> -1 And CTRLS_Loaded = True And FORM_Shown = True Then
' Try
If ControlCreator.GET_CONTROL_PROPERTIES(DTCONTROLS, 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 ControlCreator.GetDependingControls(DTCONTROLS, 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, True)
_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.Info("Unexpected Error in displaying SQL-result for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message)
End Try
Next
'Catch ex As Exception
' LOGGER.Info("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 ControlCreator.GET_CONTROL_PROPERTIES(DTCONTROLS, 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 ControlCreator.GetDependingControls(DTCONTROLS, 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 oConnectionId = ROW.Item(1)
'Dim resultDT As DataTable = ClassDatabase.Return_Datatable_ConId(sql_Statement, ROW.Item(1))
Dim resultDT As DataTable = DatabaseFallback.GetDatatable(New GetDatatableOptions(sql_Statement, DatabaseType.ECM) With {
.ConnectionId = oConnectionId
})
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
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 = DatabaseFallback.GetDatatableECM(sql) ', "MV_LoadSimpleData")
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)
sql = clsPatterns.ReplaceInternalValues(sql)
LOGGER.Debug(">>> sql after ReplaceInternalValues: " & sql)
'sql = ClassPatterns.ReplaceInternalValues(sqlStatement)
dt = DatabaseFallback.GetDatatableECM(sql) ', "MV_LoadSimpleData1")
If IsNothing(dt) Then
MsgBox($"SQL-Query for control {control.Name} is invalid.")
Exit Sub
End If
Dim oValue
If TypeOf control Is TextEdit 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)
LOGGER.Warn($"Error in LoadSimpleData for TextBox: {ex.Message}")
End Try
ElseIf TypeOf control Is Windows.Forms.ComboBox Then
Try
Dim comboxBox As Windows.Forms.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)
LOGGER.Warn($"Error in LoadSimpleData for Combobox: {ex.Message}")
End Try
ElseIf TypeOf control Is LookupControl3 Then
Try
Dim lookup As LookupControl3 = control
lookup.Properties.DataSource = dt
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn($"Error in LoadSimpleData for LookupControl3: {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)
' End Try
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 CheckAndUpdateIndices() = False Then
Dim workedFiles As Integer
For Each docrow As DataRow In CURRENT_DT_MASS_CHANGE_DOCS.Rows
If docrow.Item("DOC_ID") = 0 Then
Continue For
End If
WMDocPathWindows = ""
WMDocFileString = ""
CURRENT_DOC_ID = docrow.Item("DOC_ID")
CURRENT_DOC_GUID = docrow.Item("DOC_GUID")
GetWMDocPathWindows(0)
If CreateWMObject() = True Then
If ClassFinalizeDoc.Write_Final_Metadata(CURRENT_WMFILE) = True Then
Dim sql = $"EXEC PRTF_PROFILE_FILES_WORK {CURRENT_DOC_ID},{CURRENT_ProfilGUID},{USER_ID},'Worked'"
'String.Format("UPDATE TBPM_PROFILE_FILES SET IN_WORK = 0, WORK_USER = '{0}', EDIT = 1 WHERE GUID = {1}", USER_USERNAME, CURRENT_DOC_GUID)
If DatabaseFallback.ExecuteNonQueryECM(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
LOGGER.Error(ex)
WORK_HISTORY_ENTRY = Nothing
End Try
If Not IsNothing(WORK_HISTORY_ENTRY) Then
If WORK_HISTORY_ENTRY <> String.Empty Then
Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}"
' einen Regulären Ausdruck laden
Dim regulärerAusdruck As System.Text.RegularExpressions.Regex = New System.Text.RegularExpressions.Regex(preg)
' die Vorkommen im SQL-String auslesen
Dim elemente As System.Text.RegularExpressions.MatchCollection = regulärerAusdruck.Matches(WORK_HISTORY_ENTRY)
'####
' alle Vorkommen innerhalbd er Namenkonvention durchlaufen
For Each element As System.Text.RegularExpressions.Match In elemente
Try
LOGGER.Debug("element in RegeX WORK_HISTORY_ENTRY: " & element.Value)
Dim CTRL_ID = element.Value.Substring(2, element.Value.Length - 3)
CTRL_ID = CTRL_ID.Replace("CTRLID", "")
Dim value_from_control
For Each oControl As Control In Me.pnldesigner.Controls
If IsNothing(oControl.Tag) Then
Continue For
End If
If DirectCast(oControl.Tag, ClassControlCreator.ControlMetadata).Guid = CTRL_ID Then
'######
Select Case oControl.GetType
Case GetType(DevExpress.XtraEditors.TextEdit)
Try
value_from_control = oControl.Text
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case GetType(System.Windows.Forms.ComboBox)
Dim cmb As Windows.Forms.ComboBox = oControl
Try
value_from_control = cmb.Text
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case GetType(System.Windows.Forms.DateTimePicker)
Dim dtp As DateTimePicker = oControl
Try
value_from_control = dtp.Value.ToString
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case GetType(System.Windows.Forms.CheckBox)
Dim chk As CheckBox = oControl
Try
value_from_control = chk.Checked
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
End Select
End If
Next
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", USER_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, USER_USERNAME, Environment.MachineName, WORK_HISTORY_ENTRY)
DatabaseFallback.ExecuteNonQueryECM(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 = DatabaseFallback.GetDatatableECM(Sql) ', "MV_Finish1")
If Not IsNothing(DT_ENTRY) Then
If DT_ENTRY.Rows.Count = 1 Then
Dim AnnotationString = DT_ENTRY.Rows(0).Item("WORKED_WHEN") & " " & DT_ENTRY.Rows(0).Item("WORKED_BY") & ": " & DT_ENTRY.Rows(0).Item("STATUS_COMMENT")
ClassAnnotation.Annotate_PDF("Workflow-State:", AnnotationString, 0, False)
End If
End If
End If
Dim value = CURRENT_DT_PROFILE.Rows(0).Item("ANNOTATE_ALL_WORK_HISTORY_ENTRIES")
If CBool(value) = True Then
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 = DatabaseFallback.GetDatatableECM(Sql) ', "MV_Finish2")
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, _windream)
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 USER_LANGUAGE = "de-DE" Then
MsgBox(String.Format("{0} Dateien wurden abgeschlossen!", workedFiles), MsgBoxStyle.Information, "Erfolgsmeldung:")
Else
MsgBox(String.Format("{0} files have been worked successfully!", workedFiles), MsgBoxStyle.Information, "Success:")
End If
Else
If 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:")
Else
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()
' LOGGER.Info(">> Unvorhergesehener Fehler bei Abschluss: " & ex.Message, True)
'End Try
Else
'lblerror.Visible = True
'lblerror.Text = errmessage
errormessage = oErrorMessage
frmError.ShowDialog()
End If
btnSave.Enabled = True
End Sub
Private Function GetWMDocPathWindows(_CheckStandard As Integer)
Dim oResult As String
Dim oSQL = $"SELECT [dbo].[FNPM_GET_WM_FILE_PATH] ({CURRENT_DOC_GUID},{_CheckStandard})"
oResult = DatabaseFallback.GetScalarValueECM(oSQL)
LOGGER.Debug($"Checking file 0 GDP [{oResult}] exists?...")
LOGGER.Debug($"GetWMDocPathWindows returned false - trying with standard again...")
oSQL = $"SELECT [dbo].[FNPM_GET_WM_FILE_PATH] ({CURRENT_DOC_GUID},1)"
oResult = DatabaseFallback.GetScalarValueECM(oSQL)
LOGGER.Debug($"Checking file 1 GDP [{oResult}] exists?...")
If File.Exists(oResult) = False Then
Return False
End If
WMDocPathWindows = oResult
CURRENT_DOC_PATH = WMDocPathWindows
LOGGER.Debug($"CURRENT_DOC_PATH: {CURRENT_DOC_PATH}")
Return True
End Function
Private Function CreateWMObject() As String
CURRENT_WMFILE = Nothing
LOGGER.Debug($"in GetWMDocFileString...'")
Dim oWMRELPATH As String = BASEDATA_DT_CONFIG.Rows.Item(0).Item("WM_REL_PATH")
If oWMRELPATH.EndsWith("\") = False Then
oWMRELPATH = oWMRELPATH & "\"
End If
Dim oWMOwnPath = WMDocPathWindows.Replace(oWMRELPATH, "")
LOGGER.Debug($"oWMOwnPath: {oWMOwnPath}")
Try
Dim oNormalizedPath = WINDREAM.NormalizePath(oWMOwnPath)
LOGGER.Debug($"oNormalizedPath: {oNormalizedPath}")
CURRENT_WMFILE = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oNormalizedPath)
WMDocFileString = oNormalizedPath
LOGGER.Debug("WMDocFileString: " & WMDocFileString)
Return True
Catch ex As Exception
Dim _err1 As Boolean = False
LOGGER.Error(ex)
LOGGER.Info("Unexpected error creating WMObjectMV in GetWMDocFileString: " & ex.Message)
LOGGER.Info("Error Number: " & Err.Number.ToString)
errormessage = $"Could not create a WMObjectMV) for [{oWMOwnPath}]!"
frmError.ShowDialog()
WMDocFileString = ""
Return False
End Try
End Function
Function CheckAndUpdateIndices()
' Try
Dim oMissing As Boolean = False
'Jedes Control auf panel durchlaufen
For Each oControl As Control In Me.pnldesigner.Controls
Dim oMyControlInput As String = ""
'Jedes Control in Konfig Tab durchlaufn
For Each oControlRow As DataRow In DTCONTROLS.Rows
If oControlRow.Item("CTRL_TYPE") = "LBL" Or oControlRow.Item("CTRL_TYPE") = "LINE" Then
Continue For
End If
'Den Indexnamen auslesen
Dim oIndexname As String = oControlRow.Item("INDEX_NAME")
Dim _MUSSEINGABE As Boolean = CBool(oControlRow.Item("VALIDATION"))
Dim _READ_ONLY As Boolean = CBool(oControlRow.Item("READ_ONLY"))
Dim Typ As String = oControlRow.Item("CTRL_TYPE")
Dim CONTROL_ID As String = oControlRow.Item("GUID")
Dim ctrl = oControlRow.Item("NAME")
'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist
If oControlRow.Item("NAME") = oControl.Name And (_READ_ONLY = False Or oControlRow.Item("SQL_UEBERPRUEFUNG") <> "") And oIndexname <> "DD PM-ONLY FOR DISPLAY" Then
LOGGER.Debug("Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & oIndexname & "'")
If oIndexname = "" Then
LOGGER.Info(" >> Indexname is unexpected empty.")
Continue For
End If
Select Case oControl.GetType
Case GetType(DigitalData.Controls.LookupGrid.LookupControl3)
Try
Dim myLookup As LookupControl3 = oControl
'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss
If myLookup.Properties.SelectedValues.Count = 0 And _MUSSEINGABE = True Then
oMissing = True
oErrorMessage = $"No selection in LookUpGrid '{oControl.Name}'"
oControl.BackColor = Color.Red
Exit For
End If
If myLookup.Properties.MultiSelect = True Then
Dim Zeilen As Integer = myLookup.Properties.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 myLookup.Properties.SelectedValues
If value Is Nothing = False Then
'Das Array anpassen
ReDim Preserve myVektorArr(ZeilenGrid)
'Den Wert im Array speichern
myVektorArr(ZeilenGrid) = value
ZeilenGrid += 1
End If
Next
'Jetzt die Datei indexieren
If IndexMultipleFiles(oIndexname, myVektorArr) = False Then
oMissing = True
oErrorMessage = "Fehler beim Indexieren von LookupGrid - 1337: "
Exit For
End If
Else
Dim oValues As New List(Of Object) From {String.Empty}
If IndexMultipleFiles(oIndexname, "") = False Then
oMissing = True
oErrorMessage = "Fehler beim Indexieren von LookupGrid - 1345: "
Exit For
End If
End If
Else
oMyControlInput = myLookup.Properties.SelectedValues.FirstOrDefault()
If IsNothing(oMyControlInput) Then
Continue For
End If
If oMyControlInput = "Unexp. error in GetWM_Value_Multiple_Docs" Then
Continue For
End If
If oMyControlInput = "(Untersch. Werte)" Or oMyControlInput = "(Different values)" Then
Continue For
End If
If oIndexname.StartsWith("[%VKT") Then
oMyControlInput = Return_PM_VEKTOR(oMyControlInput, oIndexname)
'Hier muss nun separat als Vektorfeld indexiert werden
If IndexVKTMultipleFiles(oMyControlInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrorMessage = "Error while indexing LookupGrid with VEKTOR - Check the log and inform Your sysadmin"
Exit For
End If
Else
If oMyControlInput = "(Untersch. Werte)" Or oMyControlInput = "(Different values)" Then
Continue For
End If
Dim result() As String
ReDim Preserve result(0)
result(0) = oMyControlInput
If IndexMultipleFiles(oIndexname, result) = False Then
oMissing = True
oErrorMessage = "Error while indexing LookupGrid - Check the log and inform Your sysadmin"
Exit For
Else
'Nun das Logging
If PROFIL_LOGINDEX <> "" Then
oMyControlInput = Return_LOGString(oMyControlInput, oMyControlInput, oIndexname)
IndexVKTMultipleFiles(oMyControlInput, PROFIL_LOGINDEX)
End If
End If
End If
End If
Catch ex As Exception
LOGGER.Error(ex)
End Try
Case GetType(DevExpress.XtraEditors.TextEdit)
Try
'Als erstes überprüfen ob überhaupt etwas eingetragen worden ist
If Check_Missing(oControl, "txt") = True And _MUSSEINGABE = True Then 'NICHTS EINGETRAGEN
oMissing = True
oErrorMessage = "Missing input in textbox '" & oControl.Name & "'"
oControl.BackColor = Color.Red
Exit For
Else
oMyControlInput = oControl.Text
If oMyControlInput = "(Untersch. Werte)" Or oMyControlInput = "(Different values)" Then
Continue For
End If
'Wenn der Wert in ein Vektorfeld geschrieben wird
If oIndexname.StartsWith("[%VKT") Then
oMyControlInput = Return_PM_VEKTOR(oMyControlInput, oIndexname)
'Hier muss nun separat als Vektorfeld indexiert werden
If IndexVKTMultipleFiles(oMyControlInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrorMessage = "Error while indexing Textbox with VEKTOR - Check the log and inform Your sysadmin"
Exit For
End If
Else
If oMyControlInput = "" Then
Continue For
End If
Dim result() As String
ReDim Preserve result(0)
result(0) = oMyControlInput
If IndexMultipleFiles(oIndexname, result) = False Then
oMissing = True
oErrorMessage = "Unexpected error while indexing Textbox - Check the log and inform Your sysadmin"
Exit For
Else
'Nun das Logging
If PROFIL_LOGINDEX <> "" Then
oMyControlInput = Return_LOGString(oMyControlInput, oMyControlInput, oIndexname)
IndexVKTMultipleFiles(oMyControlInput, PROFIL_LOGINDEX)
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 GetType(System.Windows.Forms.DateTimePicker)
Dim dtp As DateTimePicker = oControl
'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss
If _MUSSEINGABE = True And dtp.Value.ToString = String.Empty Then
oMissing = True
oErrorMessage = "Please Choose DateValue for field'" & dtp.Name & "'"
Exit For
ElseIf dtp.Value.ToString <> "01.01.0001 00:00:00" Then
oMyControlInput = CDate(dtp.Value)
'Wenn der WErt in ein Vektorfeld geschrieben wird
If oIndexname.StartsWith("[%VKT") Then
'Input = die String komponente als String
oMyControlInput = Return_PM_VEKTOR(oMyControlInput, oIndexname)
'Hier muss nun separat als Vektorfeld indexiert werden
If IndexVKTMultipleFiles(oMyControlInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrorMessage = "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(oMyControlInput)
'MsgBox(_IDXName)
If IndexMultipleFiles(oIndexname, result) = False Then
oMissing = True
oErrorMessage = "Error while indexing DatePicker - Check the log and inform Your sysadmin"
Exit For
Else
'Nun das Logging
If PROFIL_LOGINDEX <> "" Then
oMyControlInput = Return_LOGString(oMyControlInput, oMyControlInput, oIndexname)
IndexVKTMultipleFiles(oMyControlInput, PROFIL_LOGINDEX)
End If
End If
End If
Else
LOGGER.Debug("DateValue is 01.01.0001 00:00:00")
End If
Case GetType(System.Windows.Forms.CheckBox)
Dim chk As CheckBox = oControl
oMyControlInput = chk.Checked.ToString
If chk.CheckState = CheckState.Indeterminate And _MUSSEINGABE = True Then
oMissing = True
oErrorMessage = "Option '" & chk.Name & "' is required."
Exit For
End If
If chk.CheckState = CheckState.Indeterminate Then
LOGGER.Debug("Checkbox {0} is indeterminate. Skipping indexing.", chk.Name)
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 oIndexname.StartsWith("[%VKT") Then
'Input = die String komponente mit Boolean als String
oMyControlInput = Return_PM_VEKTOR(chk.Checked.ToString, oIndexname)
'Hier muss nun separat als Vektorfeld indexiert werden
If IndexVKTMultipleFiles(oMyControlInput, PROFIL_VEKTORINDEX) = True Then
oMissing = True
oErrorMessage = "Error while indexing Checkbox with VEKTOR - Check the log and inform Your sysadmin"
Exit For
End If
Else
If IndexMultipleFiles(oIndexname, result) = False Then
oMissing = True
oErrorMessage = "error while indexing Checkbox - Check the log and inform Your sysadmin"
Exit For
Else
'Nun das Logging
If PROFIL_LOGINDEX <> "" Then
oMyControlInput = Return_LOGString(CBool(result(0)).ToString, result(0).ToString, oIndexname)
IndexVKTMultipleFiles(oMyControlInput, PROFIL_LOGINDEX)
End If
End If
End If
Case GetType(System.Windows.Forms.DataGridView)
Dim dgv As DataGridView = oControl
Dim Zeilen As Integer = 0
For Each row As DataGridViewRow In dgv.Rows
Dim exists = False
' MsgBox(row.Cells(0).Value.GetType.ToString)
If row.Cells(0).Value Is Nothing = False Then
Zeilen += 1
End If
Next
'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss
If _MUSSEINGABE = True And Zeilen = 0 Then
oMissing = True
oErrorMessage = "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(oIndexname, myVektorArr) = False Then
oMissing = True
oErrorMessage = "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 oMissing
'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:")
' LOGGER.Info("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"
Dim oTextBox As TextEdit = control
If oTextBox.Text = String.Empty Or oTextBox.Text = "(Different values)" Or oTextBox.Text = "(Untersch. Werte)" Then
Return True
End If
End Select
Return False
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
If docrow.Item("DOC_ID") = 0 Then
Continue For
End If
Dim WMDOC As WMObject
Dim oRelPath = docrow.Item("FULL_PATH").ToString
Try
If oRelPath.StartsWith("W") Then
oRelPath = oRelPath.Substring(2)
Else
If oRelPath.StartsWith("\\") Then
oRelPath = oRelPath.Replace("\\", "\")
ElseIf oRelPath.StartsWith("\") = False Then
oRelPath = "\" & oRelPath
End If
End If
WMDOC = WINDREAM.oSession.GetWMObjectByPath(WMEntity.WMEntityDocument, oRelPath)
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("error while creating WMObject in (IndexMultipleFiles): " & oRelPath)
_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
LOGGER.Debug("Indexing Index '" & idxxname & "' with Arrayvalue")
Dim anzahl As Integer = 0
For Each indexvalue As String In idxvalue
ReDim Preserve arrValue(anzahl)
arrValue(anzahl) = indexvalue
anzahl += 1
Next
Else
LOGGER.Debug("Indexing Index '" & idxxname & "' with value '" & idxvalue(0) & "'")
ReDim Preserve arrValue(0)
arrValue(0) = idxvalue(0).ToString
End If
'Jetzt das eigentliche Indexieren der Datei
If WINDREAM.RunIndexing(WMDOC, arrIndex, arrValue) = False Then
_allfine = False
Exit For
End If
End If
Next
Return _allfine
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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"))
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
LOGGER.Debug("Indexing Index '" & idxxname & "' with Arrayvalue")
Dim anzahl As Integer = 0
For Each indexvalue As String In idxvalue
ReDim Preserve arrValue(anzahl)
arrValue(anzahl) = indexvalue
anzahl += 1
Next
Else
LOGGER.Debug("Indexing Index '" & idxxname & "' with value '" & idxvalue(0) & "'")
ReDim Preserve arrValue(0)
arrValue(0) = idxvalue(0).ToString
End If
'Jetzt das eigentliche Indexieren der Datei
File_indexiert = WINDREAM.RunIndexing(_dok, arrIndex, arrValue)
Return File_indexiert
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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 & USER_USERNAME & Delimiter & Now.ToString
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(">> Fehler in Return_PM_VEKTOR: " & ex.Message, True)
PM_String = "DD-PM ERROR: " & ex.Message
End Try
Return PM_String
End Function
Function Return_LOGString(input As String, old As String, indexname As String)
Dim PM_String As String
Try
If old = "DDFINALINDEX" Then
PM_String = "DD-PMlog-FINAL" & Delimiter & indexname & Delimiter & input & Delimiter & USER_USERNAME & Delimiter & Now.ToString
Else
PM_String = "DD-PMlog-CHG" & Delimiter & indexname & Delimiter & "NEW: '" & input & "'" & Delimiter & USER_USERNAME & Delimiter & Now.ToString
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(">> Fehler in Return_LOGString: " & ex.Message, True)
PM_String = "DD-PM ERROR: " & ex.Message
End Try
Return PM_String
End Function
Private 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
End Class