TaskFlow/app/DD_PM_WINDREAM/clsPatterns.vb
2021-11-12 10:47:27 +01:00

493 lines
19 KiB
VB.net

Imports System.Text.RegularExpressions
Imports WINDREAMLib
Imports DigitalData.Controls.LookupGrid
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraGrid.Columns
''' <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_IDBA = "IDBA"
' Kinds of CTRL Placeholder
'
' Normal Control
' {#CTRL#ControlName}
'
' Summary Item from Table Column
' {#CTRL#ControlName::ColumnName}
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 USER_VALUE_LANGUAGE = "LANGUAGE"
Public Const USER_VALUE_USER_ID = "USER_ID"
Public Const VALUE_PROFILE_ID = "PROFILE_ID"
Public Const VALUE_PROFILE_TITLE = "PROFILE_TITLE"
Public Const INT_VALUE_USERNAME = "USERNAME"
Public Const INT_VALUE_MACHINE = "MACHINE"
Public Const INT_VALUE_DOMAIN = "DOMAIN"
Public Const INT_VALUE_DATE = "DATE"
Public Const MAX_TRY_COUNT = 50
''' <summary>
''' This value will be valid as any datatype,
''' and you can easily check against it
''' </summary>
Public Const ERROR_REPLACE_VALUE = "0"
Private Shared ReadOnly MyRegex As Regex = New Regex("{#(\w+)#([\:\.\w\s_-]+)}+")
Private Shared ReadOnly allPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA, PATTERN_USER, PATTERN_INT}
Private Shared ReadOnly complexPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA}
Private Shared ReadOnly 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, is_SQL As Boolean) As String
Try
Dim result = input
If Not HasAnyPatterns(result) Then
Return result
End If
LOGGER.Debug($"input BEFORE replacing: [{result}]")
result = ReplaceInternalValues(result)
result = ReplaceControlValues(result, panel, is_SQL)
If Not IsNothing(CURRENT_WMFILE) Then
result = ReplaceWindreamIndicies(result, CURRENT_WMFILE, is_SQL)
End If
If IDB_ACTIVE = True Then
result = ReplaceIDBAttributes(result, is_SQL)
End If
If Not IsNothing(result) Then
result = ReplaceUserValues(result)
LOGGER.Debug($"input AFTER replacing: [{result}]")
End If
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceAllValues:" & ex.Message)
Return input
End Try
End Function
Public Shared Function ReplaceInternalValues(pInput As String) As String
Dim oResult = pInput
Try
' Replace Username(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_USERNAME)
oResult = ReplacePattern(oResult, PATTERN_INT, USER_USERNAME)
End While
' Replace Machinename(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_MACHINE)
oResult = ReplacePattern(oResult, PATTERN_INT, Environment.MachineName)
End While
' Replace Domainname(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DOMAIN)
oResult = ReplacePattern(oResult, PATTERN_INT, Environment.UserDomainName)
End While
' Replace CurrentDate(s)
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_DATE)
oResult = ReplacePattern(oResult, PATTERN_INT, Now.ToShortDateString)
End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceInternalValues:" & ex.Message)
Return oResult
End Try
End Function
Public Shared Function ReplaceUserValues(input As String) As String
Try
Dim result = input
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME)
result = ReplacePattern(result, PATTERN_USER, USER_PRENAME)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID)
result = ReplacePattern(result, PATTERN_USER, USER_ID)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME)
result = ReplacePattern(result, PATTERN_USER, USER_SURNAME)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME)
result = ReplacePattern(result, PATTERN_USER, USER_SHORTNAME)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE)
result = ReplacePattern(result, PATTERN_USER, USER_LANGUAGE)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL)
result = ReplacePattern(result, PATTERN_USER, USER_EMAIL)
End While
While ContainsPatternAndValue(result, PATTERN_USER, VALUE_PROFILE_ID)
If IsNothing(CURRENT_CLICKED_PROFILE_ID) Then
CURRENT_CLICKED_PROFILE_ID = 0
End If
result = ReplacePattern(result, PATTERN_USER, CURRENT_CLICKED_PROFILE_ID)
End While
While ContainsPatternAndValue(result, PATTERN_USER, VALUE_PROFILE_TITLE)
If CURRENT_CLICKED_PROFILE_TITLE Is Nothing Then
CURRENT_CLICKED_PROFILE_TITLE = "NONE_TITLE"
End If
result = ReplacePattern(result, PATTERN_USER, CURRENT_CLICKED_PROFILE_TITLE)
End While
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceUserValues:" & ex.Message)
End Try
End Function
Public Shared Function ReplaceControlValues(pInput As String, oPanel As Panel, oIsSQL As Boolean) As String
Dim oResult = pInput
Try
Dim oTryCounter = 0
While ContainsPattern(oResult, PATTERN_CTRL)
If oTryCounter > MAX_TRY_COUNT Then
LOGGER.Warn($"Max tries in ReplaceControlValues exceeded - Replacing with [0]")
oResult = ReplacePattern(oResult, PATTERN_CTRL, 0)
Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{oResult}].")
End If
Dim oControlName As String = GetNextPattern(oResult, PATTERN_CTRL).Value
Dim oColumnName As String = String.Empty
If oControlName.Contains("::") Then
Dim oSplitName = Split(oControlName, "::").ToList()
oControlName = oSplitName.First()
oColumnName = oSplitName.Last()
End If
LOGGER.Debug("Found placeholder for control [{0}].", oControlName)
Dim oControl As Control = oPanel.Controls.Find(oControlName, False).FirstOrDefault()
If oControl IsNot Nothing Then
Dim oReplaceValue As String
Select Case oControl.GetType
Case GetType(TextBox)
oReplaceValue = oControl.Text
Case GetType(LookupControl3)
Dim oLookupControl3 As LookupControl3 = oControl
If oLookupControl3.Properties.SelectedValues.Count = 1 Then
oReplaceValue = oLookupControl3.Properties.SelectedValues.Item(0)
Else
oReplaceValue = ERROR_REPLACE_VALUE
End If
Case GetType(ComboBox)
oReplaceValue = oControl.Text
Case GetType(CheckBox)
Dim oCheckBox As CheckBox = oControl
oReplaceValue = oCheckBox.Checked
Case GetType(GridControl)
Dim oGrid As GridControl = oControl
Dim oView As GridView = oGrid.FocusedView
If oColumnName = String.Empty Then
LOGGER.Warn("Used placeholder for Table [{0}] but without Column Name!", oControlName)
oReplaceValue = ERROR_REPLACE_VALUE
End If
Dim oColumn As GridColumn = oView.Columns.
Where(Function(c) c.FieldName = oColumnName).
SingleOrDefault()
If oColumn?.SummaryItem?.SummaryValue Is Nothing Then
LOGGER.Warn("Column [{0}] not found in Grid!", oColumnName)
oReplaceValue = ERROR_REPLACE_VALUE
Else
oReplaceValue = oColumn.SummaryItem.SummaryValue
End If
Case Else
oReplaceValue = ERROR_REPLACE_VALUE
End Select
If oIsSQL = True Then
'LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oReplaceValue}")
'LOGGER.Debug($"oReplaceValue = {oReplaceValue}")
oReplaceValue = oReplaceValue.Replace("'", "''")
End If
oResult = ReplacePattern(oResult, PATTERN_CTRL, oReplaceValue)
End If
oTryCounter += 1
End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn("Error in ReplaceControlValues:" & ex.Message)
Return oResult
End Try
End Function
Public Shared Function ReplaceWindreamIndicies(pInput As String, pDocument As WMObject, pIsSQL As Boolean) As String
Try
Dim oResult = pInput
Dim oTryCounter As Integer = 0
While ContainsPattern(oResult, PATTERN_WMI)
Dim oIndexName As String = GetNextPattern(oResult, PATTERN_WMI).Value
Dim oWMValue As String = pDocument.GetVariableValue(oIndexName)
If IsNothing(oWMValue) And oTryCounter = MAX_TRY_COUNT Then
Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.")
End If
If oWMValue IsNot Nothing Then
If pIsSQL = True Then
LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oWMValue}")
oWMValue = oWMValue.ToString().Replace("'", "''")
LOGGER.Debug($"oReplaceValue = {oWMValue}")
End If
oResult = ReplacePattern(oResult, PATTERN_WMI, oWMValue)
End If
' Increase counter by 10 to avoid DDOSing the Windream Service
oTryCounter += 10
End While
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceWindreamIndicies:" & ex.Message)
Return pInput
End Try
End Function
Public Shared Function ReplaceIDBAttributes(input As String, IS_SQL As Boolean) As String
Try
Dim result = input
Dim oTryCounter As Integer = 0
While ContainsPattern(result, PATTERN_IDBA)
Dim indexName As String = GetNextPattern(result, PATTERN_IDBA).Value
Dim oIDBValue
If indexName = "ObjectID" Then
oIDBValue = CURRENT_DOC_ID
ElseIf indexName = "OBJID" Then
oIDBValue = CURRENT_DOC_ID
ElseIf indexName = "DocID" Then
oIDBValue = CURRENT_DOC_ID
Else
oIDBValue = IDBData.GetVariableValue(indexName)
End If
If IsNothing(oIDBValue) And oTryCounter = MAX_TRY_COUNT Then
LOGGER.Warn($"Max tries for [{indexName}] in ReplaceIDBAttributes exceeded - Replacing with [0]!")
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
result = result.Replace(oReplaceValue, 0)
Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.")
End If
If oIDBValue IsNot Nothing Or Not IsDBNull(oIDBValue) Then
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
If IS_SQL = True Then
LOGGER.Debug($"IS_SQL = True - oReplaceValue = [{oReplaceValue}]")
If indexName <> "ObjectID" And indexName <> "OBJID" And indexName <> "DocID" Then
Try
oIDBValue = oIDBValue.Replace("'", "''")
Catch ex As Exception
LOGGER.Warn($"Invalid IDBValue for [{indexName}] in ReplaceIDBAttributes [{ex.Message}] - Replacing with [0]!")
oIDBValue = 0
End Try
End If
LOGGER.Debug($"oIDBValue = {oIDBValue}")
End If
result = result.Replace(oReplaceValue, oIDBValue)
Else
LOGGER.Warn($"IDBValue for [{indexName}] in ReplaceIDBAttributes is nothing or dbnull - Replacing with [0]!")
Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
result = result.Replace(oReplaceValue, 0)
End If
' Increase counter by 10 to avoid DDOSing the Database/IDB Service
oTryCounter += 10
End While
LOGGER.Debug("sql after ReplaceIDBAttributes: " & input)
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceIDBAttributes:" & ex.Message)
End Try
End Function
Private Shared Function ContainsPattern(input As String, type As String) As String
Dim elements As MatchCollection = MyRegex.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 = MyRegex.Matches(input)
For Each element As Match In elements
' Pattern in pInput
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 = MyRegex.Matches(input)
Dim results As New List(Of Pattern)
For Each element As Match In elements
' Pattern in pInput
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 = MyRegex.Matches(input)
If IsNothing(replacement) 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 = MyRegex.Matches(input)
For Each element As Match In elements
' Pattern in pInput
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 = MyRegex.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 = MyRegex.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