Refactor parameter and property names from PascalCase to camelCase for consistent naming conventions across VBA modules. Changes: - Conditions → conditions (property and parameters) - Update all references across 7 modules - Maintain functional behavior while improving code readability Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
224 lines
7.4 KiB
OpenEdge ABL
224 lines
7.4 KiB
OpenEdge ABL
'=====================================================================
|
||
' 类名: 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)
|
||
|
||
' fjgn字段特殊处理(多值匹配)
|
||
If varName = "fjgn" Then
|
||
' fjgn!=N1:检查actualValue中是否不包含value
|
||
EvaluateSingleCondition = (InStr(actualValue, value) = 0)
|
||
Else
|
||
' 其他字段使用精确匹配
|
||
EvaluateSingleCondition = (actualValue <> value)
|
||
End If
|
||
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)
|
||
|
||
' fjgn字段特殊处理(多值匹配)
|
||
If varName = "fjgn" Then
|
||
' fjgn=N1:检查actualValue中是否包含value
|
||
EvaluateSingleCondition = (InStr(actualValue, value) > 0)
|
||
Else
|
||
' 其他字段使用精确匹配
|
||
EvaluateSingleCondition = (actualValue = value)
|
||
End If
|
||
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 |