纯编码如何实现Access数据库的建立或压缩（4）

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(SavePat

　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.number0 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