ASP 精华源码收集（五年总结）第1/20页

<%
'#######以下是一个类文件，下面的注解是调用类的方法################################################
'# 注意：如果系统不支持建立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
%>

1