mydata.cls

guan yu pai ke xi tong de ruan jian

        Next
        '读取数据记录数量.
        TemRowCount = 0
        For TemIndex = 0 To 3 Step 1 '四字节表示记录数量.
            Get #1, FileSize, TemData
            TemRowCount = TemRowCount * 256 + TemData
            FileSize = FileSize + 1
        Next
        '读取字段数量.
        TemFieldCount = 0
        For TemIndex = 0 To 3 Step 1 '四字节表示字段数量.
            Get #1, FileSize, TemData
            TemFieldCount = TemFieldCount * 256 + TemData
            FileSize = FileSize + 1
        Next
        '读取各字段数据类型.
        ReDim TemFieldType(TemFieldCount)
        For TemIndex = 0 To TemFieldCount - 1 Step 1
            Get #1, FileSize, TemFieldType(TemIndex)
            If TemFieldType(TemIndex) <> vbBoolean And TemFieldType(TemIndex) <> vbByte And TemFieldType(TemIndex) <> vbInteger And TemFieldType(TemIndex) <> vbLong And TemFieldType(TemIndex) <> vbString Then GoTo OpenMddFileErr '系统不支持的数据类型。
            FileSize = FileSize + 1
        Next
        '读取表格名称及各字段名称。
        TemIndex = 0
ReadNameNext:
        TemStr = ""
        Do While True
            Get #1, FileSize, TemData
            FileSize = FileSize + 1
            If TemData = 0 Or EOF(1) = True Then Exit Do  '遇到字符串结束标志,或文件结束标志。
            If TemData < 128 Then 'ASC字符。
                TemStr = TemStr & Chr(TemData)
            Else
                Get #1, FileSize, TemDataNext
                FileSize = FileSize + 1
                TemStr = TemStr & Chr("&H" & Hex(TemData) & Hex(TemDataNext))
            End If
        Loop
        If TemIndex = 0 Then
            TemTable.Name = TemStr '表格名称.
        Else '字段名称。
            If TemFieldType(TemIndex) = vbString Then '字符型。
                TemTable.Fields.AddField TemStr, TemFieldType(TemIndex - 1)
            Else '数字型。
                TemTable.Fields.AddField TemStr, TemFieldType(TemIndex - 1)
            End If
        End If
        TemIndex = TemIndex + 1
        If TemIndex <= TemFieldCount Then GoTo ReadNameNext
        Me.AddTable TemTable '将表格结构添加到数据库中。
        '读取数据记录。
        For TemRowIndex = 0 To TemRowCount - 1 Step 1
            Me.Tables(Me.TableCount - 1).AddRow
            For TemFieldIndex = 0 To TemFieldCount - 1 Step 1
                Select Case TemFieldType(TemFieldIndex)
                Case vbBoolean:
                    Get #1, FileSize, TemData
                    Me.Tables(Me.TableCount - 1).Rows(Me.Tables(Me.TableCount - 1).RowCount - 1).Items(TemFieldIndex).Value = CBool(TemData)
                    FileSize = FileSize + 1
                Case vbByte:
                    Get #1, FileSize, TemData
                    Me.Tables(Me.TableCount - 1).Rows(Me.Tables(Me.TableCount - 1).RowCount - 1).Items(TemFieldIndex).Value = CByte(TemData)
                    FileSize = FileSize + 1
                Case vbInteger:
                    TemStr = ""
                    For ForIndex = 0 To 1 Step 1
                        Get #1, FileSize, TemData
                        TemStr = Hex(TemData) & TemStr: If Len(TemStr) Mod 2 <> 0 Then TemStr = "0" & TemStr
                        FileSize = FileSize + 1
                    Next
                    Me.Tables(Me.TableCount - 1).Rows(Me.Tables(Me.TableCount - 1).RowCount - 1).Items(TemFieldIndex).Value = CInt("&h" & TemStr)
                Case vbLong:
                    TemStr = ""
                    For ForIndex = 0 To 3 Step 1
                        Get #1, FileSize, TemData
                        TemStr = Hex(TemData) & TemStr: If Len(TemStr) Mod 2 <> 0 Then TemStr = "0" & TemStr
                        FileSize = FileSize + 1
                    Next
                    Me.Tables(Me.TableCount - 1).Rows(Me.Tables(Me.TableCount - 1).RowCount - 1).Items(TemFieldIndex).Value = CLng("&h" & TemStr)
                Case vbString:
                    TemStr = ""
                    Do While True
                        Get #1, FileSize, TemData
                        FileSize = FileSize + 1
                        If TemData = 0 Then Exit Do '遇到字符串结束标志。
                        If TemData < 128 Then 'ASC字符。
                            TemStr = TemStr & Chr(TemData)
                        Else
                            Get #1, FileSize, TemDataNext
                            FileSize = FileSize + 1
                            TemStr = TemStr & Chr("&H" & Hex(TemData) & Hex(TemDataNext))
                        End If
                    Loop
                    Me.Tables(Me.TableCount - 1).Rows(Me.Tables(Me.TableCount - 1).RowCount - 1).Items(TemFieldIndex).Value = TemStr
                End Select
            Next
        Next
    Next
    DataFileName = FileName
    OpenMddFile = False
    Close #1
    Exit Function
OpenMddFileErr:
On Error Resume Next
    Close #1
    MsgBox Err.Description & Chr(13) & "请确保打开一个与本系统兼容的数据文件.", vbOKOnly, "打开文件错误..."
End Function
Public Function LimitReduce(ByVal LimitStr As String) As String
    Dim Tian As Long
    Dim Duan As Long
    Dim Jie As Long
    Dim TianAll As Long
    Dim DuanAll As Long
    Dim JieAll As Long
    Dim ItemCount As Long
    Dim ForIndex As Long
    Dim TemNum As Long
    Dim TemStr As String
    Dim NextStr As String
    Dim Data() As Boolean
    Dim Lcount() As Long
    Tian = Me.Tables(6).RowCount
    Jie = 0
    For Duan = 0 To 4
        Jie = Jie + Me.Tables(7).Rows(0).Items(Duan).Value
    Next
    ReDim Data(0 To Tian, 0 To Duan, 0 To Jie)
    ReDim Lcount(Tian * Jie)
    Me.LimitCount LimitStr, Lcount
    '转换成三维数组。
    For ForIndex = 1 To Lcount(0) Step 1
        If Lcount(ForIndex) > 0 Then
            Data(Lcount(ForIndex) \ 100 - 1, (Lcount(ForIndex) Mod 100) \ 10 - 1, Lcount(ForIndex) Mod 10 - 1) = True
        End If
    Next
    ReDim Lcount(1) '释放部分内存资源。
    
    TemStr = ""
    '纵向合并。
    '检测是否有一整天都为允许或禁止的情况。
    TianAll = 0
    For Tian = 0 To Me.Tables(6).RowCount - 1
        DuanAll = 0
        For Duan = 0 To 4
            JieAll = 0
            For Jie = 0 To Me.Tables(7).Rows(0).Items(Duan).Value - 1
                If TemStr <> "" Then TemStr = TemStr & ","
                If Data(Tian, Duan, Jie) = True Then
                    TemStr = TemStr & Tian + 1 & Duan + 1 & Jie + 1
                    JieAll = JieAll + 1
                Else
                    TemStr = TemStr & "-" & Tian + 1 & Duan + 1 & Jie + 1
                    JieAll = JieAll - 1
                End If
            Next
            If Abs(JieAll) = Me.Tables(7).Rows(0).Items(Duan).Value Then '表示全部为允许或全部为禁止。
                If TemStr <> "" Then TemStr = TemStr & ","
                If JieAll > 0 Then
                    TemStr = TemStr & Tian + 1 & Duan + 1 & "0"
                    DuanAll = DuanAll + 1
                Else
                    TemStr = TemStr & "-" & Tian + 1 & Duan + 1 & "0"
                    DuanAll = DuanAll - 1
                End If
            End If
        Next
        If Abs(DuanAll) = 5 Then '表示所有段全部为允许或禁止。
            If TemStr <> "" Then TemStr = TemStr & ","
            If DuanAll > 0 Then
                TemStr = TemStr & Tian + 1 & "00"
                TianAll = TianAll + 1
            Else
                TemStr = TemStr & "-" & Tian + 1 & "00"
                TianAll = TianAll - 1
            End If
        End If
    Next
    If Abs(TianAll) = Me.Tables(6).RowCount Then '说明所有教学日全部为允许或全部为禁止。
        If TianAll > 0 Then
            TemStr = ""
        Else
            TemStr = "-0"
        End If
        LimitReduce = TemStr
        Exit Function '保证后续过程不会遇到为0的项。
    End If
    '横向合并。
    '检测是否各时段都允许或都禁止的情况；或所有时段的某几节全为允许或全为禁止。
    DuanAll = 0
    For Duan = 0 To 4
        JieAll = 0
        For Jie = 0 To Me.Tables(7).Rows(0).Items(Duan).Value - 1
            TianAll = 0
            For Tian = 0 To Me.Tables(6).RowCount - 1
                If Data(Tian, Duan, Jie) = True Then TianAll = TianAll + 1 Else TianAll = TianAll - 1
            Next
            If Abs(TianAll) = Me.Tables(6).RowCount Then '表示该节全部教学日都为允许或都为禁止。
                If TemStr <> "" Then TemStr = TemStr & ","
                If TianAll > 0 Then '表示允许。
                    TemStr = TemStr & "0" & Duan + 1 & Jie + 1
                    JieAll = JieAll + 1
                Else '表示禁止。
                    TemStr = TemStr & "-0" & Duan + 1 & Jie + 1
                    JieAll = JieAll - 1
                End If
            End If
        Next
        If Abs(JieAll) = Me.Tables(7).Rows(0).Items(Duan).Value Then '该段所有节均为允许或均为禁止。
            If TemStr <> "" Then TemStr = TemStr & ","
            If JieAll > 0 Then '该段全为允许。
                TemStr = TemStr & "0" & Duan + 1 & "0"
                DuanAll = DuanAll + 1
            Else '全为禁止。
                TemStr = TemStr & "-0" & Duan + 1 & "0"
                DuanAll = DuanAll - 1
            End If
        End If
    Next
    If Abs(DuanAll) = 5 Then '表示所有段全部为允许或全部为禁止。
        If DuanAll > 0 Then
            TemStr = ""
        Else
            TemStr = "-0"
        End If
        LimitReduce = TemStr
        Exit Function '保证后续过程不会遇到为0的项。
    End If
    ReDim Data(1) '释放部分内存资源。
    
    '对公式进行化简(去除被包含的子项)。
    '提取公式了项。
    ItemCount = 0
    TemNum = 1
    For ForIndex = 1 To Len(TemStr)
        If Mid(TemStr, ForIndex, 1) = "," Then
            ItemCount = ItemCount + 1
            ReDim Preserve Lcount(ItemCount)
            Lcount(ItemCount - 1) = Val(Mid(TemStr, TemNum, ForIndex - TemNum))
            TemNum = ForIndex + 1
        End If
    Next
    ItemCount = ItemCount + 1
    ReDim Preserve Lcount(ItemCount)
    Lcount(ItemCount - 1) = Val(Mid(TemStr, TemNum, Len(TemStr) - TemNum + 1))
ReduceStart:
    For Index1 = 0 To ItemCount - 1
        For Index2 = 0 To ItemCount - 1
            '交换位置，使后项数字的绝对值始终比前项大。
            '交换位置不会影响整个公式的意义。
            If Abs(Lcount(Index1)) > Abs(Lcount(Index2)) Then
                TemNum = Lcount(Index1)
                Lcount(Index1) = Lcount(Index2)
                Lcount(Index2) = TemNum
            End If
            '判断前项是否包含后项。
            If Abs(Lcount(Index1)) Mod 10 = 0 Or Abs(Lcount(Index1)) Mod 1