From 6a02439942664256d24385ceee363b7b597b06ea Mon Sep 17 00:00:00 2001 From: Jonathan Jenne Date: Wed, 13 Jun 2018 12:23:55 +0200 Subject: [PATCH] jj: add clsPatterns, fix defaultValue --- app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj | 1 + app/DD_PM_WINDREAM/clsPatterns.vb | 288 +++++++++++++++++++++++ app/DD_PM_WINDREAM/frmValidator.vb | 126 ++++++---- 3 files changed, 369 insertions(+), 46 deletions(-) create mode 100644 app/DD_PM_WINDREAM/clsPatterns.vb diff --git a/app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj b/app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj index e57ab17..ed8eb17 100644 --- a/app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj +++ b/app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj @@ -162,6 +162,7 @@ + frmAbout.vb diff --git a/app/DD_PM_WINDREAM/clsPatterns.vb b/app/DD_PM_WINDREAM/clsPatterns.vb new file mode 100644 index 0000000..731eaa0 --- /dev/null +++ b/app/DD_PM_WINDREAM/clsPatterns.vb @@ -0,0 +1,288 @@ +Imports System.Text.RegularExpressions +Imports WINDREAMLib + +''' +''' Defines common Functions for Checking for and replacing placeholders. +''' This Class also includes a child class `Pattern` for passing around Patterns. +''' +''' The format of all placeholders is: +''' {#TYPE#VALUE} +''' +''' Some Examples: +''' {#INT#USERNAME} +''' {#CTRL#CMB_2} +''' {#WMI#String 39} +''' +Public Class clsPatterns + ' Complex patterns that rely on a datasource like a Database or Windream + Public Const PATTERN_WMI = "WMI" + Public Const PATTERN_CTRL = "CTRL" + ' Simple patterns that only rely on .NET functions + Public Const PATTERN_INT = "INT" + ' Simple patterns that rely on Data from the TBDD_USER table + Public Const PATTERN_USER = "USER" + + Public Const USER_VALUE_PRENAME = "PRENAME" + Public Const USER_VALUE_SURNAME = "SURNAME" + Public Const USER_VALUE_EMAIL = "EMAIL" + Public Const USER_VALUE_SHORTNAME = "SHORTNAME" + + Public Const INT_VALUE_USERNAME = "USERNAME" + Public Const INT_VALUE_MACHINE = "MACHINE" + Public Const INT_VALUE_DOMAIN = "DOMAIN" + + Private Shared regex As Regex = New Regex("{#(\w+)#([\w\s_]+)}+") + Private Shared allPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_USER, PATTERN_INT} + Private Shared complexPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL} + Private Shared simplePatterns As New List(Of String) From {PATTERN_USER, PATTERN_INT} + + ''' + ''' Wraps a pattern-type and -value in the common format: {#type#value} + ''' + Public Shared Function WrapPatternValue(type As String, value As String) As String + Return New Pattern(type, value).ToString + End Function + + + Public Shared Function ReplaceAllValues(input As String, panel As Panel, document As WMObject, prename As Object, surname As Object, shortname As Object, email As Object) As String + Try + Dim result = input + + result = ReplaceInternalValues(result) + result = ReplaceControlValues(result, panel) + If Not IsNothing(document) Then result = ReplaceWindreamIndicies(result, document) + result = ReplaceUserValues(result, prename, surname, shortname, email) + + Return result + Catch ex As Exception + ClassLogger.Add("Error in ReplaceAllValues:" & ex.Message) + End Try + End Function + + Public Shared Function ReplaceInternalValues(input As String) As String + Try + Dim result = input + + ' Replace Username(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_USERNAME) + result = ReplacePattern(result, PATTERN_INT, Environment.UserName) + End While + + ' Replace Machinename(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_MACHINE) + result = ReplacePattern(result, PATTERN_INT, Environment.MachineName) + End While + + ' Replace Domainname(s) + While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DOMAIN) + result = ReplacePattern(result, PATTERN_INT, Environment.UserDomainName) + End While + + Return result + Catch ex As Exception + ClassLogger.Add("Error in ReplaceInternalValues:" & ex.Message) + End Try + End Function + + Public Shared Function ReplaceUserValues(input As String, prename As Object, surname As Object, shortname As Object, email As Object) As String + Try + Dim result = input + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME) + result = ReplacePattern(input, PATTERN_USER, prename) + End While + + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME) + result = ReplacePattern(input, PATTERN_USER, surname) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME) + result = ReplacePattern(input, PATTERN_USER, shortname) + End While + + While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL) + result = ReplacePattern(input, PATTERN_USER, email) + End While + + Return result + Catch ex As Exception + ClassLogger.Add("Error in ReplaceUserValues:" & ex.Message) + End Try + End Function + + + Public Shared Function ReplaceControlValues(input As String, panel As Panel) As String + Try + Dim result = input + + While ContainsPattern(result, PATTERN_CTRL) + Dim controlName As String = GetNextPattern(result, PATTERN_CTRL).Value + Dim control As Control = panel.Controls.Find(controlName, False).FirstOrDefault() + + If control IsNot Nothing Then + Dim value As String = control.Text + result = ReplacePattern(result, PATTERN_CTRL, value) + End If + End While + + Return result + Catch ex As Exception + ClassLogger.Add("Error in ReplaceControlValues:" & ex.Message) + End Try + End Function + + Public Shared Function ReplaceWindreamIndicies(input As String, document As WMObject) As String + Try + Dim result = input + + While ContainsPattern(result, PATTERN_WMI) + Dim indexName As String = GetNextPattern(result, PATTERN_WMI).Value + Dim value = document.GetVariableValue(indexName) + + If value IsNot Nothing Then + result = ReplacePattern(result, PATTERN_WMI, value) + End If + End While + + Return result + Catch ex As Exception + ClassLogger.Add("Error in ReplaceWindreamIndicies:" & ex.Message) + End Try + End Function + + Private Shared Function ContainsPattern(input As String, type As String) As String + Dim elements As MatchCollection = regex.Matches(input) + + For Each element As Match In elements + Dim t As String = element.Groups(1).Value + + If t = type Then + Return True + End If + Next + + Return False + End Function + + Public Shared Function GetNextPattern(input As String, type As String) As Pattern + Dim elements As MatchCollection = regex.Matches(input) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + If t = type Then + Return New Pattern(t, v) + End If + Next + + Return Nothing + End Function + + Public Shared Function GetAllPatterns(input As String) As List(Of Pattern) + Dim elements As MatchCollection = regex.Matches(input) + Dim results As New List(Of Pattern) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + results.Add(New Pattern(t, v)) + Next + + Return results + End Function + + Public Shared Function ReplacePattern(input As String, type As String, replacement As String) As String + Dim elements As MatchCollection = regex.Matches(input) + + If IsNothing(replacement) Or replacement = String.Empty Then + Return input + End If + + For Each element As Match In elements + ' if group 1 contains the 'pattern' the replace whole group with 'replacement' + ' and return it + If element.Groups(1).Value = type Then + Return Regex.Replace(input, element.Groups(0).Value, replacement) + End If + Next + + ' no replacement made + Return input + End Function + + Private Shared Function ContainsPatternAndValue(input As String, type As String, value As String) As Boolean + Dim elements As MatchCollection = regex.Matches(input) + + For Each element As Match In elements + ' Pattern in input + Dim t As String = element.Groups(1).Value + Dim v As String = element.Groups(2).Value + + If t = type And v = value Then + Return True + End If + Next + + Return False + End Function + + Public Shared Function HasAnyPatterns(input) As Boolean + Return allPatterns.Any(Function(p) + Return HasPattern(input, p) + End Function) + End Function + + Public Shared Function HasOnlySimplePatterns(input As String) As Boolean + Return Not HasComplexPatterns(input) + End Function + + Public Shared Function HasComplexPatterns(input As String) As Boolean + Return complexPatterns.Any(Function(p) + Return HasPattern(input, p) + End Function) + End Function + + Public Shared Function HasPattern(input As String, type As String) As Boolean + Dim matches = regex.Matches(input) + + For Each match As Match In matches + For Each group As Group In match.Groups + If group.Value = type Then + Return True + End If + Next + Next + + Return False + End Function + + Public Class Pattern + Public ReadOnly Property Type As String + Public ReadOnly Property Value As String + + Public Sub New(type As String, value As String) + Me.Type = type + Me.Value = value + End Sub + + Public Sub New(stringRepresentation As String) + Dim elements As MatchCollection = regex.Matches(stringRepresentation) + Dim first As Match = elements.Item(0) + + Dim t As String = first.Groups(1).Value + Dim v As String = first.Groups(2).Value + + Type = t + Value = v + End Sub + + Public Overrides Function ToString() As String + Return $"{{#{Type}#{Value}}}" + End Function + End Class +End Class \ No newline at end of file diff --git a/app/DD_PM_WINDREAM/frmValidator.vb b/app/DD_PM_WINDREAM/frmValidator.vb index 0fc87ac..15cf529 100644 --- a/app/DD_PM_WINDREAM/frmValidator.vb +++ b/app/DD_PM_WINDREAM/frmValidator.vb @@ -408,53 +408,74 @@ Public Class frmValidator End Sub Sub LoadSimpleData(control As Control, controlId As Integer) - If TypeOf control Is Label Then Exit Sub + Try + If TypeOf control Is Label Then Exit Sub - Dim sql As String = $"SELECT NAME, CONNECTION_ID, SQL_UEBERPRUEFUNG FROM TBPM_PROFILE_CONTROLS WHERE GUID = {controlId} AND PROFIL_ID = {CURRENT_ProfilGUID} AND LEN(ISNULL(SQL_UEBERPRUEFUNG,'')) > 0 AND SQL_UEBERPRUEFUNG NOT LIKE '%#WMI#%' AND SQL_UEBERPRUEFUNG NOT LIKE '%#CTRL#%'" - Dim dt As DataTable = ClassDatabase.Return_Datatable(sql) + 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 + 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") + 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 + 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") + Dim sqlStatement As String = row.Item("SQL_UEBERPRUEFUNG") + Dim connectionId As Integer = row.Item("CONNECTION_ID") - sql = DD_LIB_Standards.clsPatterns.ReplaceInternalValues(sqlStatement) - If LogErrorsOnly = False Then ClassLogger.Add(">>> sql after ReplaceInternalValues: " & sql, False) - 'sql = ClassPatterns.ReplaceInternalValues(sqlStatement) - dt = ClassDatabase.Return_Datatable(sql) + If clsPatterns.HasComplexPatterns(sqlStatement) Then + Continue for + End If - If IsNothing(dt) Then - MsgBox($"SQL-Query for control {control.Name} is invalid.") - Exit Sub - End If + sql = clsPatterns.ReplaceUserValues(sqlStatement, CURRENT_USER_PRENAME, CURRENT_USER_SURNAME, CURRENT_USER_SHORTNAME, CURRENT_USER_EMAIL) + sql = clsPatterns.ReplaceInternalValues(sql) + If LogErrorsOnly = False Then ClassLogger.Add(">>> sql after ReplaceInternalValues: " & sql, False) + 'sql = ClassPatterns.ReplaceInternalValues(sqlStatement) + dt = ClassDatabase.Return_Datatable(sql) - If TypeOf control Is TextBox Then - Dim firstRow As DataRow = dt.Rows(0) - Dim value = firstRow.Item(0) + If IsNothing(dt) Then + MsgBox($"SQL-Query for control {control.Name} is invalid.") + Exit Sub + End If - control.Text = value - ElseIf TypeOf control Is ComboBox Then - Dim comboxBox As ComboBox = control - Dim list As New List(Of String) + If TypeOf control Is TextBox Then + Try + Dim firstRow As DataRow = dt.Rows(0) + Dim value = firstRow.Item(0) - For Each _row As DataRow In dt.Rows - list.Add(_row.Item(0)) - Next + control.Text = value + Catch ex As Exception + 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) - comboxBox.DataSource = list - ElseIf TypeOf control Is DataGridView Then - Dim dataGridView As DataGridView = control + For Each _row As DataRow In dt.Rows + list.Add(_row.Item(0)) + Next - dataGridView.DataSource = dt - End If - Next + comboxBox.DataSource = list + Catch ex As Exception + clsLogger.Add("Error in LoadSimpleData for Combobox: " & ex.Message) + End Try + ElseIf TypeOf control Is DataGridView Then + Try + Dim dataGridView As DataGridView = control + dataGridView.DataSource = dt + Catch ex As Exception + clsLogger.Add("Error in LoadSimpleData for DataGridView: " & ex.Message) + End Try + End If + Next + Catch ex As Exception + MsgBox("Error in LoadSimpleData: " & ex.Message, MsgBoxStyle.Critical) + clsLogger.Add("Error in LoadSimpleData: " & ex.Message) + End Try End Sub 'Sub ComboBoxData(profileId As Integer, controlName As String) @@ -567,6 +588,7 @@ Public Class frmValidator Case "TXT" If LogErrorsOnly = False Then ClassLogger.Add(" >> Versuch TXT zu laden", False) Dim txt As TextBox = ClassControlCreator.CreateExistingTextbox(dr, False) + If LogErrorsOnly = False Then ClassLogger.Add(" >> TXT wurde geladen", False) AddHandler txt.GotFocus, AddressOf OnTextBoxFocus AddHandler txt.LostFocus, AddressOf OnTextBoxLostFocus @@ -935,14 +957,17 @@ Public Class frmValidator If _dependingControl_in_action = True Then Exit Sub End If - + Dim _Step = 0 For Each ROW As DataRow In DT.Rows Try Dim displayboxname = ROW.Item(0).ToString + _Step = 1 If Not IsDBNull(ROW.Item("CONNECTION_ID")) And Not IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")) Then - Dim sql_Statement = ROW.Item("SQL_UEBERPRUEFUNG") + _Step = 2 + Dim sql_Statement = IIf(IsDBNull(ROW.Item("SQL_UEBERPRUEFUNG")), "", ROW.Item("SQL_UEBERPRUEFUNG")) sql_Statement = clsPatterns.ReplaceAllValues(sql_Statement, pnldesigner, aktivesDokument, CURRENT_USER_PRENAME, CURRENT_USER_SURNAME, CURRENT_USER_SHORTNAME, CURRENT_USER_EMAIL) + _Step = 3 If LogErrorsOnly = False Then ClassLogger.Add(">>> sql after ReplaceAllValues: " & sql, False) '' Regulären Ausdruck zum Auslesen der Indexe definieren 'Dim preg As String = "\[%{1}[a-zA-Z0-9\!\$\&\/\(\)\=\?\,\.\-\;\:_öÖüÜäÄ\#\'\+\*\~\{\}\@\€\<\>\ ]+]{1}" @@ -975,12 +1000,14 @@ Public Class frmValidator 'If LogErrorsOnly = False Then ClassLogger.Add(">>> sql_Statement after replacement: " & sql_Statement) _dependingControl_in_action = True + _Step = 4 Depending_Control_Set_Result(displayboxname, sql_Statement, ROW.Item(1)) + _Step = 5 _dependingControl_in_action = False End If Catch ex As Exception - ClassLogger.Add("Unexpected Error in Display SQL result (Combobox) for control: " & ROW.Item(0).ToString & " - ERROR: " & ex.Message) + ClassLogger.Add("Unexpected Error in Display SQL result (Combobox) for control: (" & _Step.ToString & ")" & ROW.Item(0).ToString & " - ERROR: " & ex.Message) End Try Next End If @@ -1716,7 +1743,7 @@ Public Class frmValidator Exit For End If If idxname Is Nothing = False Then - If LoadIDX = False Then + If LoadIDX = False Or idxname = "DD PM-ONLY FOR DISPLAY" Then If defaultValue = String.Empty Then cmb.SelectedIndex = -1 Else @@ -1735,8 +1762,8 @@ Public Class frmValidator If defaultValue = String.Empty Then cmb.SelectedIndex = -1 Else - - cmb.SelectedIndex = cmb.FindStringExact(defaultValue) + cmb.Text = defaultValue + 'cmb.SelectedIndex = cmb.FindStringExact(defaultValue) End If Else cmb.SelectedIndex = cmb.FindStringExact(wertWD) @@ -1823,11 +1850,11 @@ Public Class frmValidator Dim chk As CheckBox = inctrl - If LoadIDX = False Then + If LoadIDX = False Or idxname = "DD PM-ONLY FOR DISPLAY" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexwert soll nicht geladen werden.", False) If defaultValue <> String.Empty Then - Dim result + Dim result = False If Boolean.TryParse(defaultValue, result) Then chk.Checked = result End If @@ -1850,13 +1877,17 @@ Public Class frmValidator chk.Checked = False Else If wertWD.ToString = "" Then + ClassLogger.Add(">> Versuch, default Value zu laden", False) If defaultValue <> String.Empty Then - Dim result + Dim result = False If Boolean.TryParse(defaultValue, result) Then + ClassLogger.Add(">> defaultValue wurde geladen", False) chk.Checked = result - Else : chk.Checked = False + Else + chk.Checked = False End If Else + ClassLogger.Add(">> defaultValue war leer", False) chk.Checked = False End If Else @@ -1875,8 +1906,10 @@ Public Class frmValidator Try Select Case CBool(_value) Case True + ClassLogger.Add(">> CBool(_value) = True", False) chk.Checked = True Case Else + ClassLogger.Add(">> CBool(_value) = False", False) chk.Checked = False End Select Catch ex As Exception @@ -2353,12 +2386,13 @@ Public Class frmValidator 'Den Indexnamen auslesen Dim _IDXName As String = dr.Item("INDEX_NAME") Dim _MUSSEINGABE As Boolean = CBool(dr.Item("VALIDATION")) + Dim _SQL As String = IIf(IsDBNull(dr.Item("SQL_UEBERPRUEFUNG")), "", dr.Item("SQL_UEBERPRUEFUNG")) Dim _READ_ONLY As Boolean = CBool(dr.Item("READ_ONLY")) Dim Typ As String = dr.Item("CTRL_TYPE") Dim CONTROL_ID As String = dr.Item("GUID") Dim ctrl = dr.Item("CTRL_NAME") 'Nur wenn der Name der Zeile entspricht und der Index READ_ONLY FALSE ist - If dr.Item("CTRL_NAME") = inctrl.Name And (_READ_ONLY = False Or dr.Item("SQL_UEBERPRUEFUNG") <> "") And _IDXName <> "DD PM-ONLY FOR DISPLAY" Then + If dr.Item("CTRL_NAME") = inctrl.Name And (_READ_ONLY = False Or _SQL <> "") And _IDXName <> "DD PM-ONLY FOR DISPLAY" Then If LogErrorsOnly = False Then ClassLogger.Add(" >> Indexierung für Control (" & CONTROL_ID & ") '" & ctrl & "' gestartet. Indexname '" & _IDXName & "'", False) If _IDXName = "" Then ClassLogger.Add(" >> Indexname is unexpected empty.", False)