广告：
网页制作参考
千千学园
雨路开发频道
雨路技术文档
技术问答
编程技术

<% 
#######以下是一个类文件，下面的注解是调用类的方法################################################ 
# 注意：如果系统不支持建立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 ("无法建立，请检查错误信息 
" & 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.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 

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("删除文件发生错误!请查看错误信息 
" & 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.number<>0 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 
%> 

（）