AppStd/TaskFlow
8
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

jj: add clsPatterns, fix defaultValue

Browse Source
This commit is contained in:
Jonathan Jenne 2018-06-13 12:23:55 +02:00
parent 5b524a0e41
commit 6a02439942
3 changed files with 369 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
app/DD_PM_WINDREAM/DD_PM_WINDREAM.vbproj
View File

@ -162,6 +162,7 @@
<Compile Include="ClassSQLEditor.vb" />
<Compile Include="ClassUser.vb" />
<Compile Include="ClassWorkDoc.vb" />
<Compile Include="clsPatterns.vb" />
<Compile Include="frmAbout.designer.vb">
<DependentUpon>frmAbout.vb</DependentUpon>
</Compile>

288
app/DD_PM_WINDREAM/clsPatterns.vb Normal file
View File

@ -0,0 +1,288 @@
Imports System.Text.RegularExpressions
Imports WINDREAMLib
''' <summary>
''' 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}
''' </summary>
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}
''' <summary>
''' Wraps a pattern-type and -value in the common format: {#type#value}
''' </summary>
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

126
app/DD_PM_WINDREAM/frmValidator.vb
View File

@ -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)