当前位置:Gxlcms > mysql > 纯编码如何实现Access数据库的建立或压缩(2)

纯编码如何实现Access数据库的建立或压缩(2)

时间:2021-07-01 10:21:17 帮助过:5人阅读

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

人气教程排行