Files
TaskFlow/app/TaskFlow/clsPatterns.vb
2026-03-25 15:20:39 +01:00

736 lines
32 KiB
VB.net

Imports System.Text.RegularExpressions
Imports DevExpress.Xpo.Helpers.AssociatedCollectionCriteriaHelper
Imports DevExpress.XtraEditors
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Columns
Imports DevExpress.XtraGrid.Views.Grid
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 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 INT_VALUE_WMDocID = "WMDocID"
Public Const INT_VALUE_IDBID = "IDBObjID"
Public Const MAX_TRY_COUNT = 5
''' <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}
Private Shared _ControlLookupCache As Dictionary(Of String, Control)
''' <summary>
''' Clears the control lookup cache. Call when controls are dynamically added/removed.
''' </summary>
Public Shared Sub ClearControlCache()
_ControlLookupCache = Nothing
LOGGER.Debug("Control cache cleared")
End Sub
''' <summary>
''' Aktualisiert den Wert eines Controls im Cache
''' </summary>
Public Shared Sub UpdateControlInCache(controlName As String, newValue As Object)
' FIX: SyncLock auf Nothing ist illegal → GetType(clsPatterns) als stabilen Lock-Anker nutzen
SyncLock GetType(clsPatterns)
If _ControlLookupCache Is Nothing OrElse Not _ControlLookupCache.ContainsKey(controlName) Then
LOGGER.Warn($"Control [{controlName}] not found in cache for update")
Return
End If
' Hole das Control aus dem Cache
Dim ctrl As Control = _ControlLookupCache(controlName)
' Aktualisiere den WERT des Controls basierend auf seinem Typ
Try
Select Case ctrl.GetType
Case GetType(TextEdit), GetType(MemoEdit)
DirectCast(ctrl, BaseEdit).EditValue = newValue
Case GetType(LookupControl3)
Dim lookup = DirectCast(ctrl, LookupControl3)
If TypeOf newValue Is List(Of String) Then
lookup.Properties.SelectedValues = DirectCast(newValue, List(Of String))
ElseIf TypeOf newValue Is String Then
lookup.Properties.SelectedValues = New List(Of String) From {newValue.ToString()}
End If
' ========== FIX START: Beide ComboBox-Typen unterstützen ==========
Case GetType(System.Windows.Forms.ComboBox)
DirectCast(ctrl, System.Windows.Forms.ComboBox).Text = newValue?.ToString()
Case GetType(DevExpress.XtraEditors.ComboBoxEdit)
DirectCast(ctrl, DevExpress.XtraEditors.ComboBoxEdit).Text = newValue?.ToString()
' ========== FIX END ==========
Case GetType(CheckBox)
If TypeOf newValue Is Boolean Then
DirectCast(ctrl, CheckBox).Checked = CBool(newValue)
End If
Case GetType(DateTimePicker)
If TypeOf newValue Is Date Then
DirectCast(ctrl, DateTimePicker).Value = CDate(newValue)
End If
Case Else
LOGGER.Warn($"Unsupported control type for cache update: {ctrl.GetType.Name}")
End Select
LOGGER.Debug($"Cache updated for control [{controlName}] with value type [{newValue?.GetType().Name}]")
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn($"Failed to update control [{controlName}]: {ex.Message}")
End Try
End SyncLock
End Sub
''' <summary>
''' Batch-Update für mehrere Controls
''' </summary>
Public Shared Sub UpdateMultipleControlsInCache(updates As Dictionary(Of String, Object))
If updates Is Nothing OrElse updates.Count = 0 Then Return
' FIX: Gleicher Lock-Anker wie UpdateControlInCache → kein Deadlock
' Die eigentliche Aktualisierung läuft sequenziell über UpdateControlInCache,
' da SyncLock in VB.NET re-entrant auf demselben Thread ist.
For Each kvp In updates
UpdateControlInCache(kvp.Key, kvp.Value)
Next
LOGGER.Debug($"Batch cache update completed for {updates.Count} controls")
End Sub
''' <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 DevExpress.XtraEditors.XtraScrollableControl, is_SQL As Boolean) As String
Dim oResult = input
Try
If Not HasAnyPatterns(oResult) Then
Return oResult
End If
LOGGER.Debug($"input BEFORE replacing: [{oResult}]")
oResult = ReplaceInternalValues(oResult)
If Not IsNothing(CURRENT_WMFILE) Then
oResult = ReplaceWindreamIndicies(oResult, CURRENT_WMFILE, is_SQL)
End If
If IDB_ACTIVE = True Then
oResult = ReplaceIDBAttributes(oResult, is_SQL)
End If
'vorher hinter result = ReplaceInternalValues(result)
oResult = ReplaceControlValues(oResult, panel, is_SQL)
If Not IsNothing(oResult) Then
oResult = ReplaceUserValues(oResult)
LOGGER.Debug($"input AFTER replacing: [{oResult}]")
End If
Return oResult
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Error($"❌ CRITICAL ERROR in ReplaceAllValues!")
LOGGER.Error($" Input: [{input}]")
LOGGER.Error($" Last successful result: [{oResult}]")
LOGGER.Error($" Exception Type: [{ex.GetType().Name}]")
LOGGER.Error($" Message: [{ex.Message}]")
LOGGER.Error($" StackTrace: [{ex.StackTrace}]")
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
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_WMDocID)
oResult = ReplacePattern(oResult, PATTERN_INT, CURRENT_DOC_ID)
End While
While ContainsPatternAndValue(oResult, PATTERN_INT, INT_VALUE_IDBID)
oResult = ReplacePattern(oResult, PATTERN_INT, CURRENT_DOC_ID)
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.Replace("GROUP_TEXT:", ""))
End While
Return result
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Info("Error in ReplaceUserValues:" & ex.Message)
Return input ' FIX: Originalwert zurückgeben statt implizit Nothing
End Try
End Function
Private Shared Sub RecursiveAddToCache(rootCtrl As Control, cache As Dictionary(Of String, Control))
Dim stack As New Stack(Of Control)()
stack.Push(rootCtrl)
While stack.Count > 0
Dim ctrl As Control = stack.Pop()
If Not String.IsNullOrEmpty(ctrl.Name) Then
cache(ctrl.Name) = ctrl
End If
For Each child As Control In ctrl.Controls
stack.Push(child)
Next
End While
End Sub
Public Shared Function ReplaceControlValues(pInput As String, oPanel As DevExpress.XtraEditors.XtraScrollableControl, oIsSQL As Boolean) As String
Dim oResult = pInput
' Cache beim ersten Aufruf erstellen mit Lock
SyncLock GetType(clsPatterns) ' Class-Level Lock
If _ControlLookupCache Is Nothing Then
_ControlLookupCache = New Dictionary(Of String, Control)()
For Each ctrl As Control In oPanel.Controls
RecursiveAddToCache(ctrl, _ControlLookupCache)
Next
LOGGER.Debug($"Control cache initialized with {_ControlLookupCache.Count} controls")
End If
End SyncLock
Try
LOGGER.Debug($"Starting ReplaceControlValues with input: [{oResult}] for document ID: {CURRENT_DOC_ID}")
Dim oTryCounter = 0
While ContainsPattern(oResult, PATTERN_CTRL)
If oTryCounter > MAX_TRY_COUNT Then
LOGGER.Info($"Max tries in ReplaceControlValues exceeded - Replacing PATTERN_CTRL [{PATTERN_CTRL}] with [0]")
LOGGER.Info($"oResult so far is:{oResult}")
oResult = ReplacePattern(oResult, PATTERN_CTRL, 0)
Exit While
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)
' Beim Cache-Zugriff Lock verwenden
Dim oControl As Control = Nothing
SyncLock _ControlLookupCache
If Not _ControlLookupCache.TryGetValue(oControlName, oControl) Then
LOGGER.Warn($"Control [{oControlName}] not found in cache!")
' Fallback außerhalb des Lock
End If
End SyncLock
' Fallback außerhalb des Lock
If oControl Is Nothing Then
oControl = oPanel.Controls.Find(oControlName, True).FirstOrDefault()
If oControl IsNot Nothing Then
LOGGER.Info($"Control [{oControlName}] found via fallback. Adding to cache.")
SyncLock _ControlLookupCache
_ControlLookupCache(oControlName) = oControl
End SyncLock
End If
End If
If oControl IsNot Nothing Then
Dim oReplaceValue As String
LOGGER.Debug("oControl.GetType [{0}].", oControl.GetType.ToString)
Select Case oControl.GetType
Case GetType(TextBox)
oReplaceValue = oControl.Text
LOGGER.Debug("TextBox- oReplaceValue will be [{0}].", oReplaceValue)
Case GetType(TextEdit)
Try
oReplaceValue = ClassAllgemeineFunktionen.NotNullString(DirectCast(oControl, TextEdit).EditValue, String.Empty)
Catch ex As Exception
LOGGER.Warn($"Error in ReplaceValue MemoEdit: {ex.Message}")
oReplaceValue = ""
End Try
LOGGER.Debug("TextEdit- oReplaceValue will be [{0}].", oReplaceValue)
Case GetType(MemoEdit)
Try
oReplaceValue = ClassAllgemeineFunktionen.NotNullString(DirectCast(oControl, MemoEdit).EditValue, String.Empty)
Catch ex As Exception
LOGGER.Warn($"Error in ReplaceValue MemoEdit: {ex.Message}")
oReplaceValue = ""
End Try
LOGGER.Debug("MemoEdit- oReplaceValue will be [{0}].", oReplaceValue)
Case GetType(LookupControl3)
Dim oLookupControl3 As LookupControl3 = oControl
' ========== FIX START: NULL-Check ==========
Dim selectedValues As List(Of String) = Nothing
Try
selectedValues = oLookupControl3.Properties.SelectedValues
Catch ex As Exception
LOGGER.Warn($"⚠️ LookupControl [{oControlName}] SelectedValues not accessible: {ex.Message}")
selectedValues = Nothing
End Try
If selectedValues Is Nothing Then
LOGGER.Warn($"⚠️ LookupControl [{oControlName}] SelectedValues is Nothing! Using ERROR_REPLACE_VALUE")
oReplaceValue = ERROR_REPLACE_VALUE
ElseIf selectedValues.Count = 0 Then
LOGGER.Warn($"⚠️ LookupControl [{oControlName}] SelectedValues is empty! Using ERROR_REPLACE_VALUE")
oReplaceValue = ERROR_REPLACE_VALUE
' ========== FIX END ==========
ElseIf selectedValues.Count > 1 Then
LOGGER.Debug($"LookupControl3 [{oControlName}] mit mehr als 1 Value")
Dim oIndex As Integer = 0
For Each oString As String In selectedValues
If oIndex = 0 Then
oReplaceValue = oString
Else
oReplaceValue += "', '" + oString
End If
oIndex += 1
Next
oIsSQL = False
Else ' Count = 1
LOGGER.Debug($"LookupControl3 [{oControlName}] mit genau einem Value")
oReplaceValue = selectedValues(0)
End If
LOGGER.Debug($"oReplaceValue nach Durchlaufen selectedValues: {oReplaceValue}")
LOGGER.Debug($"oReplaceValue nach Durchlaufen selectedValues: {oReplaceValue}")
Case GetType(Windows.Forms.ComboBox)
oReplaceValue = oControl.Text
Case GetType(CheckBox)
Dim oCheckBox As CheckBox = oControl
oReplaceValue = If(oCheckBox.Checked, "1", "0") ' Explizite String-Konvertierung
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
LOGGER.Debug($"[SQL-ESCAPE CHECK] Control: [{oControlName}], oReplaceValue Type: [{If(oReplaceValue?.GetType()?.Name, "NULL")}], Value: [{oReplaceValue}], IsSQL: [{oIsSQL}]")
If oReplaceValue Is Nothing Then
LOGGER.Warn($"⚠️ oReplaceValue is Nothing for control [{oControlName}]! Setting to ERROR_REPLACE_VALUE")
oReplaceValue = ERROR_REPLACE_VALUE
End If
If Not TypeOf oReplaceValue Is String Then
LOGGER.Warn($"⚠️ oReplaceValue is not a String for control [{oControlName}]! Type: [{oReplaceValue.GetType().Name}]. Converting to String.")
oReplaceValue = oReplaceValue.ToString()
End If
If oIsSQL = True Then
oReplaceValue = SafeSqlEscape(oReplaceValue)
End If
oResult = ReplacePattern(oResult, PATTERN_CTRL, oReplaceValue)
Else
LOGGER.Warn("⚠️ Could not get a Control for [{0}].", oControlName)
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
Private Shared Function SafeSqlEscape(value As Object) As String
LOGGER.Debug($"[SafeSqlEscape] Input Type: [{If(value?.GetType()?.Name, "NULL")}], Value: [{value}]")
If value Is Nothing Then
LOGGER.Warn("[SafeSqlEscape] Value is Nothing → returning ERROR_REPLACE_VALUE")
Return ERROR_REPLACE_VALUE
End If
Dim strValue As String
Try
strValue = value.ToString()
Catch ex As Exception
LOGGER.Error(ex)
LOGGER.Warn($"[SafeSqlEscape] ToString() failed: {ex.Message} → returning ERROR_REPLACE_VALUE")
Return ERROR_REPLACE_VALUE
End Try
If String.IsNullOrEmpty(strValue) Then
LOGGER.Warn("[SafeSqlEscape] String is empty → returning ERROR_REPLACE_VALUE")
Return ERROR_REPLACE_VALUE
End If
Dim escaped = strValue.Replace("'", "''")
LOGGER.Debug($"[SafeSqlEscape] Output: [{escaped}]")
Return escaped
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
LOGGER.Debug($"Starting ReplaceWindreamIndicies with input: [{oResult}] for document ID: {CURRENT_DOC_ID}")
While ContainsPattern(oResult, PATTERN_WMI)
Dim oWMValue As String
Dim oIndexName As String = GetNextPattern(oResult, PATTERN_WMI).Value
If oIndexName = "@@DISPLAY_ONLY" Then
oWMValue = String.Empty
Else
oWMValue = pDocument.GetVariableValue(oIndexName)
End If
' FIX 1: >= statt = → Counter springt in 10er-Schritten, trifft niemals genau 5
If IsNothing(oWMValue) AndAlso oTryCounter >= MAX_TRY_COUNT Then
LOGGER.Warn($"[ReplaceWindreamIndicies] Max tries for [{oIndexName}] exceeded → replacing with empty string")
oResult = ReplacePattern(oResult, PATTERN_WMI, String.Empty)
Continue While
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)
Else
' FIX 2: Else-Branch — Nothing-Wert ersetzt den Placeholder mit leerem String
' verhindert Endless Loop wenn Windream-Index keinen Wert hat
LOGGER.Warn($"[ReplaceWindreamIndicies] WMI value for [{oIndexName}] is Nothing → replacing with empty string (counter: {oTryCounter})")
oResult = ReplacePattern(oResult, PATTERN_WMI, String.Empty)
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
LOGGER.Debug($"Starting ReplaceIDBAttributes with input: [{result}] for document ID: {CURRENT_DOC_ID}")
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)
Return input ' FIX: Originalwert zurückgeben statt implizit Nothing
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