AutoBOM/VBA/Modules/M05_PreProcessor.bas

' ==============================================================================
' 模块: M05_PreProcessor
' 职责: 预处理条件表达式，用于"接头"类别的值映射和去重
' ==============================================================================
Option Explicit

' 模块级变量
Private g_LcfwMapping As Object      ' Scripting.Dictionary - lcfw映射表
Private g_AzxsMapping As Object      ' Scripting.Dictionary - azxs映射表
Private g_Logger As clsErrorLogger
Private g_IsInitialized As Boolean

' ------------------------------------------------------------------------------
' 初始化预处理器
' ------------------------------------------------------------------------------
Public Sub InitPreProcessor(logger As clsErrorLogger, wsMapping As Worksheet)
    Set g_Logger = logger
    Set g_LcfwMapping = CreateObject("Scripting.Dictionary")
    Set g_AzxsMapping = CreateObject("Scripting.Dictionary")

    ' 从[对照表]加载映射
    Call LoadLcfwMapping(wsMapping)
    Call LoadAzxsMapping(wsMapping)

    g_IsInitialized = True
End Sub

' ------------------------------------------------------------------------------
' 检查是否已初始化
' ------------------------------------------------------------------------------
Public Function IsInitialized() As Boolean
    IsInitialized = g_IsInitialized
End Function

' ------------------------------------------------------------------------------
' 主入口：预处理条件表达式
' ------------------------------------------------------------------------------
Public Function PreprocessCondition( _
    ByVal strCondition As String, _
    ByVal strCategory As String, _
    ByVal rowIdx As Long _
) As String
    ' 仅对"接头"类别进行预处理
    If strCategory <> "接头" Then
        PreprocessCondition = strCondition
        Exit Function
    End If

    If Not g_IsInitialized Then
        PreprocessCondition = strCondition
        Exit Function
    End If

    PreprocessCondition = ApplyPreprocessing(strCondition, rowIdx)
End Function

' ------------------------------------------------------------------------------
' 加载lcfw映射（从A列:B列，列1:2）
' ------------------------------------------------------------------------------
Private Sub LoadLcfwMapping(wsMapping As Worksheet)
    Dim lastRow As Long
    lastRow = wsMapping.Cells(wsMapping.Rows.count, 1).End(xlUp).Row

    Dim i As Long
    Dim key As String, val As String

    ' 从第3行开始读取
    For i = 3 To lastRow
        key = Trim(CStr(wsMapping.Cells(i, 1).Value))
        val = Trim(CStr(wsMapping.Cells(i, 2).Value))

        If Len(key) > 0 And Len(val) > 0 Then
            If Not g_LcfwMapping.Exists(key) Then
                g_LcfwMapping.Add key, val
            End If
        End If
    Next i
End Sub

' ------------------------------------------------------------------------------
' 加载azxs映射（从D列:E列，列4:5）
' ------------------------------------------------------------------------------
Private Sub LoadAzxsMapping(wsMapping As Worksheet)
    Dim lastRow As Long
    lastRow = wsMapping.Cells(wsMapping.Rows.count, 4).End(xlUp).Row

    Dim i As Long
    Dim key As String, val As String

    ' 从第3行开始读取
    For i = 3 To lastRow
        key = Trim(CStr(wsMapping.Cells(i, 4).Value))
        val = Trim(CStr(wsMapping.Cells(i, 5).Value))

        If Len(key) > 0 And Len(val) > 0 Then
            If Not g_AzxsMapping.Exists(key) Then
                g_AzxsMapping.Add key, val
            End If
        End If
    Next i
End Sub

' ------------------------------------------------------------------------------
' 应用预处理：值替换和OR去重（递归处理嵌套表达式）
' ------------------------------------------------------------------------------
Private Function ApplyPreprocessing( _
    ByVal strCondition As String, _
    ByVal rowIdx As Long _
) As String
    ' 首先递归处理括号内的表达式并简化
    strCondition = ProcessAndSimplifyNested(strCondition, rowIdx)

    ' 然后按顶层OR分割
    Dim orSegments As Collection
    Set orSegments = SplitTopLevel(strCondition, " OR ")

    If orSegments.count = 1 Then
        ' 没有顶层OR，直接处理AND分段
        ApplyPreprocessing = ProcessAndSegment(CStr(orSegments(1)), rowIdx)
        Exit Function
    End If

    ' 处理每个OR分段
    Dim processedSegments As Collection
    Set processedSegments = New Collection

    Dim segment As Variant
    For Each segment In orSegments
        Dim processedSegment As String
        processedSegment = ProcessAndSegment(CStr(segment), rowIdx)
        processedSegments.Add processedSegment
    Next segment

    ' 合并去重后的OR条件
    ApplyPreprocessing = MergeDuplicateORs(processedSegments)
End Function

' ------------------------------------------------------------------------------
' 递归处理并简化嵌套表达式
' ------------------------------------------------------------------------------
Private Function ProcessAndSimplifyNested( _
    ByVal strCondition As String, _
    ByVal rowIdx As Long _
) As String
    Dim result As String
    result = ""
    Dim i As Long
    Dim bracketLevel As Long
    bracketLevel = 0
    Dim inBracket As Boolean
    inBracket = False
    Dim bracketContent As String
    bracketContent = ""

    For i = 1 To Len(strCondition)
        Dim char As String
        char = Mid(strCondition, i, 1)

        If char = "(" Then
            bracketLevel = bracketLevel + 1
            If bracketLevel = 1 Then
                inBracket = True
                bracketContent = ""
            Else
                bracketContent = bracketContent & char
            End If
        ElseIf char = ")" Then
            If bracketLevel = 1 Then
                ' 递归处理括号内的内容
                Dim processedContent As String
                processedContent = ProcessAndSimplifyNested(bracketContent, rowIdx)

                ' 简化处理后的内容（应用值替换和OR合并）
                processedContent = ApplyPreprocessing(processedContent, rowIdx)

                ' 检查所有OR分段是否相同，如果是则去重
                processedContent = SimplifyIfAllSame(processedContent)

                ' 重新组装：决定是否需要保留括号
                ' 如果处理后的内容包含顶层 OR 或 AND，需要加括号以保持正确的逻辑结构
                Dim needsParens As Boolean
                needsParens = HasTopLevelOperator(processedContent, " OR ") Or _
                             HasTopLevelOperator(processedContent, " AND ")

                If needsParens Then
                    result = result & "(" & processedContent & ")"
                Else
                    result = result & processedContent
                End If

                inBracket = False
            Else
                bracketContent = bracketContent & char
            End If
            bracketLevel = bracketLevel - 1
        ElseIf inBracket Then
            bracketContent = bracketContent & char
        Else
            result = result & char
        End If
    Next i

    ProcessAndSimplifyNested = result
End Function

' ------------------------------------------------------------------------------
' 如果所有OR分段都相同，则简化为单个分段
' ------------------------------------------------------------------------------
Private Function SimplifyIfAllSame( _
    ByVal strExpr As String _
) As String
    ' 检查是否包含OR
    If Not HasTopLevelOperator(strExpr, " OR ") Then
        SimplifyIfAllSame = strExpr
        Exit Function
    End If

    ' 分割OR分段
    Dim segments As Collection
    Set segments = SplitTopLevel(strExpr, " OR ")

    If segments.count <= 1 Then
        SimplifyIfAllSame = strExpr
        Exit Function
    End If

    ' 检查所有分段是否相同
    Dim allSame As Boolean
    allSame = True
    Dim firstSegment As String
    firstSegment = NormalizeWhitespace(CStr(segments(1)))

    Dim i As Long
    For i = 2 To segments.count
        Dim segment As String
        segment = NormalizeWhitespace(CStr(segments(i)))
        If segment <> firstSegment Then
            allSame = False
            Exit For
        End If
    Next i

    ' 如果所有分段都相同，返回第一个分段
    If allSame Then
        SimplifyIfAllSame = segments(1)
    Else
        SimplifyIfAllSame = strExpr
    End If
End Function

' ------------------------------------------------------------------------------
' 尝试去除外层括号（如果可能）
' ------------------------------------------------------------------------------
Private Function MaybeRemoveOuterParentheses( _
    ByVal strExpr As String _
) As String
    strExpr = Trim(strExpr)

    ' 如果没有外层括号，直接返回
    If Left(strExpr, 1) <> "(" Or Right(strExpr, 1) <> ")" Then
        MaybeRemoveOuterParentheses = strExpr
        Exit Function
    End If

    ' 去掉外层括号，检查内容
    Dim innerContent As String
    innerContent = Mid(strExpr, 2, Len(strExpr) - 2)
    innerContent = Trim(innerContent)

    ' 检查内容是否包含顶层OR或AND
    Dim hasTopLevelOR As Boolean
    Dim hasTopLevelAND As Boolean
    hasTopLevelOR = HasTopLevelOperator(innerContent, " OR ")
    hasTopLevelAND = HasTopLevelOperator(innerContent, " AND ")

    ' 如果没有顶层操作符，可以去掉括号
    If Not hasTopLevelOR And Not hasTopLevelAND Then
        MaybeRemoveOuterParentheses = innerContent
        Exit Function
    End If

    ' 如果仍有顶层操作符，需要保留括号以保持正确的逻辑结构
    MaybeRemoveOuterParentheses = strExpr
End Function

' ------------------------------------------------------------------------------
' 检查字符串是否包含顶层操作符
' ------------------------------------------------------------------------------
Private Function HasTopLevelOperator( _
    ByVal strExpr As String, _
    ByVal operator As String _
) As Boolean
    Dim bracketLevel As Long
    bracketLevel = 0
    Dim i As Long
    Dim lenOp As Long
    lenOp = Len(operator)

    For i = 1 To Len(strExpr) - lenOp + 1
        Dim char As String
        char = Mid(strExpr, i, 1)

        If char = "(" Then
            bracketLevel = bracketLevel + 1
        ElseIf char = ")" Then
            bracketLevel = bracketLevel - 1
        ElseIf bracketLevel = 0 Then
            If Mid(strExpr, i, lenOp) = operator Then
                HasTopLevelOperator = True
                Exit Function
            End If
        End If
    Next i

    HasTopLevelOperator = False
End Function

' ------------------------------------------------------------------------------
' 处理AND分段：进行值替换并合并重复原子
' ------------------------------------------------------------------------------
Private Function ProcessAndSegment( _
    ByVal strSegment As String, _
    ByVal rowIdx As Long _
) As String
    Dim andAtoms As Collection
    Set andAtoms = SplitTopLevel(strSegment, " AND ")

    Dim processedAtoms As Collection
    Set processedAtoms = New Collection

    Dim atom As Variant
    For Each atom In andAtoms
        Dim processedAtom As String
        processedAtom = ProcessAtom(CStr(atom), rowIdx)
        processedAtoms.Add processedAtom
    Next atom

    ' 合并重复的原子
    Dim mergedAtoms As Collection
    Set mergedAtoms = MergeDuplicateAtoms(processedAtoms)

    ' 重新组合AND分段
    ProcessAndSegment = JoinCollection(mergedAtoms, " AND ")
End Function

' ------------------------------------------------------------------------------
' 处理单个原子：应用值映射
' ------------------------------------------------------------------------------
Private Function ProcessAtom( _
    ByVal strAtom As String, _
    ByVal rowIdx As Long _
) As String
    Dim atomDict As Object
    Set atomDict = ParseAtom(strAtom)

    If atomDict Is Nothing Then
        ProcessAtom = strAtom
        Exit Function
    End If

    Dim key As String
    Dim value As String
    Dim operator As String

    key = atomDict("key")
    value = atomDict("value")
    operator = atomDict("operator")

    ' 应用映射
    Dim mappedValue As String
    mappedValue = ""

    If key = "lcfw" Then
        If g_LcfwMapping.Exists(value) Then
            mappedValue = g_LcfwMapping(value)
        End If
    ElseIf key = "azxs" Then
        If g_AzxsMapping.Exists(value) Then
            mappedValue = g_AzxsMapping(value)
        End If
    End If

    ' 如果找到了映射值，使用它；否则保持原值
    If Len(mappedValue) > 0 Then
        value = mappedValue
    Else
        ' 记录警告（仅针对lcfw和azxs）
        If (key = "lcfw" Or key = "azxs") And Len(value) > 0 Then
            g_Logger.Record rowIdx, "M05.PreProcessor", "Mapping Warning", _
                "Value not found in mapping table: " & key & "=" & value, strAtom
        End If
    End If

    ' 重建原子字符串
    ProcessAtom = key & operator & value
End Function

' ------------------------------------------------------------------------------
' 解析原子字符串为Dictionary
' ------------------------------------------------------------------------------
Private Function ParseAtom(ByVal strAtom As String) As Object
    Set ParseAtom = Nothing

    strAtom = Trim(strAtom)
    If Len(strAtom) = 0 Then Exit Function

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim p As Long
    Dim key As String, value As String, op As String

    If InStr(strAtom, "!=") > 0 Then
        p = InStr(strAtom, "!=")
        key = Trim(Left(strAtom, p - 1))
        value = Trim(Mid(strAtom, p + 2))
        op = "!="
    ElseIf InStr(strAtom, "=") > 0 Then
        p = InStr(strAtom, "=")
        key = Trim(Left(strAtom, p - 1))
        value = Trim(Mid(strAtom, p + 1))
        op = "="
    Else
        Exit Function
    End If

    dict.Add "key", key
    dict.Add "value", value
    dict.Add "operator", op

    Set ParseAtom = dict
End Function

' ------------------------------------------------------------------------------
' 顶层分割（尊重括号嵌套）
' ------------------------------------------------------------------------------
Private Function SplitTopLevel( _
    ByVal strExpr As String, _
    ByVal delimiter As String _
) As Collection
    Dim result As New Collection
    Dim currentSegment As String
    currentSegment = ""

    Dim i As Long
    Dim bracketLevel As Long
    bracketLevel = 0

    Dim lenDelim As Long
    lenDelim = Len(delimiter)

    i = 1
    Do While i <= Len(strExpr)
        Dim char As String
        char = Mid(strExpr, i, 1)

        If char = "(" Then
            bracketLevel = bracketLevel + 1
            currentSegment = currentSegment & char
        ElseIf char = ")" Then
            bracketLevel = bracketLevel - 1
            currentSegment = currentSegment & char
        ElseIf bracketLevel = 0 Then
            ' 检查是否匹配分隔符
            If i + lenDelim - 1 <= Len(strExpr) Then
                Dim checkStr As String
                checkStr = Mid(strExpr, i, lenDelim)

                If UCase(checkStr) = delimiter Then
                    ' 找到分隔符，保存当前分段
                    result.Add Trim(currentSegment)
                    currentSegment = ""
                    i = i + lenDelim - 1 ' 跳过分隔符
                Else
                    currentSegment = currentSegment & char
                End If
            Else
                currentSegment = currentSegment & char
            End If
        Else
            currentSegment = currentSegment & char
        End If

        i = i + 1
    Loop

    ' 添加最后一个分段
    If Len(Trim(currentSegment)) > 0 Then
        result.Add Trim(currentSegment)
    End If

    Set SplitTopLevel = result
End Function

' ------------------------------------------------------------------------------
' 合并重复的OR条件
' ------------------------------------------------------------------------------
Private Function MergeDuplicateORs(ByVal segments As Collection) As String
    If segments.count = 0 Then
        MergeDuplicateORs = ""
        Exit Function
    End If

    If segments.count = 1 Then
        MergeDuplicateORs = segments(1)
        Exit Function
    End If

    ' 使用Dictionary去重
    Dim uniqueSegments As Object
    Set uniqueSegments = CreateObject("Scripting.Dictionary")

    Dim segment As Variant
    For Each segment In segments
        Dim segStr As String
        segStr = CStr(segment)

        ' 标准化字符串用于比较（去除多余空格）
        Dim normalized As String
        normalized = NormalizeWhitespace(segStr)

        If Not uniqueSegments.Exists(normalized) Then
            uniqueSegments.Add normalized, segStr
        End If
    Next segment

    ' 重新组合
    Dim result As String
    result = ""

    Dim key As Variant
    Dim isFirst As Boolean
    isFirst = True

    For Each key In uniqueSegments.keys
        If isFirst Then
            result = uniqueSegments(key)
            isFirst = False
        Else
            result = result & " OR " & uniqueSegments(key)
        End If
    Next key

    MergeDuplicateORs = result
End Function

' ------------------------------------------------------------------------------
' 标准化空白字符
' ------------------------------------------------------------------------------
Private Function NormalizeWhitespace(ByVal str As String) As String
    ' 去除多余空格
    Dim result As String
    result = Trim(str)

    ' 将连续多个空格替换为单个空格
    Do While InStr(result, "  ") > 0
        result = Replace(result, "  ", " ")
    Loop

    ' 标准化 " AND " 和 " OR "
    result = Replace(result, " AND ", " AND ")
    result = Replace(result, " OR ", " OR ")

    NormalizeWhitespace = result
End Function

' ------------------------------------------------------------------------------
' 连接集合为字符串
' ------------------------------------------------------------------------------
Private Function JoinCollection( _
    ByVal col As Collection, _
    ByVal delimiter As String _
) As String
    Dim result As String
    result = ""

    Dim item As Variant
    Dim isFirst As Boolean
    isFirst = True

    For Each item In col
        If isFirst Then
            result = CStr(item)
            isFirst = False
        Else
            result = result & delimiter & CStr(item)
        End If
    Next item

    JoinCollection = result
End Function

' ------------------------------------------------------------------------------
' 合并重复的原子（在AND分段中）
' ------------------------------------------------------------------------------
Private Function MergeDuplicateAtoms( _
    ByVal atoms As Collection _
) As Collection
    Dim result As New Collection
    Dim uniqueAtoms As Object
    Set uniqueAtoms = CreateObject("Scripting.Dictionary")

    Dim atom As Variant
    For Each atom In atoms
        Dim atomStr As String
        atomStr = Trim(CStr(atom))

        ' 标准化用于比较
        Dim normalized As String
        normalized = NormalizeWhitespace(atomStr)

        If Not uniqueAtoms.Exists(normalized) Then
            uniqueAtoms.Add normalized, atomStr
        End If
    Next atom

    ' 返回去重后的原子
    Dim key As Variant
    For Each key In uniqueAtoms.keys
        result.Add uniqueAtoms(key)
    Next key

    Set MergeDuplicateAtoms = result
End Function

' ------------------------------------------------------------------------------
' 测试辅助函数：获取lcfw映射值
' ------------------------------------------------------------------------------
Public Function GetLcfwMappedValue(key As String) As String
    If g_LcfwMapping.Exists(key) Then
        GetLcfwMappedValue = g_LcfwMapping(key)
    Else
        GetLcfwMappedValue = ""
    End If
End Function

' ------------------------------------------------------------------------------
' 测试辅助函数：获取azxs映射值
' ------------------------------------------------------------------------------
Public Function GetAzxsMappedValue(key As String) As String
    If g_AzxsMapping.Exists(key) Then
        GetAzxsMappedValue = g_AzxsMapping(key)
    Else
        GetAzxsMappedValue = ""
    End If
End Function