7cb025c243
All checks were successful
NTFY Notification / notify (push) Successful in 4s
Convert Long rowIdx parameters to String using CStr() for clsErrorLogger.Record/RecordWarning methods. Changes: - M03_Logic.bas: Add CStr() to 5 logger calls (lines 37, 112, 200, 208, 215) - M03_Logic.bas: Change ParseAtom syntax error from Record to RecordWarning (non-blocking) - M05_PreProcessor.bas: Add CStr() to mapping warning (line 318) This resolves VBA compilation errors caused by passing Long type to ByRef String parameters. Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
289 lines
10 KiB
QBasic
289 lines
10 KiB
QBasic
' ==============================================================================
|
|
' 模块: M03_Logic
|
|
' 职责: 核心算法。使用后期绑定(Late Binding)避免引用错误。
|
|
' ==============================================================================
|
|
Option Explicit
|
|
|
|
Private g_Logger As clsErrorLogger
|
|
|
|
' 初始化日志引用
|
|
Public Sub InitLogic(logger As clsErrorLogger)
|
|
Set g_Logger = logger
|
|
End Sub
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 主入口: 解析规则字符串
|
|
' 返回: Collection (包含多个 Dictionary 对象)
|
|
' ------------------------------------------------------------------------------
|
|
Public Function ParseRule(strRule As String, rowIdx As Long) As Collection
|
|
On Error GoTo ErrorHandler
|
|
|
|
Dim cleanStr As String
|
|
cleanStr = CleanString(strRule)
|
|
|
|
' 空条件处理
|
|
If Len(cleanStr) = 0 Then
|
|
Dim col As New Collection
|
|
' 创建一个空字典
|
|
col.Add CreateObject("Scripting.Dictionary")
|
|
Set ParseRule = col
|
|
Exit Function
|
|
End If
|
|
|
|
Set ParseRule = RecursiveParse(cleanStr, rowIdx)
|
|
Exit Function
|
|
|
|
ErrorHandler:
|
|
g_Logger.Record CStr(rowIdx), "M03.ParseRule", "System Error", err.Description, strRule
|
|
Set ParseRule = Nothing
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 递归解析核心
|
|
' ------------------------------------------------------------------------------
|
|
Private Function RecursiveParse(strExpr As String, rowIdx As Long) As Collection
|
|
Dim splitIdx As Long
|
|
|
|
' 1. 查找顶层 OR (最低优先级，先拆分)
|
|
splitIdx = FindSplitIndex(strExpr, "OR")
|
|
If splitIdx > 0 Then
|
|
Dim leftRes As Collection, rightRes As Collection
|
|
' 递归左边
|
|
Set leftRes = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
|
|
' 递归右边 (+2 是 OR 的长度)
|
|
Set rightRes = RecursiveParse(Trim(Mid(strExpr, splitIdx + 2)), rowIdx)
|
|
' 合并结果 (Union)
|
|
Set RecursiveParse = UnionCollections(leftRes, rightRes)
|
|
Exit Function
|
|
End If
|
|
|
|
' 2. 查找顶层 AND
|
|
splitIdx = FindSplitIndex(strExpr, "AND")
|
|
If splitIdx > 0 Then
|
|
Dim leftCol As Collection, rightCol As Collection
|
|
' 递归左边
|
|
Set leftCol = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
|
|
' 递归右边 (+3 是 AND 的长度)
|
|
Set rightCol = RecursiveParse(Trim(Mid(strExpr, splitIdx + 3)), rowIdx)
|
|
' 笛卡尔积 (Intersection/Merge)
|
|
Set RecursiveParse = CartesianProduct(leftCol, rightCol, rowIdx)
|
|
Exit Function
|
|
End If
|
|
|
|
' 3. 去除外层括号
|
|
If Left(strExpr, 1) = "(" And Right(strExpr, 1) = ")" Then
|
|
' 防止像 (A) AND (B) 这种情况被误去括号，但这里已经被 FindSplitIndex 过滤了顶层操作符，
|
|
' 所以如果这里首尾是括号，且中间没有暴露的操作符，说明是包裹的整体，例如 ((A AND B))
|
|
Set RecursiveParse = RecursiveParse(Mid(strExpr, 2, Len(strExpr) - 2), rowIdx)
|
|
Exit Function
|
|
End If
|
|
|
|
' 4. 原子解析 (Base Case)
|
|
Set RecursiveParse = ParseAtom(strExpr, rowIdx)
|
|
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 原子解析: key=val 或 key!=val
|
|
' ------------------------------------------------------------------------------
|
|
Private Function ParseAtom(strAtom As String, rowIdx As Long) As Collection
|
|
Dim dict As Object ' Late Binding
|
|
Set dict = CreateObject("Scripting.Dictionary")
|
|
|
|
Dim p As Long
|
|
Dim key As String, val As String
|
|
|
|
' 移除多余空格，但保留值中间可能存在的(虽然通常没有)
|
|
strAtom = Trim(strAtom)
|
|
|
|
If InStr(strAtom, "!=") > 0 Then
|
|
p = InStr(strAtom, "!=")
|
|
key = Trim(Left(strAtom, p - 1))
|
|
val = Trim(Mid(strAtom, p + 2))
|
|
dict.Add key, "!=" & val
|
|
ElseIf InStr(strAtom, "=") > 0 Then
|
|
p = InStr(strAtom, "=")
|
|
key = Trim(Left(strAtom, p - 1))
|
|
val = Trim(Mid(strAtom, p + 1))
|
|
dict.Add key, val
|
|
Else
|
|
' 无法解析的格式
|
|
If Len(strAtom) > 0 Then
|
|
g_Logger.RecordWarning CStr(rowIdx), "M03.ParseAtom", "Syntax Error", "No = or != found", strAtom
|
|
End If
|
|
End If
|
|
|
|
Dim col As New Collection
|
|
col.Add dict
|
|
Set ParseAtom = col
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 笛卡尔积: AND 逻辑
|
|
' ------------------------------------------------------------------------------
|
|
Private Function CartesianProduct(col1 As Collection, col2 As Collection, rowIdx As Long) As Collection
|
|
Dim res As New Collection
|
|
Dim d1 As Object, d2 As Object
|
|
Dim merged As Object
|
|
Dim i As Long, j As Long
|
|
|
|
If col1 Is Nothing Or col2 Is Nothing Then
|
|
Set CartesianProduct = Nothing
|
|
Exit Function
|
|
End If
|
|
|
|
For i = 1 To col1.count
|
|
For j = 1 To col2.count
|
|
Set d1 = col1(i)
|
|
Set d2 = col2(j)
|
|
Set merged = MergeDictionaries(d1, d2, rowIdx)
|
|
If Not merged Is Nothing Then
|
|
res.Add merged
|
|
End If
|
|
Next j
|
|
Next i
|
|
|
|
Set CartesianProduct = res
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 集合合并: OR 逻辑
|
|
' ------------------------------------------------------------------------------
|
|
Private Function UnionCollections(col1 As Collection, col2 As Collection) As Collection
|
|
Dim res As New Collection
|
|
Dim item As Variant
|
|
|
|
If Not col1 Is Nothing Then
|
|
For Each item In col1
|
|
res.Add item
|
|
Next item
|
|
End If
|
|
|
|
If Not col2 Is Nothing Then
|
|
For Each item In col2
|
|
res.Add item
|
|
Next item
|
|
End If
|
|
|
|
Set UnionCollections = res
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 字典合并 (处理冲突和 !=)
|
|
' ------------------------------------------------------------------------------
|
|
Private Function MergeDictionaries(d1 As Object, d2 As Object, rowIdx As Long) As Object
|
|
Dim res As Object
|
|
Set res = CreateObject("Scripting.Dictionary")
|
|
|
|
Dim k As Variant
|
|
Dim v1 As String, v2 As String
|
|
|
|
' 复制 d1
|
|
For Each k In d1.keys
|
|
res.Add k, d1(k)
|
|
Next k
|
|
|
|
' 合并 d2
|
|
For Each k In d2.keys
|
|
If res.Exists(k) Then
|
|
v1 = CStr(res(k))
|
|
v2 = CStr(d2(k))
|
|
|
|
If v1 = v2 Then
|
|
' 相同，无视
|
|
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) = "!=" Then
|
|
' 都是不等于，合并
|
|
res(k) = v1 & "," & v2
|
|
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) <> "!=" Then
|
|
' v1!=, v2=
|
|
If v2 = Mid(v1, 3) Then
|
|
g_Logger.Record CStr(rowIdx), "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
|
|
Set MergeDictionaries = Nothing: Exit Function
|
|
Else
|
|
res(k) = v2
|
|
End If
|
|
ElseIf Left(v1, 2) <> "!=" And Left(v2, 2) = "!=" Then
|
|
' v1=, v2!=
|
|
If v1 = Mid(v2, 3) Then
|
|
g_Logger.Record CStr(rowIdx), "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
|
|
Set MergeDictionaries = Nothing: Exit Function
|
|
Else
|
|
res(k) = v1
|
|
End If
|
|
Else
|
|
' 都是等于，但值不同
|
|
g_Logger.Record CStr(rowIdx), "M03.Conflict", "Logic Conflict", "Mutually Exclusive", k & "=" & v1 & " AND " & v2
|
|
Set MergeDictionaries = Nothing: Exit Function
|
|
End If
|
|
Else
|
|
res.Add k, d2(k)
|
|
End If
|
|
Next k
|
|
|
|
Set MergeDictionaries = res
|
|
End Function
|
|
|
|
' ------------------------------------------------------------------------------
|
|
' 查找逻辑分割点 (忽略括号内容)
|
|
' ------------------------------------------------------------------------------
|
|
Private Function FindSplitIndex(strExpr As String, delimiter As String) As Long
|
|
Dim i As Long
|
|
Dim bracketLevel As Long
|
|
Dim subStr As String
|
|
Dim lenDelim As Long
|
|
Dim checkStr As String
|
|
|
|
bracketLevel = 0
|
|
lenDelim = Len(delimiter)
|
|
|
|
' 预处理：为了防止匹配到变量名里的字符，我们检查 " AND " (带空格)
|
|
' 或者简单起见，我们假设变量名不包含 AND/OR 且大小写敏感
|
|
' 这里采用严格括号计数
|
|
|
|
For i = 1 To Len(strExpr) - lenDelim + 1
|
|
subStr = Mid(strExpr, i, 1)
|
|
|
|
If subStr = "(" Then
|
|
bracketLevel = bracketLevel + 1
|
|
ElseIf subStr = ")" Then
|
|
bracketLevel = bracketLevel - 1
|
|
ElseIf bracketLevel = 0 Then
|
|
' 只有在第0层括号时才匹配逻辑符
|
|
checkStr = Mid(strExpr, i, lenDelim)
|
|
|
|
' 关键修正：确保匹配的是独立单词，而不是变量名的一部分
|
|
' 简单判断：前后字符是空格，或者处于字符串边界
|
|
If UCase(checkStr) = delimiter Then
|
|
Dim isWord As Boolean
|
|
isWord = True
|
|
|
|
' 检查前一个字符
|
|
If i > 1 Then
|
|
If Mid(strExpr, i - 1, 1) <> " " And Mid(strExpr, i - 1, 1) <> ")" Then isWord = False
|
|
End If
|
|
|
|
' 检查后一个字符
|
|
If i + lenDelim <= Len(strExpr) Then
|
|
If Mid(strExpr, i + lenDelim, 1) <> " " And Mid(strExpr, i + lenDelim, 1) <> "(" Then isWord = False
|
|
End If
|
|
|
|
If isWord Then
|
|
FindSplitIndex = i
|
|
Exit Function
|
|
End If
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
FindSplitIndex = 0
|
|
End Function
|
|
|
|
Private Function CleanString(s As String) As String
|
|
' 移除多余的空格，将换行符替换为空格
|
|
Dim temp As String
|
|
temp = Replace(s, vbCrLf, " ")
|
|
temp = Replace(temp, vbCr, " ")
|
|
temp = Replace(temp, vbLf, " ")
|
|
temp = Trim(temp)
|
|
CleanString = temp
|
|
End Function |