mydata.cls

guan yu pai ke xi tong de ruan jian

            FileSize = FileSize + 1
        Next
        '保存表格名称及各字段名称。
        For TemIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount Step 1
            If TemIndex = 0 Then
                NameStr = Me.Tables(TableIndex).Name
            Else
                NameStr = Me.Tables(TableIndex).Fields.Items(TemIndex - 1).Name
            End If
            Put #1, FileSize, 0 '字符串结束标志。
            For ForIndex = 1 To Len(NameStr) Step 1
                TemStr = Mid(NameStr, ForIndex, 1)
                If Asc(TemStr) < 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
                    Put #1, FileSize, TemData
                    FileSize = FileSize + 1
                    Put #1, FileSize, 0 '字符串结束标志。
                End If
            Next
            FileSize = FileSize + 1
        Next
        '保存各记录数据.
        For TemRowIndex = 0 To Me.Tables(TableIndex).RowCount - 1 Step 1 '所有记录。
            For TemFieldIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1 Step 1 '所有字段。
                Put #1, FileSize, 0 '数据初始化，字符串结束标志。
                Select Case Me.Tables(TableIndex).Fields.Items(TemFieldIndex).DataType
                Case vbBoolean: '布尔型.
                    TemData = CByte(CBool(Me.Tables(TableIndex).Rows(TemRowIndex).Items(TemFieldIndex).Value))
                    Put #1, FileSize, TemData
                    FileSize = FileSize + 1
                Case vbByte: '1字节。
                    TemData = CByte(Me.Tables(TableIndex).Rows(TemRowIndex).Items(TemFieldIndex).Value)
                    Put #1, FileSize, TemData
                    FileSize = FileSize + 1
                Case vbInteger: '两字节。
                    TemStr = Hex(CInt((Me.Tables(TableIndex).Rows(TemRowIndex).Items(TemFieldIndex).Value)))
                    Do While Len(TemStr) < 4
                        TemStr = "0" & TemStr
                    Loop
                    '先存低字节（低字节在前）。
                    Do While TemStr <> ""
                        TemData = CByte("&H" & Right(TemStr, 2)) '取出后两个字符（第2字节）
                        TemStr = Left(TemStr, Len(TemStr) - 2) '去除后两个字符（第2字节）
                        Put #1, FileSize, TemData '写入数据。
                        FileSize = FileSize + 1
                    Loop
                Case vbLong: '四字节。
                    TemStr = Hex(CLng((Me.Tables(TableIndex).Rows(TemRowIndex).Items(TemFieldIndex).Value)))
                    Do While Len(TemStr) < 8
                        TemStr = "0" & TemStr
                    Loop
                    '先存低字节（低字节在前）。
                    Do While TemStr <> ""
                        TemData = CByte("&H" & Right(TemStr, 2)) '取出后两个字符（第2字节）
                        TemStr = Left(TemStr, Len(TemStr) - 2) '去除后两个字符（第2字节）
                        Put #1, FileSize, TemData '写入数据。
                        FileSize = FileSize + 1
                    Loop
                Case vbString: '以NULL结束。长度不限。
                    Put #1, FileSize, 0 '字符串结束标志。
                    NameStr = Me.Tables(TableIndex).Rows(TemRowIndex).Items(TemFieldIndex).Value
                    For ForIndex = 1 To Len(NameStr) Step 1
                        TemStr = Mid(NameStr, ForIndex, 1)
                        If Asc(TemStr) < 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
                            Put #1, FileSize, TemData
                            FileSize = FileSize + 1
                            Put #1, FileSize, 0 '字符串结束标志。
                        End If
                    Next
                    FileSize = FileSize + 1
                End Select
            Next
        Next
    Next
    SaveMddFile = False
    Close #1
    Exit Function
SaveMddFileErr:
    On Error Resume Next
    Close #1
    MsgBox Err.Description, vbOKOnly, "保存文件错误..."
End Function
Public Function OpenDataFile(ByVal FileName As String) As Boolean
    OpenDataFile = True
    Select Case LCase(Right(FileName, 3))
    Case "mdd":
        OpenDataFile = OpenMddFile(FileName)
    Case "mdb":
        OpenDataFile = OpenAccessFile(FileName)
    Case "xls":
        OpenDataFile = OpenXlsFile(FileName)
    Case Else:
        MsgBox "文件扩展名错误!" & Chr(13) & "请使用本系统支持的数据库文件！", vbOKOnly, "文件类型错..."
        Exit Function
    End Select
    If OpenDataFile = False Then
        Me.DataFileName = FileName
        Me.Updatable = False
    End If
End Function
Private Function OpenAccessFile(ByVal FileName As String) As Boolean
    '打开ACCESS文件。
On Error GoTo OpenAccessFileErr
    Dim TemDatabase As Database
    Dim TemRecord As Recordset
    Dim TableIndex As Long
    Dim FieldIndex As Long
    OpenAccessFile = True
    If ApplyMode = False Then
        If MsgBox("尚未注册!该功能限用!" & Chr(13) & "支持国产软件,请注册您的产品!" & Chr(13) & "现在就要注册吗?", vbYesNo, "功能受限") = vbYes Then Apply.Show 1
        Exit Function
    End If
    Set TemDatabase = Workspaces(0).OpenDatabase(FileName)
    '以下代码将数据导入到数据集中(请确定打开的文件内部名称与数据类型与本系统完全一致！)。
    For TableIndex = 0 To Me.TableCount - 1
        Me.Tables(TableIndex).ClearRows '清除现有数据.
        Set TemRecord = TemDatabase.OpenRecordset(Me.Tables(TableIndex).Name) '打开相应记录.
        For FieldIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1
            If TemRecord.Fields(FieldIndex).Type <> dbText Then
                Me.Tables(TableIndex).Fields.Items(FieldIndex).DataType = MddLong
            Else
                Me.Tables(TableIndex).Fields.Items(FieldIndex).DataType = MddString
            End If
        Next
        TemRecord.MoveFirst
        Do While TemRecord.EOF = False
            Me.Tables(TableIndex).AddRow '添加到数据集.
            For FieldIndex = 0 To Me.Tables(TableIndex).Fields.FieldCount - 1
                Me.Tables(TableIndex).Rows(Me.Tables(TableIndex).RowCount - 1).Items(FieldIndex).Value = TemRecord.Fields(FieldIndex).Value
            Next
            TemRecord.MoveNext '下一记录.
        Loop
    Next
    TemDatabase.Close  '关闭数据库.
    OpenAccessFile = False
    Exit Function
OpenAccessFileErr:
    MsgBox Err.Description, vbOKOnly, "打开文件错误..."
End Function
Private Function OpenMddFile(ByVal FileName As String) As Boolean
    '打开本系统专用的数据库格式文件。
On Error GoTo OpenMddFileErr
    Dim TemData As Byte
    Dim TemDataNext As Byte
    Dim TemStr As String
    Dim TemIndex As Long
    Dim FileSize As Double
    Dim ForIndex As Long
    Dim TableIndex As Long
    Dim TemTable As MDD_Table
    Dim TemTableCount As Long
    Dim TemFieldCount As Long
    Dim TemFieldType() As Byte
    Dim TemRowCount As Long
    Dim TemRowIndex As Long
    Dim TemFieldIndex As Long
    Dim NewFrm As PassFrm
    OpenMddFile = True
    Open FileName For Binary Access Read As #1
    '对文件标志进行判断。
    Get #1, 1, TemData
    If TemData <> 80 Then GoTo OpenMddFileErr
    Get #1, 2, TemData
    If TemData <> 75 Then GoTo OpenMddFileErr
    Get #1, 3, TemData
    If TemData <> 90 Then GoTo OpenMddFileErr
    Get #1, 4, TemData
    If TemData <> 83 Then GoTo OpenMddFileErr
    For FileSize = 15 To 20 Step 1
        Get #1, FileSize, TemData
        If TemData <> FileSymbol Then GoTo OpenMddFileErr
    Next
    '获取密码.
    TemStr = ""
    FileSize = 301
    Do While FileSize < 400
        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
    If TemStr <> "" Then
        PassString = TemStr
        PassFrm.Show 1
    End If
    If TemStr <> PassString Then GoTo OpenMddFileErr
    Me.Clear '文件标志正确，清除数据库原有内容，准备接收文件数据。
    Me.PassStr = TemStr '保存密码.
    '获取文件主版本号。
    Get #1, 5, TemData
    TemMajor = TemData * 256
    Get #1, 6, TemData
    TemMajor = TemMajor + TemData
    '获取文件次版本号。
    Get #1, 7, TemData
    TemMinor = TemData * 256
    Get #1, 8, TemData
    TemMinor = TemMinor + TemData
    '获取文件修正号。
    Get #1, 9, TemData
    TemRevision = TemData * 256
    Get #1, 10, TemData
    TemRevision = TemRevision + TemData
    TemTableCount = 0
    For ForIndex = 11 To 14 Step 1
        Get #1, ForIndex, TemData
        TemTableCount = TemTableCount * 256 + TemData
    Next
    '获取数据库存名称
    TemStr = ""
    FileSize = 101
    Do While FileSize < 300
        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.DatabaseName = TemStr
    '读取第一个表格。
    FileSize = 600
    For TableIndex = 0 To TemTableCount - 1 Step 1
        Set TemTable = New MDD_Table
        FileSize = FileSize + 1
        For TemIndex = 0 To 3 Step 1 '四字节标志.
            Get #1, FileSize, TemData
            FileSize = FileSize + 1
            If TemData <> FileSymbol Then GoTo OpenMddFileErr