'压缩文件函数，dataS为源文件，dataz为目标文件，传出为一个布尔值

Private Function DataZip(ByVal Datas As String, ByVal Dataz As String) As Boolean

On Error GoTo Compact_Error

Dim JRO As JRO.JetEngine

Set JRO = New JRO.JetEngine

Dim fso As New FileSystemObject

If fso.FileExists(Dataz) = True Then


   If MsgBox("此压缩文件已存在是否将其覆盖？", vbYesNo + vbQuestion, "压缩工程数据文件") = vbYes  Then

      Kill Dataz

  Else

     Exit Function

End If

End If


'压缩工程文件

JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Datas, _

"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Dataz & ";Jet OLEDB:Engine Type=5"

DataZip = True

MsgBox "工程数据压缩成功！", vbInformation + vbOKOnly, "压缩数据文件"

Exit Function

Compact_Error:

DataZip = False

If Err.Number = -2147467259 Then

   MsgBox "数据压缩失败!(可能你的数据库正被其他程序使用，请将重新运行系统！)", vbOKOnly + vbInformation, "错误"

   Exit Function

End If

    dbEncrypt.SaveError "MDIForm1-DataZip"

End Function


'解压缩函数，datas未压缩文件，dataz为已压缩文件


Private Function Zipext(ByVal Dataz As String, ByVal Datas As String) As Boolean

On Error GoTo Compact_Error

Dim JRO As JRO.JetEngine

Set JRO = New JRO.JetEngine

Dim fso As New FileSystemObject

If fso.FileExists(Datas) = True Then

    If MsgBox("此工程文件已存在是否将其覆盖？", vbYesNo + vbQuestion, "解压缩工程数据文件") = vbYes Then

        Kill Datas

    Else

       Exit Function

End If

End If


'解压缩工程文件


JRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Dataz, _

"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Datas & ";Jet OLEDB:Engine Type=5"

Zipext = True

MsgBox "工程数据解压缩成功！", vbOKOnly + vbInformation, "解压缩数据文件"

Exit Function

Compact_Error:

Zipext = False

If Err.Number = -2147467259 Then

   MsgBox "数据压缩失败!(可能你的数据库正被其他程序使用，请将重新运行系统！)", vbOKOnly + vbInformation, "错误"

   Exit Function

End If

    dbEncrypt.SaveError "MDIForm1-DataZip"

End Function