Imports System.Text.RegularExpressions Imports WINDREAMLib Imports DigitalData.Controls.LookupGrid Imports DevExpress.XtraGrid Imports DevExpress.XtraGrid.Views.Grid Imports DevExpress.XtraGrid.Columns ''' ''' 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_ZFATTRIBUTE = "ATTR" Public Const PATTERN_ATTR_AUTO = "ATTR_A" Public Const PATTERN_ATTR_MAN = "ATTR_M" Public Const PATTERN_IDBA = "IDBA" Public Const PATTERN_FILE = "FILE" ' 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 ''' ''' This value will be valid as any datatype, ''' and you can easily check against it ''' 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_ZFATTRIBUTE, PATTERN_ATTR_AUTO, PATTERN_ATTR_MAN, PATTERN_CTRL, PATTERN_IDBA, PATTERN_USER, PATTERN_INT} Private Shared ReadOnly complexPatterns As New List(Of String) From {PATTERN_ZFATTRIBUTE, PATTERN_ATTR_AUTO, PATTERN_ATTR_MAN, PATTERN_CTRL, PATTERN_IDBA} Private Shared ReadOnly 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, 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, My.Application.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, My.Application.User.GivenName) End While While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_USER_ID) result = ReplacePattern(result, PATTERN_USER, My.Application.User.UserId) End While While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SURNAME) result = ReplacePattern(result, PATTERN_USER, My.Application.User.Surname) End While While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_SHORTNAME) result = ReplacePattern(result, PATTERN_USER, My.Application.User.ShortName) End While While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_LANGUAGE) result = ReplacePattern(result, PATTERN_USER, My.Application.User.Language) End While While ContainsPatternAndValue(result, PATTERN_USER, USER_VALUE_EMAIL) result = ReplacePattern(result, PATTERN_USER, My.Application.User.Email) 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 ReplaceAttributes(pInput As String, pIDBOBJ_ID As Long, pIsSQL As Boolean) As String Try Dim oResult = pInput Dim oTryCounter As Integer = 0 While ContainsPattern(oResult, PATTERN_ZFATTRIBUTE) Dim oIndexName As String = GetNextPattern(oResult, PATTERN_ZFATTRIBUTE).Value Dim oValue As String '= pDocument.GetVariableValue(oIndexName) If IsNothing(oValue) And oTryCounter = MAX_TRY_COUNT Then Throw New Exception("Max tries in ReplaceWindreamIndicies exceeded.") End If If oValue IsNot Nothing Then If pIsSQL = True Then LOGGER.Debug($"IS_SQL = True - oReplaceValue = {oValue}") oValue = oValue.ToString().Replace("'", "''") LOGGER.Debug($"oReplaceValue = {oValue}") End If oResult = ReplacePattern(oResult, PATTERN_ZFATTRIBUTE, oValue) 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