FileFlow/Global_Indexer/ClassPatterns.vb
2020-04-01 15:59:12 +02:00

467 lines
19 KiB
VB.net

Imports System.Text.RegularExpressions
Imports DigitalData.Controls.LookupGrid
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 ClassPatterns
' Complex patterns that rely on a datasource like a Database or Windream
Public Const PATTERN_WMI = "WMI"
Public Const PATTERN_IDBA = "IDBA"
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 USER_VALUE_PROFILE_ID = "PROFILE_ID"
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 = 500
Private Shared regex As Regex = New Regex("{#(\w+)#([\w\d\s_-]+)}+")
Private Shared allPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA, PATTERN_USER, PATTERN_INT}
Private Shared complexPatterns As New List(Of String) From {PATTERN_WMI, PATTERN_CTRL, PATTERN_IDBA}
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, language As Object, email As Object, userId As Object, profileId As Object) As String
Try
Dim result = input
LOGGER.Debug($"inputString BEFORE replacing: [{result}]")
result = ReplaceInternalValues(result)
result = ReplaceControlValues(result, panel)
If Not IsNothing(document) Then result = ReplaceWindreamIndicies(result, document)
'result = ReplaceIDBAttributes(result)
result = ReplaceUserValues(result, prename, surname, shortname, language, email, userId, profileId)
LOGGER.Debug($"inputString AFTER replacing: [{result}]")
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
' Replace CurrentDate(s)
While ContainsPatternAndValue(result, PATTERN_INT, INT_VALUE_DATE)
result = ReplacePattern(result, PATTERN_INT, Now.ToShortDateString)
End While
LOGGER.Debug("sql after ReplaceInternalValues: " & input)
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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, language As String, email As Object, userId As Object, profileId As Object) As String
Try
Dim result = input
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PRENAME)
result = ReplacePattern(result, PATTERN_USER, prename)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID)
result = ReplacePattern(result, PATTERN_USER, userId)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME)
result = ReplacePattern(result, PATTERN_USER, surname)
End While
If IsDBNull(shortname) Then
shortname = ""
End If
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME)
result = ReplacePattern(result, PATTERN_USER, shortname)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE)
result = ReplacePattern(result, PATTERN_USER, language)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL)
result = ReplacePattern(result, PATTERN_USER, email)
End While
While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_PROFILE_ID)
result = ReplacePattern(result, PATTERN_USER, profileId)
End While
LOGGER.Debug("sql after ReplaceUserValues: " & input)
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("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
Dim oTryCounter = 0
LOGGER.Debug("Input String: [{0}]", input)
While ContainsPattern(result, PATTERN_CTRL)
LOGGER.Debug("ReplaceControlValues Try no. [{0}]", oTryCounter)
If oTryCounter > MAX_TRY_COUNT Then
Throw New Exception($"Max tries in ReplaceControlValues exceeded - Result so far [{result}].")
End If
LOGGER.Debug("Getting next pattern..")
Dim oNextPattern = GetNextPattern(result, PATTERN_CTRL)
If oNextPattern Is Nothing Then
LOGGER.Debug("No Next Pattern found. Exiting!")
Exit While
End If
LOGGER.Debug("Next Pattern Value: [{0}]", oNextPattern.Value)
LOGGER.Debug("Next Pattern Type: [{0}]", oNextPattern.Type)
Dim controlName As String = oNextPattern.Value
Dim oFoundControl As Control = Nothing
Dim oFoundType As String = Nothing
For Each oControl As Control In panel.Controls
If TypeOf oControl Is Label Then
Continue For
End If
LOGGER.Debug("Getting control metadata from object: [{0}]", oControl?.Tag?.ToString())
If oControl.Tag Is Nothing Then
LOGGER.Warn("No Metadata object found for control [{0}]. Skipping.", oControl.Name)
Continue For
End If
Dim oMeta = TryCast(oControl.Tag, ClassControls.ControlMeta)
LOGGER.Debug("Metadata IndexName: [{0}]", oMeta.IndexName)
LOGGER.Debug("Metadata IndexType: [{0}]", oMeta.IndexType)
LOGGER.Debug("Checking Control Name matches..")
If oMeta Is Nothing Then
LOGGER.Warn("No Metadata found for control [{0}]. Skipping.", oControl.Name)
Continue For
End If
If oMeta.IndexName = controlName Then
LOGGER.Debug("Control Name matches! Matching Control: [{0}]", controlName)
oFoundControl = oControl
oFoundType = oMeta.IndexType
Exit For
End If
Next
If oFoundControl IsNot Nothing Then
Dim oValue As String = String.Empty
LOGGER.Debug("Found Control [{0}], continuing with setting value..", oFoundControl.Name)
If TypeOf oFoundControl Is TextBox Then
Try
oValue = DirectCast(oFoundControl, TextBox).Text
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn("Control Value for TextBox [{0}] could not be retrieved!", oFoundControl.Name)
End Try
ElseIf TypeOf oFoundControl Is CheckBox Then
Try
oValue = IIf(DirectCast(oFoundControl, CheckBox).Checked, 1, 0)
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn("Control Value for CheckBox [{0}] could not be retrieved!", oFoundControl.Name)
End Try
ElseIf TypeOf oFoundControl Is LookupControl2 Then
Try
Dim oLookupControl = DirectCast(oFoundControl, LookupControl2)
If oLookupControl.MultiSelect Then
Select Case oFoundType
Case "INTEGER"
oValue = String.Join(",", oLookupControl.SelectedValues)
Case "VARCHAR"
Dim oWrapped = oLookupControl.SelectedValues
oValue = String.Join(",", oWrapped)
Case Else
LOGGER.Warn("Lookup Control with [{0}] is not supported!", oFoundType)
End Select
Else
oValue = NotNull(oLookupControl.SelectedValues.Item(0), "")
End If
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn("Control Value for LookupControl2 [{0}] could not be retrieved!", oFoundControl.Name)
End Try
Else
LOGGER.Debug("Unknown Control type for type [{0}], setting value to empty string.", oFoundControl.Name)
oValue = ""
End If
LOGGER.Debug("Retrieved Value from Control [{0}] is: [{1}]", controlName, oValue)
result = ReplacePattern(result, PATTERN_CTRL, oValue)
Else
LOGGER.Warn("Control [{0}] not found!", controlName)
End If
oTryCounter += 1
End While
LOGGER.Debug("sql after ReplaceControlValues: " & input)
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceControlValues:" & ex.Message)
Return input
End Try
End Function
Public Shared Function ReplaceWindreamIndicies(input As String, document As WMObject) As String
Try
Dim result = input
Dim oTryCounter As Integer = 0
While ContainsPattern(result, PATTERN_WMI)
Dim indexName As String = GetNextPattern(result, PATTERN_WMI).Value
Dim oWMValue = document.GetVariableValue(indexName)
If IsNothing(oWMValue) And oTryCounter = MAX_TRY_COUNT Then
LOGGER.Warn("Exit from ReplaceWindreamIndicies as oWMValue is still nothing and oTryCounter is 500!")
Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.")
End If
If oWMValue IsNot Nothing Then
result = ReplacePattern(result, PATTERN_WMI, oWMValue)
End If
oTryCounter += 100
End While
LOGGER.Debug("sql after ReplaceWindreamIndicies: " & input)
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceWindreamIndicies:" & ex.Message)
End Try
End Function
'Public Shared Function ReplaceIDBAttributes(input As String) 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("Exit from ReplaceIDBIndicies as Value is still nothing and oTryCounter is 500!")
' Throw New Exception("Max tries in ReplaceIDBAttributes exceeded.")
' End If
' If oIDBValue IsNot Nothing Then
' Dim oReplaceValue = "{" + $"#{PATTERN_IDBA}#{indexName}" + "}"
' result = result.Replace(oReplaceValue, oIDBValue)
' 'result = ReplacePattern(result, oReplaceValue, oIDBValue)
' End If
' oTryCounter += 100
' 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 = 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) 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