Files
AutoBOM-BOMForge/VBA/ClassModules/cConditionEngine.cls
Misaka_Company f344cbe206 Add VBA source code modules
Added VBA project structure including:
- Class modules for BOM row and condition engine
- Test engine module

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 12:28:29 +08:00

123 lines
5.2 KiB
OpenEdge ABL
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
' ==============================================================================
' 模块名称: cConditionEngine
' 模块类别: 类模块 (Class Module)
' 所属项目: BOMForge
' 模块职责: 负责安全的BOM条件字符串手术解析并注入新的条件分支
' ==============================================================================
Option Explicit
Private regEx As Object
Private Sub Class_Initialize()
' 使VBE
Set regEx = CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.IgnoreCase = True
End Sub
Private Sub Class_Terminate()
' 释放对象内存
Set regEx = Nothing
End Sub
' ------------------------------------------------------------------------------
' 函数名称: InjectOr
' 函数功能: 将新参数作为 OR 条件安全地注入到现有的逻辑表达式中
' 参数说明:
' - expression: "lcfw=M01 AND gclj!=M20"
' - paramName: "lcfw"
' - newValue: "M19"
' 返回值: 注入后的新字符串
' ------------------------------------------------------------------------------
Public Function InjectOr(ByVal expression As String, ByVal paramName As String, ByVal newValue As String) As String
Dim targetCondition As String
targetCondition = paramName & "=" & newValue
' [防御机制 1]:如果原表达式中已经存在我们要注入的完整条件,直接返回原字符串
If InStr(1, expression, targetCondition, vbTextCompare) > 0 Then
InjectOr = expression
Exit Function
End If
' [ 2](azxs)
If InStr(1, expression, paramName & "=", vbTextCompare) = 0 And _
InStr(1, expression, paramName & " =", vbTextCompare) = 0 Then
InjectOr = expression
Exit Function
End If
' ==========================================================================
' 场景 A参数存在于括号内部
' 示例:(lcfw=M12 OR lcfw=M13) AND gclj!=M20
' " OR lcfw=M19"
' ==========================================================================
' : =
regEx.Pattern = "\([^)]*\b" & paramName & "\b\s*=[^)]*\)"
If regEx.Test(expression) Then
Dim matchBlocks As Object
Dim matchBlock As Object
Set matchBlocks = regEx.Execute(expression)
Dim resultExpr As String
resultExpr = expression
' 遍历所有匹配的括号块并替换万一存在多个括号里都有lcfw
For Each matchBlock In matchBlocks
Dim oldBlockStr As String
oldBlockStr = matchBlock.value
Dim newBlockStr As String
'
newBlockStr = Left(oldBlockStr, Len(oldBlockStr) - 1) & " OR " & targetCondition & ")"
' 在主字符串中执行替换
resultExpr = Replace(resultExpr, oldBlockStr, newBlockStr)
Next matchBlock
InjectOr = resultExpr
Exit Function
End If
' ==========================================================================
' 场景 B参数在括号外部且表达式中存在 AND 逻辑
' 示例lcfw=M01 AND gclj!=M20
' 动作:必须加括号包裹它,变成 (lcfw=M01 OR lcfw=M19) AND gclj!=M20
' ==========================================================================
If InStr(1, expression, "AND", vbTextCompare) > 0 Then
' lcfw=M01
regEx.Pattern = "\b" & paramName & "\s*=\s*[A-Za-z0-9_]+"
If regEx.Test(expression) Then
Dim standaloneMatches As Object
Dim sMatch As Object
Set standaloneMatches = regEx.Execute(expression)
Dim resultStandalone As String
resultStandalone = expression
For Each sMatch In standaloneMatches
Dim oldStandaloneStr As String
oldStandaloneStr = sMatch.value
Dim newStandaloneStr As String
' OR
newStandaloneStr = "(" & oldStandaloneStr & " OR " & targetCondition & ")"
resultStandalone = Replace(resultStandalone, oldStandaloneStr, newStandaloneStr)
Next sMatch
InjectOr = resultStandalone
Exit Function
End If
End If
' ==========================================================================
' 场景 C没有任何括号也没有 AND 逻辑,纯 OR 链
' 示例lcfw=M01 OR lcfw=M02 OR lcfw=M03 (如盘止钉)
' 动作:直接在字符串最末尾追加即可
' ==========================================================================
expression = Trim(expression)
InjectOr = expression & " OR " & targetCondition
End Function