mydata.cls

guan yu pai ke xi tong de ruan jian

            TemDatabase.Workbooks(1).Worksheets(Me.TableCount + ForIndex).Rows("1:65536").HorizontalAlignment = &HFFFFEFF4
            '自动调整单元格大小。HorizontalAlignment
            TemDatabase.Workbooks(1).Worksheets(Me.TableCount + ForIndex).Columns("a:iv").AutoFit
            TemDatabase.Workbooks(1).Worksheets(Me.TableCount + ForIndex).Rows("1:65536").AutoFit
            '设置列宽。
            TemDatabase.Workbooks(1).Worksheets(Me.TableCount + ForIndex).Columns("a:b").ColumnWidth = 3
            If ForIndex < 4 Then TemDatabase.Workbooks(1).Worksheets(Me.TableCount + ForIndex).Columns(NumToColumnname(Me.Tables(6).RowCount + 3) & ":" & NumToColumnname(Me.Tables(6).RowCount + 4)).ColumnWidth = 3
        Next
        TemDatabase.Workbooks(1).Worksheets(Me.TableCount + 4).Columns("a:iv").ColumnWidth = 3
    End If
    '将数据保存到外部文件。
    TemDatabase.Workbooks(1).SaveAs FileName
    TemDatabase.Quit
    SaveXlsFile = False
    Exit Function
SaveXlsFileErr:
    MsgBox Err.Description, vbOKOnly, "保存文件错误..."
    On Error Resume Next
    TemDatabase.Workbooks(1).Close (0) '关闭工作簿，并且不保存数据。
    TemDatabase.Quit '退出EXCEL服务，在系统任务中关闭相应服务程序，如果没有这句，即使退出本应用系统，EXCEL服务程序任然在运行。
End Function

Private Function SaveAccessFile(ByVal FileName As String) As Boolean
    '保存为Access文件。
On Error GoTo SaveAccessFileErr
    Const MAXLENG = 250 '字符串长度.
    Dim TempDatabase As Database '数据集对象.
    Dim TempTable As TableDef '表对象.
    Dim TempField As Field '字段对象.
    Dim TempRecord As Recordset '数据记录对象.
    Dim ForIndex As Integer
    Dim TempStr As String
    Dim TableIndex As Long
    Dim FieldIndex As Long
    Dim RowIndex As Long
    Dim FieldType As Long
    Dim myOfstruct As OFSTRUCT
    SaveAccessFile = 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
    
    Set TempDatabase = Workspaces(0).CreateDatabase(FileName, dbLangGeneral) '建立一个新的MDB文件.
    For TableIndex = 0 To Me.TableCount - 1 '从第一个表开始。
        '复制结构。
        Set TempTable = TempDatabase.CreateTableDef(Me.Tables(TableIndex).Name) '设置一个新的表格对象。
        For FieldIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1 '添加字段。
            FieldType = Me.Tables(TableIndex).Fields.Items(FieldIndex).DataType
            TempStr = Me.Tables(TableIndex).Fields.Items(FieldIndex).Name '取得字段名称。
            '检查字段名称是否重复。
            For ForIndex = 0 To FieldIndex - 1 Step 1
                If TempStr = Me.Tables(TableIndex).Fields.Items(ForIndex).Name Then
                    TempStr = "字段" & FieldIndex
                    Exit For
                End If
            Next
            Select Case FieldType
            Case vbBoolean:
                Set TempField = TempTable.CreateField(TempStr, dbBoolean)
            Case vbByte:
                Set TempField = TempTable.CreateField(TempStr, dbByte)
            Case vbInteger
                Set TempField = TempTable.CreateField(TempStr, dbInteger)
            Case vbLong:
                Set TempField = TempTable.CreateField(TempStr, dbLong)
            Case vbString:
                Set TempField = TempTable.CreateField(TempStr, dbText, MAXLENG)
                TempField.AllowZeroLength = True '字符串允许零长度。
            End Select
            TempTable.Fields.Append TempField
        Next
        TempDatabase.TableDefs.Append TempTable '将此表添加到数据库对象中。
        Set TempRecord = TempDatabase.OpenRecordset(Me.Tables(TableIndex).Name) '打开数据记录对象(刚才建立的表)。
        '复制数据。
        For RowIndex = 0 To Me.Tables(TableIndex).RowCount - 1
            TempRecord.AddNew
            For FieldIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1
                TempRecord.Fields(FieldIndex).Value = Me.Tables(TableIndex).Rows(RowIndex).Items(FieldIndex).Value
            Next
            TempRecord.Update
        Next
    Next
    TempDatabase.Close '关闭数据库.
    SaveAccessFile = False
    Exit Function
SaveAccessFileErr:
    MsgBox Err.Description, vbOKOnly, "保存文件错误..."
End Function
Private Function SaveMddFile(ByVal FileName As String) As Boolean
    '保存为本系统专用格式的数据库文件。
    '本系统支持数据类型:
    '0:MyBoolean布尔型,占一个字节.
    '1:MyByte字节型,占一个字节.
    '2:MyInteger整数型,占两个字节.
    '3:MyLong长整型,占四个字节.
    '4:MyString字符型,根据字符长度占用相应字节.以0表示字符结束.(即比实际字符长度多一个字节).
    '数据结构说明:
    '1、文件由文件头及各表格数据结构2部分构成。
    '2、表格数据结构由表格头结构及数据体2部分构成。
    '文件头定义:
    '1:第1~4字节(前四个字节)为"PKZS"的ASCII码(80-75-90-83)(排课助手的汉语拼音打头字母)
    '2:第5~10字节表示版本号.( 主版本App.Major 与 次版本App.Minor 与 修正App.Revision)
    '3:第11~14字节表示表格数量.
    '4:第15~20字节全部保存为85(&H55)
    '5:第101字节至300字节表示数据库名称(最多100个汉字).
    '6:第301至400为密码.
    '7:第401至600字节保留.
    '表格头结构定义:
    '1:前四字节85(&H55)作为表格验证标志.
    '2:紧接其后四字节表示数据记录数量.
    '3:然后是四个字节表示字段数量.
    '4:然后是各字段的类型标志字节.
    '5:然后是表格名称及各字段名称.
    '6:然后是各条记录数据.
    '注意:本系统只支持前述数据类型,并严格按这些类型检测,否则报错.
On Error GoTo SaveMddFileErr
    Dim TemData As Byte
    Dim TemStr As String
    Dim TemIndex As Long
    Dim FileSize As Double
    Dim ForIndex As Long
    Dim TableIndex As Long
    Dim NameStr As String
    Dim TemRowIndex As Long
    Dim TemFieldIndex As Long
    SaveMddFile = True
    If LCase(Right(FileName, 4)) <> FileType Then
        MsgBox "文件扩展名错误!" & Chr(13) & "请使用<" & FileType & ">作文件扩展名！", vbOKOnly, "文件类型错..."
        Exit Function
    End If
    Open FileName For Binary Access Write As #1
    For FileSize = 1 To 14 Step 1
        Select Case FileSize
        Case 1:
            TemData = 80
        Case 2:
            TemData = 75:
        Case 3:
            TemData = 90:
        Case 4:
            TemData = 83:
        Case 5:
            TemData = App.Major \ 256:
        Case 6:
            TemData = App.Major Mod 256:
        Case 7:
            TemData = App.Minor \ 256:
        Case 8:
            TemData = App.Minor Mod 256:
        Case 9:
            TemData = App.Revision \ 256:
        Case 10:
            TemData = App.Revision Mod 256:
        Case 11:
            TemData = (Me.TableCount \ 256 \ 256 \ 256) Mod 256:
        Case 12:
            TemData = (Me.TableCount \ 256 \ 256) Mod 256:
        Case 13:
            TemData = (Me.TableCount \ 256) Mod 256:
        Case 14:
            TemData = Me.TableCount Mod 256:
        End Select
        Put #1, FileSize, TemData
    Next
    For FileSize = 15 To 20 Step 1
        Put #1, FileSize, FileSymbol
    Next
    '保存标题.
    FileSize = 101: Put #1, FileSize, 0 '添加字符串结束标志。
    For ForIndex = 1 To Len(Me.DatabaseName) Step 1
        TemStr = Mid(Me.DatabaseName, ForIndex, 1)
        If Asc(TemStr) < 0 Then '表示是一个汉字。
            If FileSize > 298 Then Exit For '如果发现多余字符，则自动截断。                          'If Asc(Mid(TemStr, ForNum, 1)) < 0 Then
            TemData = Val("&H" & Left(Right(Hex(Asc(TemStr)), 4), 2)) Mod 256
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            TemData = Val("&H" & Right(Right(Hex(Asc(TemStr)), 4), 2)) Mod 256
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            Put #1, FileSize, 0 '添加字符串结束标志。
        Else '表示是一个ASC字符。
            TemData = Asc(TemStr) Mod 256
            If FileSize > 299 Then Exit For '如果发现多余字符，则自动截断。
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            Put #1, FileSize, 0 '添加字符串结束标志。
        End If
    Next
    '保存密码.
    FileSize = 301: Put #1, FileSize, 0 '添加字符串结束标志。
    For ForIndex = 1 To Len(Me.PassStr) Step 1
        TemStr = Mid(Me.PassStr, ForIndex, 1)
        If Asc(TemStr) < 0 Then '表示是一个汉字。
            If FileSize > 398 Then Exit For '如果发现多余字符，则自动截断。                          'If Asc(Mid(TemStr, ForNum, 1)) < 0 Then
            TemData = Val("&H" & Left(Right(Hex(Asc(TemStr)), 4), 2)) Mod 256
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            TemData = Val("&H" & Right(Right(Hex(Asc(TemStr)), 4), 2)) Mod 256
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            Put #1, FileSize, 0 '添加字符串结束标志。
        Else '表示是一个ASC字符。
            TemData = Asc(TemStr) Mod 256
            If FileSize > 399 Then Exit For '如果发现多余字符，则自动截断。
            Put #1, FileSize, TemData
            FileSize = FileSize + 1
            Put #1, FileSize, 0 '添加字符串结束标志。
        End If
    Next
    FileSize = 600
    '保存各个数据表。
    For TableIndex = 0 To Me.TableCount - 1 Step 1
        FileSize = FileSize + 1
        For TemIndex = 0 To 3 Step 1 '四字节标志.
            Put #1, FileSize, FileSymbol
            FileSize = FileSize + 1
        Next
        '填写数据记录数量.
        TemData = (Me.Tables(TableIndex).RowCount \ 256 \ 256 \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = (Me.Tables(TableIndex).RowCount \ 256 \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = (Me.Tables(TableIndex).RowCount \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = Me.Tables(TableIndex).RowCount Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        '填写字段数量.
        TemData = (Me.Tables(TableIndex).Fields.FieldCount \ 256 \ 256 \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = (Me.Tables(TableIndex).Fields.FieldCount \ 256 \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = (Me.Tables(TableIndex).Fields.FieldCount \ 256) Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        TemData = Me.Tables(TableIndex).Fields.FieldCount Mod 256
        Put #1, FileSize, TemData
        FileSize = FileSize + 1
        '依次保存各字段类型.
        For TemIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1 Step 1
            TemData = Me.Tables(TableIndex).Fields.Items(TemIndex).DataType Mod 256
            Put #1, FileSize, TemData