From f344cbe20610913615f3fcd947013bc1f90deb3b Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Thu, 19 Mar 2026 12:28:29 +0800 Subject: [PATCH] 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 --- VBA/ClassModules/cBOMRow.cls | 121 ++++++++++++++++++++++++ VBA/ClassModules/cConditionEngine.cls | 123 ++++++++++++++++++++++++ VBA/Modules/mTestEngine.bas | 130 ++++++++++++++++++++++++++ 3 files changed, 374 insertions(+) create mode 100644 VBA/ClassModules/cBOMRow.cls create mode 100644 VBA/ClassModules/cConditionEngine.cls create mode 100644 VBA/Modules/mTestEngine.bas diff --git a/VBA/ClassModules/cBOMRow.cls b/VBA/ClassModules/cBOMRow.cls new file mode 100644 index 0000000..adf091d --- /dev/null +++ b/VBA/ClassModules/cBOMRow.cls @@ -0,0 +1,121 @@ +' ============================================================================== +' 模块名称: cBOMRow +' 模块类别: 类模块 (Class Module) +' 所属项目: BOMForge +' 模块职责: 封装单行 BOM 数据，提供属性访问，并内置状态跟踪 (脏标记) 机制 +' ============================================================================== +Option Explicit + +' 内部变量：映射 Excel 数据列 +Private pExcelRowIndex As Long ' 记录该对象对应 Excel 表中的物理行号，保存时定位用 +Private pRowNo As Long ' 行号 (如 10, 20) +Private pModuleType As String ' 模块 (如 表壳, 罩壳, 接头) +Private pCode As String ' 代号 +Private pItemName As String ' 名称 (使用 ItemName 避免与内部 Name 关键字冲突) +Private pQuantity As Double ' 数量 +Private pCondition As String ' 选择条件 (核心修改字段) +Private pRemark As String ' 备注 +Private pCategory As String ' 类别 +Private pParentCategory As String ' 上层类别 +Private pCategoryCondition As String ' 类别选用条件 +Private pCode66 As String ' 66代码 +Private pBIPBaseRowNo As String ' BIP行号基数 + +' 内部变量：状态追踪 +Private pIsDirty As Boolean ' 脏标记：True 表示对象数据被修改过，需要写回 Excel + +' 初始化对象时，默认状态为干净 (未修改) +Private Sub Class_Initialize() + pIsDirty = False +End Sub + +' ------------------------------------------------------------------------------ +' 属性: ExcelRowIndex (物理行号) +' ------------------------------------------------------------------------------ +Public Property Get ExcelRowIndex() As Long: ExcelRowIndex = pExcelRowIndex: End Property +Public Property Let ExcelRowIndex(ByVal vNewValue As Long): pExcelRowIndex = vNewValue: End Property + +' ------------------------------------------------------------------------------ +' 属性: RowNo (BOM行号) +' ------------------------------------------------------------------------------ +Public Property Get RowNo() As Long: RowNo = pRowNo: End Property +Public Property Let RowNo(ByVal vNewValue As Long) + If pRowNo <> vNewValue Then pRowNo = vNewValue: pIsDirty = True +End Property + +' ------------------------------------------------------------------------------ +' 属性: ModuleType (模块) +' ------------------------------------------------------------------------------ +Public Property Get ModuleType() As String: ModuleType = pModuleType: End Property +Public Property Let ModuleType(ByVal vNewValue As String) + If pModuleType <> vNewValue Then pModuleType = vNewValue: pIsDirty = True +End Property + +' ------------------------------------------------------------------------------ +' 属性: Code (代号) +' ------------------------------------------------------------------------------ +Public Property Get Code() As String: Code = pCode: End Property +Public Property Let Code(ByVal vNewValue As String) + If pCode <> vNewValue Then pCode = vNewValue: pIsDirty = True +End Property + +' ------------------------------------------------------------------------------ +' 属性: ItemName (名称) +' ------------------------------------------------------------------------------ +Public Property Get ItemName() As String: ItemName = pItemName: End Property +Public Property Let ItemName(ByVal vNewValue As String) + If pItemName <> vNewValue Then pItemName = vNewValue: pIsDirty = True +End Property + +' ------------------------------------------------------------------------------ +' 属性: Quantity (数量) +' ------------------------------------------------------------------------------ +Public Property Get Quantity() As Double: Quantity = pQuantity: End Property +Public Property Let Quantity(ByVal vNewValue As Double) + If pQuantity <> vNewValue Then pQuantity = vNewValue: pIsDirty = True +End Property + +' ------------------------------------------------------------------------------ +' 属性: Condition (选择条件) - 这是本工具最核心要修改的字段 +' ------------------------------------------------------------------------------ +Public Property Get Condition() As String: Condition = pCondition: End Property +Public Property Let Condition(ByVal vNewValue As String) + ' 只有当新写入的值和原有的值不一样时，才判定为被修改，打上脏标记 + If pCondition <> vNewValue Then + pCondition = vNewValue + pIsDirty = True + End If +End Property + +' ------------------------------------------------------------------------------ +' 其他次要属性的 Get/Let +' ------------------------------------------------------------------------------ +Public Property Get Remark() As String: Remark = pRemark: End Property +Public Property Let Remark(ByVal vNewValue As String): If pRemark <> vNewValue Then pRemark = vNewValue: pIsDirty = True: End Property + +Public Property Get Category() As String: Category = pCategory: End Property +Public Property Let Category(ByVal vNewValue As String): If pCategory <> vNewValue Then pCategory = vNewValue: pIsDirty = True: End Property + +Public Property Get ParentCategory() As String: ParentCategory = pParentCategory: End Property +Public Property Let ParentCategory(ByVal vNewValue As String): If pParentCategory <> vNewValue Then pParentCategory = vNewValue: pIsDirty = True: End Property + +Public Property Get CategoryCondition() As String: CategoryCondition = pCategoryCondition: End Property +Public Property Let CategoryCondition(ByVal vNewValue As String): If pCategoryCondition <> vNewValue Then pCategoryCondition = vNewValue: pIsDirty = True: End Property + +Public Property Get Code66() As String: Code66 = pCode66: End Property +Public Property Let Code66(ByVal vNewValue As String): If pCode66 <> vNewValue Then pCode66 = vNewValue: pIsDirty = True: End Property + +Public Property Get BIPBaseRowNo() As String: BIPBaseRowNo = pBIPBaseRowNo: End Property +Public Property Let BIPBaseRowNo(ByVal vNewValue As String): If pBIPBaseRowNo <> vNewValue Then pBIPBaseRowNo = vNewValue: pIsDirty = True: End Property + +' ------------------------------------------------------------------------------ +' 状态追踪：只读的 IsDirty 和重置方法 +' ------------------------------------------------------------------------------ +Public Property Get IsDirty() As Boolean + IsDirty = pIsDirty +End Property + +' 可以在写回 Excel 后，调用此方法将状态重置为干净 +Public Sub ResetDirtyFlag() + pIsDirty = False +End Sub \ No newline at end of file diff --git a/VBA/ClassModules/cConditionEngine.cls b/VBA/ClassModules/cConditionEngine.cls new file mode 100644 index 0000000..43c9eee --- /dev/null +++ b/VBA/ClassModules/cConditionEngine.cls @@ -0,0 +1,123 @@ +' ============================================================================== +' 模块名称: 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 \ No newline at end of file diff --git a/VBA/Modules/mTestEngine.bas b/VBA/Modules/mTestEngine.bas new file mode 100644 index 0000000..0b14d4e --- /dev/null +++ b/VBA/Modules/mTestEngine.bas @@ -0,0 +1,130 @@ +' ============================================================================== +' 模块名称: mTestEngine +' 模块类别: 标准模块 (Standard Module) +' 模块职责: 专门用于测试 cConditionEngine 类的逻辑准确性 (引入轻量级单元测试框架) +' ============================================================================== +Option Explicit + +' 定义模块级变量，用于统计测试结果 +Private passCount As Integer +Private failCount As Integer + +Public Sub RunBOMForgeTests() + ' 初始化计数器 + passCount = 0 + failCount = 0 + + ' 执行条件引擎测试 + Call Test_ConditionEngine + + ' 执行数据模型测试 (新增) + Call Test_cBOMRow + + ' ---- 输出测试汇总 ---- + Debug.Print "-----------------------------------------------" + Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例" + Debug.Print "通过: " & passCount & " 失败: " & failCount + If failCount = 0 Then + Debug.Print ">>> 状态: 全部通过！ (ALL PASS)" + Else + Debug.Print ">>> 状态: 存在失败用例，请检查逻辑！" + End If + Debug.Print "========== BOMForge 测试框架结束 ==========" + +End Sub + +Private Sub Test_ConditionEngine() + Dim conditionEngine As cConditionEngine + Set conditionEngine = New cConditionEngine + + Dim originStr As String + Dim expectedStr As String + Dim paramName As String + Dim newValue As String + + paramName = "lcfw" + newValue = "M19" + + Debug.Print "========== 1. 开始测试: cConditionEngine ==========" + + ' ---- 测试用例 1: 盘止钉 (纯 OR 链，无 AND，无括号) ---- + originStr = "lcfw=M01 OR lcfw=M02 OR lcfw=M30" + expectedStr = "lcfw=M01 OR lcfw=M02 OR lcfw=M30 OR lcfw=M19" + AssertEqual "场景1_盘止钉", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue) + + ' ---- 测试用例 2: 接头 (括号包裹的 OR 链，外面有 AND) ---- + originStr = "(azxs=A0 OR azxs=AT OR azxs=AH) AND gclj=Z14 AND (lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16)" + expectedStr = "(azxs=A0 OR azxs=AT OR azxs=AH) AND gclj=Z14 AND (lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16 OR lcfw=M19)" + AssertEqual "场景2_接头", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue) + + ' ---- 测试用例 3: 弹性元件 (孤立的参数，外面有 AND，需自动加括号) ---- + originStr = "lcfw=M01 AND gclj!=M20" + expectedStr = "(lcfw=M01 OR lcfw=M19) AND gclj!=M20" + AssertEqual "场景3_弹簧管", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue) + + ' ---- 测试用例 4: 封口片 (右侧紧跟 AND 的情况) ---- + originStr = "(lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16)AND gclj!=M20" + expectedStr = "(lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16 OR lcfw=M19)AND gclj!=M20" + AssertEqual "场景4_封口片", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue) + + ' ---- 测试用例 5: 防御性测试 (本身已经包含了目标条件，看是否会重复添加) ---- + originStr = "lcfw=M01 OR lcfw=M19" + expectedStr = "lcfw=M01 OR lcfw=M19" + AssertEqual "场景5_防重复", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue) + +End Sub + +' ============================================================================== +' 新增：针对 cBOMRow 对象的单元测试 +' ============================================================================== +Private Sub Test_cBOMRow() + Debug.Print "" + Debug.Print "========== 2. 开始测试: cBOMRow 数据模型 ==========" + + Dim bomRow As cBOMRow + Set bomRow = New cBOMRow + + ' 测试初始状态：应为 Clean (False) + AssertEqual "初始脏标记测试", "False", CStr(bomRow.IsDirty) + + ' 模拟从 Excel 中读取数据 (此时要避开 Property Let 的脏标记触发，但既然封装了，我们就测试 Property Let) + ' 实际在 Repository 载入时，载入完毕后会调用 ResetDirtyFlag + bomRow.RowNo = 700 + bomRow.ModuleType = "接头" + bomRow.Code = "01081014361" + bomRow.ItemName = "径向高压接头" + bomRow.Condition = "(azxs=A0) AND gclj=Z14" + + ' 赋值后应该是脏的 + AssertEqual "赋值后脏标记测试", "True", CStr(bomRow.IsDirty) + + ' 模拟保存完毕重置标记 + bomRow.ResetDirtyFlag + AssertEqual "重置后脏标记测试", "False", CStr(bomRow.IsDirty) + + ' 模拟未改变内容的重复赋值 (脏标记不应改变) + bomRow.Condition = "(azxs=A0) AND gclj=Z14" + AssertEqual "重复赋值脏标记测试", "False", CStr(bomRow.IsDirty) + + ' 模拟条件引擎注入新条件 (内容变更，脏标记触发) + bomRow.Condition = "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)" + AssertEqual "状态变更脏标记测试", "True", CStr(bomRow.IsDirty) + AssertEqual "属性读取测试", "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)", bomRow.Condition + +End Sub + +' ============================================================================== +' 内部辅助方法：断言测试结果 +' 将期望值与实际值进行比对，并输出标准化的日志信息 +' ============================================================================== +Private Sub AssertEqual(testName As String, expected As String, actual As String) + If expected = actual Then + Debug.Print "[PASS] " & testName + passCount = passCount + 1 + Else + Debug.Print "[FAIL] " & testName + Debug.Print " 期望结果: " & expected + Debug.Print " 实际结果: " & actual + failCount = failCount + 1 + End If +End Sub \ No newline at end of file