TaskFlow/app/DD_PM_WINDREAM/frmMassValidator.vb
Digital Data - Marlon Schreiber a4f7efff3c AdditionalSearches
2019-05-20 11:37:17 +02:00

1697 lines
89 KiB
VB.net

Imports WINDREAMLib
Imports Oracle.ManagedDataAccess.Client
Imports System.ComponentModel
Imports DD_LIB_Standards
Imports DigitalData.Controls.LookupGrid
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
' 05.10.18: Nutzung des Globalen Windream Objekts WINDREAM
'_windream = New ClassWindream_allgemein
'_windream.Create_Session()
'_windreamPM = New ClassPMWindream()
'_windreamPM.Create_Session()
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
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)
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 = CURRENT_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("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 LOG_ERRORS_ONLY = 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()
' 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"
LOGGER.Debug("Versuch TXT zu laden")
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"
LOGGER.Debug("Versuch LBL zu laden")
ctrl = ClassControlCreator.CreateExistingLabel(dr, False)
Case "CMB"
LOGGER.Debug("Versuch CMB zu laden")
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
LOGGER.Debug("ConID > 0 And commandsql <> ''")
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
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)
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
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"
LOGGER.Debug("Versuch DTP zu laden")
ctrl = ClassControlCreator.CreateExistingDatepicker(dr, False)
Case "DGV"
LOGGER.Debug("Versuch DGV zu laden")
Dim dgv = ClassControlCreator.CreateExistingDataGridView(dr, False)
AddHandler dgv.RowValidating, AddressOf onDGVRowValidating
ctrl = dgv
Case "CHK"
LOGGER.Debug("Versuch Checkbox zu laden")
ctrl = ClassControlCreator.CreateExisingCheckbox(dr, False)
'Case "TABLE"
' If LogErrorsOnly = False Then LOGGER.Info(" >> Versuch Tabelle zu laden")
' 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)
Case "LINE"
LOGGER.Debug("Versuch Linie zu laden")
ctrl = ClassControlCreator.CreateExistingLine(dr, False)
Case "LOOKUP"
ctrl = ClassControlCreator.CreateExistingLookupControl(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)
Next
LOGGER.Debug("Controls geladen")
LOGGER.Info("")
CTRLS_Loaded = True
FillIndexValues()
For Each oControl As Control In pnldesigner.Controls
LoadSimpleData(oControl, oControl.Tag)
Next
'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)
' LOGGER.Info("Unvorhergesehener Fehler bei Load_Controls:" & ex.Message)
' LOGGER.Info("")
'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")
LOGGER.Debug("INDEX: " & idxname & " - CONTROLNAME: " & inctrl.Name & " - LOAD IDXVALUES: " & LoadIDX.ToString)
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
LOGGER.Debug("Indexwert soll nicht geladen werden.")
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
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 "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
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 "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
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 = 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
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 "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
Case "DigitalData.Controls.LookupGrid.LookupControl2"
Try
Dim oLookup As LookupControl2 = inctrl
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.SelectedValues = oArrlist
Else
Dim oArrlist As New List(Of String)
oArrlist.Add(oWindreamValue.ToString)
oLookup.SelectedValues = oArrlist
'_CURRENT_INDEX_ARRAY(oCount, 1) = oWindreamValue.ToString
End If
Else
If Not IsNothing(oLookup.SelectedValues) Then
If oLookup.SelectedValues.Count = 0 And defaultValue <> String.Empty Then
Dim oValues As List(Of String) = defaultValue.Split(",").ToList()
oLookup.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 LookupControl2:")
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
tempIndexValue = WMDOC.GetVariableValue(idxname)
If IsNothing(tempIndexValue) Then tempIndexValue = ""
If tempIndexValue.ToString = "System.Object[]" Then
LOGGER.Debug("TextBox with 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 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, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, 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
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
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 = resultDT.Rows.Count <> 1"
LOGGER.Info(">> Datatable-SQL: " & sqlCommand)
End If
End If
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 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, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, 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
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 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
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 = ClassDatabase.Return_Datatable(sql)
If IsNothing(dt) Then Exit Sub
If dt.Rows.Count = 0 Then Exit Sub
For Each row As DataRow In dt.Rows
Dim name As String = row.Item("NAME")
If IsDBNull(row.Item("CONNECTION_ID")) Then Continue For
If IsDBNull(row.Item("SQL_UEBERPRUEFUNG")) Then Continue For
Dim sqlStatement As String = row.Item("SQL_UEBERPRUEFUNG")
Dim connectionId As Integer = row.Item("CONNECTION_ID")
If clsPatterns.HasComplexPatterns(sqlStatement) Then
Continue For
End If
sql = clsPatterns.ReplaceUserValues(sqlStatement, USER_PRENAME, USER_SURNAME, USER_SHORTNAME, USER_EMAIL)
sql = clsPatterns.ReplaceInternalValues(sql)
LOGGER.Debug(">>> sql after ReplaceInternalValues: " & sql)
'sql = ClassPatterns.ReplaceInternalValues(sqlStatement)
dt = ClassDatabase.Return_Datatable(sql)
If IsNothing(dt) Then
MsgBox($"SQL-Query for control {control.Name} is invalid.")
Exit Sub
End If
Dim oValue
If TypeOf control Is TextBox Then
Try
Dim firstRow As DataRow = dt.Rows(0)
Dim value = firstRow.Item(0)
control.Text = value
oValue = value
Catch ex As Exception
LOGGER.Error(ex)
clsLogger.Add("Error in LoadSimpleData for TextBox: " & ex.Message)
End Try
ElseIf TypeOf control Is ComboBox Then
Try
Dim comboxBox As ComboBox = control
Dim list As New List(Of String)
For Each _row As DataRow In dt.Rows
list.Add(_row.Item(0))
Next
comboxBox.DataSource = list
Catch ex As Exception
LOGGER.Error(ex)
clsLogger.Add("Error in LoadSimpleData for Combobox: " & ex.Message)
End Try
ElseIf TypeOf control Is LookupControl2 Then
Try
Dim lookup As LookupControl2 = control
lookup.DataSource = dt
Catch ex As Exception
LOGGER.Error(ex)
clsLogger.Add("Error in LoadSimpleData for LookupControl2: " & ex.Message)
End Try
'ElseIf TypeOf control Is GridControl Then
' Try
' Dim dataGridView As GridControl = control
' Dim oDataSource As DataTable = dataGridView.DataSource
' If oDataSource Is Nothing OrElse oDataSource.Rows.Count = 0 Then
' 'dataGridView.DataSource = dt
' Dim oDatatable As DataTable = dt.Clone()
' For Each oColumn As DataColumn In oDatatable.Columns
' If oDataSource.Columns(oColumn.ColumnName) Is Nothing Then
' 'oDataSource.Columns.Add(oColumn)
' oDataSource.Columns.Add(oColumn.ColumnName, oColumn.DataType)
' End If
' Next
' For Each oRow As DataRow In dt.Rows
' oDataSource.ImportRow(oRow)
' Next
' dataGridView.DataSource = oDataSource
' End If
' Catch ex As Exception
' LOGGER.Error(ex)
' clsLogger.Add("Error in LoadSimpleData for DataGridView: " & ex.Message)
' End Try
End If
Next
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"))
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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(WMDOC) = 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
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 inctrl As Control In Me.pnldesigner.Controls
If IsNothing(inctrl.Tag) Then
Continue For
End If
If inctrl.Tag = CTRL_ID Then
'######
Dim Type As String = inctrl.GetType.ToString
Select Case Type
Case "System.Windows.Forms.TextBox"
Try
value_from_control = inctrl.Text
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case "System.Windows.Forms.ComboBox"
Dim cmb As ComboBox = inctrl
Try
value_from_control = cmb.Text
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case "System.Windows.Forms.DateTimePicker"
Dim dtp As DateTimePicker = inctrl
Try
value_from_control = dtp.Value.ToString
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
Case "System.Windows.Forms.CheckBox"
Dim chk As CheckBox = inctrl
Try
value_from_control = chk.Checked
Catch ex As Exception
LOGGER.Error(ex)
value_from_control = String.Empty
End Try
End Select
End If
Next
If Not IsNothing(value_from_control) And value_from_control <> String.Empty Then
WORK_HISTORY_ENTRY = WORK_HISTORY_ENTRY.ToString.Replace(element.Value, value_from_control)
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Unexpected Error in Checking control values for WORK_HISTORY_ENTRY - ERROR: " & ex.Message)
End Try
Next
If WORK_HISTORY_ENTRY.ToString.Contains("@DATE") Then
WORK_HISTORY_ENTRY.ToString.Replace("@DATE", Now.ToShortDateString)
End If
If WORK_HISTORY_ENTRY.ToString.Contains("@USERNAME") Then
WORK_HISTORY_ENTRY.ToString.Replace("@USERNAME", Environment.UserName)
End If
Else
WORK_HISTORY_ENTRY = ""
End If
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, _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:")
ElseIf USER_LANGUAGE = "en-US" Then
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:")
ElseIf 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()
' LOGGER.Info(">> Unvorhergesehener Fehler bei Abschluss: " & ex.Message, True)
'End Try
Else
'lblerror.Visible = True
'lblerror.Text = errmessage
errormessage = errmessage
frmError.ShowDialog()
End If
btnSave.Enabled = True
End Sub
Function Check_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
LOGGER.Debug("Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & _IDXName & "'")
If _IDXName = "" Then
LOGGER.Info(" >> Indexname is unexpected empty.")
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
LOGGER.Error(ex)
Dim st As New StackTrace(True)
st = New StackTrace(ex, True)
MsgBox("Unvorhergesehener Fehler in Check_UpdateIndexe TextBox: " & vbNewLine & ex.Message & vbNewLine & "Line: " & st.GetFrame(0).GetFileLineNumber().ToString, MsgBoxStyle.Critical, "Error:")
LOGGER.Info("Unvorhergesehener Fehler in Check_UpdateIndexe:" & ex.Message & " - Line: " & st.GetFrame(0).GetFileLineNumber().ToString, True)
Return True
End Try
Case "System.Windows.Forms.ComboBox"
Dim cmb As ComboBox = inctrl
'Wenn kein Wert ausgewählt wurde und der Index aber gesetzt werden muss
If cmb.SelectedIndex = -1 And _MUSSEINGABE = True Then
missing = True
errmessage = "Please Choose an entry out of ComboBox '" & cmb.Name & "'"
Exit For
ElseIf cmb.SelectedIndex <> -1 Then
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
LOGGER.Debug("DateValue is 01.01.0001 00:00:00")
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:")
' 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"
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"))
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
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 & Environment.UserName & Delimiter & Now.ToString
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(">> Fehler in Return_PM_VEKTOR: " & ex.Message, True)
PM_String = "DD-PM ERROR: " & ex.Message
End Try
Return PM_String
End Function
Function Return_LOGString(input As String, old As String, indexname As String)
Dim PM_String As String
Try
If old = "DDFINALINDEX" Then
PM_String = "DD-PMlog-FINAL" & Delimiter & indexname & Delimiter & input & Delimiter & Environment.UserName & Delimiter & Now.ToString
Else
PM_String = "DD-PMlog-CHG" & Delimiter & indexname & Delimiter & "NEW: '" & input & "'" & Delimiter & Environment.UserName & Delimiter & Now.ToString
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info(">> Fehler in Return_LOGString: " & ex.Message, True)
PM_String = "DD-PM ERROR: " & ex.Message
End Try
Return PM_String
End Function
Private 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
Me.BringToFront()
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