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

"\" 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 %>
[ctrl+a 全选 注:如需引入外部js需刷新才能执行]