开发手记（十）——在VB中解压缩ACCESS数据库文件（mi6236）
开发手记（十）——在VB中解压缩ACCESS数据库文件（mi6236） 开发手记（十）——在VB中解压缩ACCESS数据库文件
－为保证文章完整性，谢绝对某篇而非全部手记的转载（mi6236）
'压缩文件函数，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