网络编程
位置:首页>> 网络编程>> Asp编程>> asp如何对Access数据库进行压缩?

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

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

标签:access,数据库,压缩,asp

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
%>

0
投稿

猜你喜欢

手机版 网络编程 asp之家 www.aspxhome.com