如何对Access 数据库进行压缩？
具体见下：
Class DatabaseTools
Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
' 建立数据库文件:DbVer为0创建Access97 数据库,为1则创建Access2000 dbFile
On error resume Next
If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid (dbFileName,2,Len(dbFileName)))
If DbExists(SavePath & dbFileName) Then
Response.Write ("对不起,该数据库已经存在!")
CreateDBfile = False
Else
Dim Ca
Set Ca = Server.CreateObject("ADOX.Catalog")
If Err.number<>0 Then
Response.Write ("数据库建立失败,请检查后再操作!
" & Err.number & "
"
& Err.Description)
Err.Clear
Exit function
End If
If DbVer=0 Then
call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" &SavePath & dbFileName)
Else
call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
SavePath & dbFileName)
End If
Set Ca = Nothing
CreateDBfile = True
End If
End function
Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)
' 压缩数据库文件,0为access 97, 1 为access 2000
On Error resume next
If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid (dbFileName,2,Len(dbFileName)))
If DbExists(SavePath & dbFileName) Then
Response.Write ("对不起，该数据库已经存在!")
CompactDatabase = False
Else
Dim Cd
Set Cd =Server.CreateObject("JRO.JetEngine")
If Err.number<>0 Then
Response.Write ("数据库压缩失败,请检查后再操作!
" & Err.number & "
"
& Err.Description)
Err.Clear
Exit function
End If
If DbVer=0 Then
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data
Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName
& ".bak.mdb;Jet OLEDB;Encrypt Database=True")
Else
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName
& ".bak.mdb;Jet OLEDB;Encrypt Database=True")
End If
call DeleteFile(SavePath & dbFileName)
' 删除旧的数据库文件
call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
' 将压缩后的数据库文件还原
Set Cd = False
CompactDatabase = True
End If
end function
Public function DbExists(byVal dbPath)
' 检查数据库文件是否存在
On Error resume Next
Dim c
Set c = Server.CreateObject("ADODB.Connection")
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
If Err.number<>0 Then
Err.Clear
DbExists = false
else
DbExists = True
End If
set c = nothing
End function
Public function AppPath()
' 取当前真实路径
AppPath = Server.MapPath("./")
End function
Public function AppName()
' 取当前程序名称
AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables ("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
End Function
Public function DeleteFile(filespec)
' 删除一个文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number<>0 Then
Response.Write("文件删除失败,请检查后再操作!
" & Err.number & "
" &
Err.Description)
Err.Clear
DeleteFile = False
End If
call fso.DeleteFile(filespec)
Set fso = Nothing
DeleteFile = True
End function
Public function RenameFile(filespec1,filespec2)
' 修改一个文件
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number<>0 Then
Response.Write("文件名修改失败, 请检查后再操作!
" & Err.number & "
"
& Err.Description)
Err.Clear
RenameFile = False
End If
call fso.CopyFile(filespec1,filespec2,True)
call fso.DeleteFile(filespec1)
Set fso = Nothing
RenameFile = True
End function
End Class
%>
本文档为【zhongyaoasp如何对Access 数据库进行压缩？】，请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑，
图片更改请在作品中右键图片并更换，文字修改请直接点击文字进行修改，也可以新增和删除文档中的内容。
该文档来自用户分享，如有侵权行为请发邮件ishare@vip.sina.com联系网站客服，我们会及时删除。
[版权声明] 本站所有资料为用户分享产生，若发现您的权利被侵害，请联系客服邮件isharekefu@iask.cn，我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权，请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传，仅限个人学习分享使用，禁止用于任何广告和商用目的。
浙公网安备 33021202002483