'#######以下是一个类文件，下面的注解是调用类的方法
'# 注意：如果系统不支持建立scripting.filesystemobject对象，
那么数据库压缩功能将无法使用
'# access 数据库类
'# createdbfile 建立一个access 数据库文件
'# compactdatabase 压缩一个access 数据库文件
'# 建立对象方法:
'# set a = new databasetools
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.number0 then
response.write (无法建立，请检查错误信息
& err.number &
& 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.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
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.number0 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.number0 then
response.write(删除文件发生错误!请查看错误信息
& err.number &
& 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.number0 then
response.write(修改文件名时发生错误!请查看错误信息
& err.number &
& 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
%>