AutoBOM/VBA/ClassModules/ConditionEvaluator.cls

'=====================================================================
' 类名: ConditionEvaluator
' 功能: 解析和评估条件表达式
'=====================================================================

Option Explicit

'=====================================================================
' 方法: Evaluate
' 功能: 评估条件表达式
' 参数: expression - 条件表达式字符串
'       productConditions - 产品条件字典(Dictionary对象)
' 返回: Boolean - True表示条件满足,False表示不满足
' 说明: 支持AND、OR、!=运算符和括号嵌套
'       特殊规则:如果表达式中要求!=某值,而产品条件中不存在该变量,视为满足条件
'=====================================================================
Public Function Evaluate(expression As String, productConditions As Object) As Boolean
    On Error GoTo ErrorHandler

    ' 空条件视为满足
    If Trim(expression) = "" Then
        Evaluate = True
        Exit Function
    End If

    ' 递归解析表达式
    Evaluate = EvaluateExpression(Trim(expression), productConditions)
    Exit Function

ErrorHandler:
    ' 解析错误时返回False
    Evaluate = False
End Function

'=====================================================================
' 方法: EvaluateExpression
' 功能: 递归评估表达式
' 参数: expr - 表达式
'       conditions - 条件字典
' 返回: Boolean
'=====================================================================
Private Function EvaluateExpression(expr As String, Conditions As Object) As Boolean
    expr = Trim(expr)

    ' 处理最外层括号
    If Left(expr, 1) = "(" And Right(expr, 1) = ")" Then
        If IsMatchedParentheses(expr) Then
            expr = Mid(expr, 2, Len(expr) - 2)
            expr = Trim(expr)
        End If
    End If

    ' 处理OR运算符(优先级最低)
    Dim orResult As Variant
    orResult = SplitByOperator(expr, " OR ", Conditions)
    If Not IsEmpty(orResult) Then
        EvaluateExpression = orResult
        Exit Function
    End If

    ' 处理AND运算符
    Dim andResult As Variant
    andResult = SplitByOperator(expr, " AND ", Conditions)
    If Not IsEmpty(andResult) Then
        EvaluateExpression = andResult
        Exit Function
    End If

    ' 处理单个条件
    EvaluateExpression = EvaluateSingleCondition(expr, Conditions)
End Function

'=====================================================================
' 方法: SplitByOperator
' 功能: 按指定运算符分割并评估表达式
' 参数: expr - 表达式
'       operator - 运算符(" OR " 或 " AND ")
'       conditions - 条件字典
' 返回: Variant - 评估结果或Empty
'=====================================================================
Private Function SplitByOperator(expr As String, operator As String, Conditions As Object) As Variant
    Dim pos As Long
    Dim leftPart As String
    Dim rightPart As String
    Dim depth As Long
    Dim i As Long
    Dim char As String

    ' 寻找不在括号内的运算符
    depth = 0
    For i = 1 To Len(expr) - Len(operator) + 1
        char = Mid(expr, i, 1)

        If char = "(" Then
            depth = depth + 1
        ElseIf char = ")" Then
            depth = depth - 1
        ElseIf depth = 0 Then
            ' 检查是否匹配运算符
            If Mid(expr, i, Len(operator)) = operator Then
                leftPart = Trim(Left(expr, i - 1))
                rightPart = Trim(Mid(expr, i + Len(operator)))

                ' 根据运算符类型评估
                If operator = " OR " Then
                    SplitByOperator = EvaluateExpression(leftPart, Conditions) Or _
                                     EvaluateExpression(rightPart, Conditions)
                ElseIf operator = " AND " Then
                    SplitByOperator = EvaluateExpression(leftPart, Conditions) And _
                                      EvaluateExpression(rightPart, Conditions)
                End If
                Exit Function
            End If
        End If
    Next i

    ' 未找到运算符
    SplitByOperator = Empty
End Function

'=====================================================================
' 方法: EvaluateSingleCondition
' 功能: 评估单个条件(如 azxs=A0 或 azxs!=AH)
' 参数: condition - 单个条件字符串
'       conditions - 条件字典
' 返回: Boolean
'=====================================================================
Private Function EvaluateSingleCondition(condition As String, Conditions As Object) As Boolean
    Dim varName As String
    Dim operator As String
    Dim value As String
    Dim actualValue As String

    condition = Trim(condition)

    ' 检查!=运算符
    If InStr(condition, "!=") > 0 Then
        Dim parts() As String
        parts = Split(condition, "!=")
        If UBound(parts) >= 1 Then
            varName = Trim(parts(0))
            value = Trim(parts(1))

            ' 特殊规则:如果产品条件中不存在该变量,视为满足!=条件
            If Not Conditions.Exists(varName) Then
                EvaluateSingleCondition = True
            Else
                actualValue = Conditions(varName)
                EvaluateSingleCondition = (actualValue <> value)
            End If
            Exit Function
        End If
    End If

    ' 检查=运算符
    If InStr(condition, "=") > 0 Then
        Dim eqParts() As String
        eqParts = Split(condition, "=")
        If UBound(eqParts) >= 1 Then
            varName = Trim(eqParts(0))
            value = Trim(eqParts(1))

            If Not Conditions.Exists(varName) Then
                EvaluateSingleCondition = False
            Else
                actualValue = Conditions(varName)
                EvaluateSingleCondition = (actualValue = value)
            End If
            Exit Function
        End If
    End If

    ' 无法解析的条件返回False
    EvaluateSingleCondition = False
End Function

'=====================================================================
' 方法: IsMatchedParentheses
' 功能: 检查字符串最外层括号是否匹配
' 参数: str - 字符串
' 返回: Boolean
'=====================================================================
Private Function IsMatchedParentheses(str As String) As Boolean
    If Left(str, 1) <> "(" Or Right(str, 1) <> ")" Then
        IsMatchedParentheses = False
        Exit Function
    End If

    Dim depth As Long
    Dim i As Long

    depth = 0
    For i = 1 To Len(str)
        If Mid(str, i, 1) = "(" Then
            depth = depth + 1
        ElseIf Mid(str, i, 1) = ")" Then
            depth = depth - 1
        End If

        ' 如果在中间某处深度归零,说明最外层括号不匹配
        If depth = 0 And i < Len(str) Then
            IsMatchedParentheses = False
            Exit Function
        End If
    Next i

    IsMatchedParentheses = (depth = 0)
End Function