mydata.cls

guan yu pai ke xi tong de ruan jian

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "MDD_Data"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'自定义数据类型
Const FileType As String = ".mdd" '文件扩展名为".mdd".
Const FileSymbol As Byte = 85 '数据文件填充标志字节值。
'文件版本号。
Private TemMajor As Integer '主版本号。
Private TemMinor As Integer '次版本号。
Private TemRevision As Integer '修正号。
 '表格对象.
Private TemTables() As MDD_Table
'表格数量.
Private TemTableCount As Long
'数据库名称。
Public DatabaseName As String
'密码文本.
Public PassStr As String
'文件名.
Public DataFileName As String
'当前自动处理状态.
Public DispState As Long '表示正在处理的记录.为-1表示自动处理已经结束(用于标志处理状态).
'数据是否已经修改的标志。
Public Updatable As Boolean
Public Property Get FileMajor() As Integer
    FileMajor = TemMajor
End Property
Public Property Get FileMinor() As Integer
    FileMinor = TemMinor
End Property
Public Property Get FileRevision() As Integer
    FileRevision = TemRevision
End Property


Public Function OutClassDataToXLS(ByVal FileName As String) As Boolean
    '将课表输出到XLS文件中。
    '分别输出到以下几个表格中：
    '班级课表
    '班级考勤表
    '表级课表+班级考勤表
    '教师课表
    '教师到班表
    '教师课表+教师到班表
    '总课表
    '总考勤表
    
    Dim TemDatabase As Object
    Set TemDatabase = CreateObject("Excel.Application")
    'Dim TemDatabase As New Excel.Application
    Dim TableIndex As Long
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim TemStr As String
    Dim TemNum As Long
On Error GoTo OutErr




    TemDatabase.Workbooks(1).SaveAs (FileName)
    TemDatabase.Quit
    OutClassDataToXLS = False
OutErr:
    MsgBox Err.Description, vbOKOnly, "输出错误..."
    On Error Resume Next
    TemDatabase.Workbooks(1).Close (0) '关闭工作簿，并且不保存数据。
    TemDatabase.Quit '退出EXCEL服务，在系统任务中关闭相应服务程序，如果没有这句，即使退出本应用系统，EXCEL服务程序任然在运行。
    OutClassDataToXLS = True '置错误标志。
End Function

Public Property Get TableCount() As Long '只读属性.
        TableCount = TemTableCount
End Property
Private Sub Class_Initialize()
    '初始化.
    TemTableCount = 0 '表格数量。
    ReDim TemTables(TemTableCount) '表格对象数组。
    Me.PassStr = "" '密码为空.
    Me.DatabaseName = "" '数据库名称。
    TemMajor = App.Major '主版本号。
    TemMinor = App.Minor '次版本号。
    TemRevision = App.Revision '修正号。
    DataFileName = "" '文件名为空.
    DispState = -1 '当前自动处理状态为停止状态。
    Me.Updatable = False '数据更新标志.
End Sub
Public Property Get Tables(ByVal TableIndex As Long) As MDD_Table
    '获取表对象(可进一步对其操作).
    If TableIndex >= 0 And TableIndex < TemTableCount Then
        Set Tables = TemTables(TableIndex)
    End If
End Property
Public Sub AddTable(ByVal InTable As MDD_Table)
    '添加表对象的结构
    Dim ForIndex As Long
    Dim RowIndex As Long
    Dim FieldIndex As Long
    TemTableCount = TemTableCount + 1
    ReDim Preserve TemTables(TemTableCount)
    Set TemTables(TemTableCount - 1) = New MDD_Table
    For ForIndex = 0 To InTable.Fields.FieldCount - 1 Step 1
        TemTables(TemTableCount - 1).Fields.AddField InTable.Fields.Items(ForIndex).Name, InTable.Fields.Items(ForIndex).DataType
    Next
    TemTables(TemTableCount - 1).Name = InTable.Name
    '添加数据记录.
    For RowIndex = 0 To InTable.RowCount - 1 Step 1
        TemTables(TemTableCount - 1).AddRow
        For FieldIndex = 0 To InTable.Fields.FieldCount - 1 Step 1
            TemTables(TemTableCount - 1).Rows(RowIndex).Items(FieldIndex).Value = InTable.Rows(RowIndex).Items(FieldIndex).Value
        Next
    Next
End Sub
Public Sub Clear()
    Class_Initialize
End Sub
Public Sub DelTable(ByVal TableIndex As Long)
    '删除表对象.
    Dim ForIndex As Long
    If TableIndex < 0 Or TableIndex >= TemTableCount Then Exit Sub
    For ForIndex = TableIndex To TemTableCount - 2 Step 1
        Set TemTables(ForIndex) = TemTables(ForIndex + 1)
    Next
    TemTableCount = TemTableCount - 1
    ReDim Preserve TemTables(TemTableCount)
End Sub
Public Function SaveDataFile(ByVal FileName As String) As Boolean
    SaveDataFile = True
    Select Case LCase(Right(FileName, 3))
    Case "mdd":
        SaveDataFile = SaveMddFile(FileName)
    Case "mdb":
        SaveDataFile = SaveAccessFile(FileName)
    Case "xls":
        SaveDataFile = SaveXlsFile(FileName)
    Case Else:
        MsgBox "文件扩展名错误!" & Chr(13) & "请使用本系统支持的数据库文件！", vbOKOnly, "文件类型错..."
        Exit Function
    End Select
    If SaveDataFile = False Then
        Me.DataFileName = FileName
        Me.Updatable = False
    End If
End Function
Private Function OpenXlsFile(ByVal FileName As String) As Boolean
On Error GoTo OpenXlsFileErr
    Dim TemDatabase As Object
    Set TemDatabase = CreateObject("Excel.Application")
    'Dim TemDatabase As New Excel.Application
    Dim TableIndex As Long
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim TemStr As String
    Dim TemData() As Variant '数据缓冲池.
    Dim ForIndex As Long
    OpenXlsFile = True
    If ApplyMode = False Then
        If MsgBox("尚未注册!该功能限用!" & Chr(13) & "支持国产软件,请注册您的产品!" & Chr(13) & "现在就要注册吗?", vbYesNo, "功能受限") = vbYes Then Apply.Show 1
        Exit Function
    End If
    TemDatabase.Workbooks.Open FileName
    For TableIndex = 0 To Me.TableCount - 1
        Me.Tables(TableIndex).ClearRows
        Me.Tables(TableIndex).Name = TemDatabase.Workbooks(1).Worksheets(TableIndex + 1).Name
        For RowIndex = 1 To 65535 Step 20 '一次读取20第记录.
            ReDim TemData(1 To 20, 1 To Me.Tables(TableIndex).Fields.FieldCount) '确定缓冲池大小.
            '计算单元格引用区域字符串。
            ColIndex = Me.Tables(TableIndex).Fields.FieldCount - 1
            If ColIndex \ 26 > 0 Then
              TemStr = Chr(ColIndex \ 26 - 1 + 65)
              ColIndex = ColIndex Mod 26
            Else
                TemStr = ""
            End If
            TemStr = TemStr & Chr(ColIndex + 65)
            TemStr = "A" & RowIndex & ":" & TemStr & (RowIndex + 20)
            TemData = TemDatabase.Workbooks(1).Worksheets(TableIndex + 1).Range(TemStr).Value
            For ForIndex = 1 To 20
                If Len(TemData(ForIndex, 1)) < 1 Then Exit For
                Me.Tables(TableIndex).AddRow
                For ColIndex = 1 To Me.Tables(TableIndex).Fields.FieldCount
                    Me.Tables(TableIndex).Rows(Me.Tables(TableIndex).RowCount - 1).Items(ColIndex - 1).Value = TemData(ForIndex, ColIndex)
                Next
            Next
            If ForIndex <= 20 Then Exit For '发现第一个字段为空值,表示记录结束.
        Next
    Next
    TemDatabase.Quit
    OpenXlsFile = False
    Exit Function
OpenXlsFileErr:
    MsgBox Err.Description, vbOKOnly, "打开文件错误..."
End Function
Public Function NumToColumnname(ByVal InNum As Byte) As String
    '将数字转换为列名称。
    '数字从0到255，列名称从A开始。
    Dim TemStr As String
    If InNum > 25 Then TemStr = Chr(InNum \ 26 - 1 + 65) Else TemStr = ""
    TemStr = TemStr & Chr(InNum Mod 26 + 65)
    NumToColumnname = TemStr
End Function
Private Function SaveXlsFile(ByVal FileName As String) As Boolean
'On Error GoTo SaveXlsFileErr
    Dim TemDatabase As Object
    Set TemDatabase = CreateObject("Excel.Application")
    'Dim TemDatabase As New Excel.Application
    Dim TableIndex As Long
    Dim RowIndex As Long
    Dim ColIndex As Long
    Dim TemStr As String
    Dim TemNum As Long
    Dim myOfstruct As OFSTRUCT
    Dim ForIndex As Long
    Dim TianCount As Long
    Dim JieCount As Long

    Dim TemData1() As Variant '班级课表。
    Dim TemData2() As Variant '教师课表。
    Dim TemData3() As Variant '资源课表。
    Dim TemData4() As Variant '总课表。
    Dim TianIndex As Long
    Dim DuanIndex As Long
    Dim JieIndex As Long
    
    
    SaveXlsFile = True
    If ApplyMode = False Then
        If MsgBox("尚未注册!该功能限用!" & Chr(13) & "支持国产软件,请注册您的产品!" & Chr(13) & "现在就要注册吗?", vbYesNo, "功能受限") = vbYes Then Apply.Show 1
        Exit Function
    End If
    '如果文件已经存在,则先删除它.
    MyFile = OpenFile(FileName, myOfstruct, OF_EXIST)
    If MyFile >= 0 Then
        If DeleteFile(FileName) <= 0 Then '删除失败，则提示后退出。
            MsgBox "文件处于使用中，或你无权操作该文件！", vbOKOnly, "保存失败..."
            Exit Function
        End If
    End If
    TemDatabase.Workbooks.Add
    Do While TemDatabase.Workbooks(1).Worksheets.Count - 4 < Me.TableCount '增加4个表：“班级课表”“教师课表”“资源课表”“总课表”“总考勤表”
        TemDatabase.Workbooks(1).Worksheets.Add
    Loop
    TemDatabase.Workbooks(1).Worksheets(Me.TableCount + 1).Name = "班级课表"
    TemDatabase.Workbooks(1).Worksheets(Me.TableCount + 2).Name = "教师课表"
    TemDatabase.Workbooks(1).Worksheets(Me.TableCount + 3).Name = "资源课表"
    TemDatabase.Workbooks(1).Worksheets(Me.TableCount + 4).Name = "总课表"