asp如何对Access数据库进行压缩?

来源:asp之家 时间:2009-11-19 21:20:00 

asp压缩access数据库,具体asp代码见下:

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 ("数据库建立失败,请检查后再操作!<br>" & Err.number & "<br>" 
& 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 ("数据库压缩失败,请检查后再操作!<br>" & Err.number & "<br>" 
& 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("文件删除失败,请检查后再操作!<br>" & Err.number & "<br>" & 
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("文件名修改失败, 请检查后再操作! <br>" & Err.number & "<br>" 
& 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
%>

标签:access,数据库,压缩,asp
0
投稿

猜你喜欢

  • sqlserver 不重复的随机数

    2012-02-12 15:29:29
  • CSS教程:简单理解em

    2008-07-03 12:44:00
  • 说说掌握JavaScript语言的思想前提

    2008-12-26 17:59:00
  • 一个非常有代表性的javascript简易拖动类

    2009-05-25 12:44:00
  • 细线表格的处理

    2008-08-06 12:53:00
  • 网页图片按钮的生成与美化

    2008-12-12 13:03:00
  • 不用script仅用css编写无限级弹出菜单

    2008-04-24 14:03:00
  • CSS制作11种风格不同的特效文字

    2010-10-20 20:08:00
  • 汇总数据库备份 还原 压缩与数据库转移的方法

    2009-01-19 14:07:00
  • 什么是Ajax及Ajax的优势

    2007-09-07 09:56:00
  • 22个HTML5的初级技巧

    2010-12-17 12:39:00
  • js自定义网页右键菜单方法

    2007-11-28 12:50:00
  • jQuery 横向滚动图片

    2009-03-11 13:09:00
  • 【总结】ASP如何获取访客真实的IP地址

    2007-08-15 13:43:00
  • ASP应用之教你使用模板

    2008-10-15 13:09:00
  • 可以实现在同一页面里的用多按钮进行提交吗?

    2009-11-01 18:04:00
  • javascript 跨浏览器的事件系统

    2010-07-28 19:34:00
  • asp会员系统如何实现“忘记密码”

    2007-09-19 12:17:00
  • 垂直无缝滚动图片(兼容性好)实例教程源码下载

    2010-04-06 12:16:00
  • SQL Server 压缩日志及数据库文件大小

    2009-05-13 10:29:00
  • asp之家 网络编程 m.aspxhome.com