纯编码实现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.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
%>