纯编码实现Access数据库的建立或压缩

梦幻广寒宫

梦幻广寒宫

2016-01-29 17:42

纯编码实现Access数据库的建立或压缩,纯编码实现Access数据库的建立或压缩
  纯编码实现Access数据库的建立或压缩!!

<%
'#######以下是一个类文件,下面的注解是调用类的方法################################################
'#  注意:如果系统不支持建立Scripting.FileSystemObject对象,那么数据库压缩功能将无法使用
'#                          Access 数据库类
'# CreateDbFile 建立一个Access 数据库文件
'# CompactDatabase 压缩一个Access 数据库文件
'# 建立对象方法:
'#     Set a = New DatabaseTools
'#                               by (萧寒雪) s.f.
'#########################################################################################

Class DatabaseTools

Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
'建立数据库文件
'If DbVer is 0 Then Create Access97 dbFile
'If DbVer is 1 Then Create 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.Connec
展开更多 50%)
分享

猜你喜欢

纯编码实现Access数据库的建立或压缩

ASP
纯编码实现Access数据库的建立或压缩

纯编码实现数据库的建立或压缩

ASP
纯编码实现数据库的建立或压缩

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

空手建立Access数据库

编程语言 网络编程
空手建立Access数据库

用程序实现压缩access(*.mdb)数据库的方法

编程语言 网络编程
用程序实现压缩access(*.mdb)数据库的方法

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

实例讲解Access数据库在线压缩的实现方法

编程语言 网络编程
实例讲解Access数据库在线压缩的实现方法

在VB中压缩ACCESS数据库

vb
在VB中压缩ACCESS数据库

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

重装不麻烦 备份Win XP系统激活信息

重装不麻烦 备份Win XP系统激活信息

Windows XP系统任务栏实用技巧总集

Windows  XP系统任务栏实用技巧总集
下拉加载更多内容 ↓