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

<%
'#######以下是一个类文件，下面的注解是调用类的方法################################################
'#注意：如果系统不支持建立Scripting.FileSystemObject对象，那么数据库压缩功能将无法使用
'#Access数据库类
'#CreateDbFile建立一个Access数据库文件
'#CompactDatabase压缩一个Access数据库文件
'#建立对象方法:
'#Seta=NewDatabaseTools
'#by(萧寒雪)s.f.
'#########################################################################################

ClassDatabaseTools

PublicfunctionCreateDBfile(byValdbFileName,byValDbVer,byValSavePath)
'建立数据库文件
'IfDbVeris0ThenCreateAccess97dbFile
'IfDbVeris1ThenCreateAccess2000dbFile
OnerrorresumeNext
IfRight(SavePath,1)<>""OrRight(SavePath,1)<>"/"ThenSavePath=Trim(SavePath)&""
IfLeft(dbFileName,1)=""OrLeft(dbFileName,1)="/"ThendbFileName=Trim(Mid(dbFileName,2,Len(dbFileName)))
IfDbExists(SavePath&dbFileName)Then
Response.Write("对不起，该数据库已经存在!")
CreateDBfile=False
Else
DimCa
SetCa=Server.CreateObject("ADOX.Catalog")
IfErr.number<>0Then
Response.Write("无法建立，请检查错误信息
"&Err.number&"
"&Err.Description)
Err.Clear
Exitfunction
EndIf
IfDbVer=0Then
callCa.Create("Provider=Microsoft.Jet.OLEDB.3.51;DataSource="&SavePath&dbFileName)
Else
callCa.Create("Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&SavePath&dbFileName)
EndIf
SetCa=Nothing
CreateDBfile=True
EndIf
Endfunction

PublicfunctionCompactDatabase(byValdbFileName,byValDbVer,byValSavePath)
'压缩数据库文件
'0为access97
'1为access2000
OnErrorresumenext
IfRight(SavePath,1)<>""OrRight(SavePath,1)<>"/"ThenSavePath=Trim(SavePath)&""
IfLeft(dbFileName,1)=""OrLeft(dbFileName,1)="/"ThendbFileName=Trim(Mid(dbFileName,2,Len(dbFileName)))
IfDbExists(SavePath&dbFileName)Then
Response.Write("对不起，该数据库已经存在!")
CompactDatabase=False
Else
DimCd
SetCd=Server.CreateObject("JRO.JetEngine")
IfErr.number<>0Then
Response.Write("无法压缩，请检查错误信息
"&Err.number&"
"&Err.Description)
Err.Clear
Exitfunction
EndIf
IfDbVer=0Then
callCd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;DataSource="&SavePath&dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data
Source="&SavePath&dbFileName&".bak.mdb;JetOLEDB;EncryptDatabase=True")
Else
callCd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&
SavePath&dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&
SavePath&dbFileName&".bak.mdb;JetOLEDB;EncryptDatabase=True")
EndIf
'删除旧的数据库文件
callDeleteFile(SavePath&dbFileName)
'将压缩后的数据库文件还原
callRenameFile(SavePath&dbFileName&".bak.mdb",SavePath&dbFileName)
SetCd=False
CompactDatabase=True
EndIf
endfunction

PublicfunctionDbExists(byValdbPath)
'查找数据库文件是否存在
OnErrorresumeNext
Dimc
Setc=Server.CreateObject("ADODB.Connection")
c.Open"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&dbPath
IfErr.number<>0Then
Err.Clear
DbExists=false
else
DbExists=True
EndIf
setc=nothing
Endfunction

PublicfunctionAppPath()
'取当前真实路径
AppPath=Server.MapPath("./")
Endfunction

PublicfunctionAppName()
'取当前程序名称
AppName=Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME"),"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
EndFunction

PublicfunctionDeleteFile(filespec)
'删除一个文件
Dimfso
Setfso=CreateObject("Scripting.FileSystemObject")
IfErr.number<>0Then
Response.Write("删除文件发生错误!请查看错误信息
"&Err.number&"
"&Err.Description)
Err.Clear
DeleteFile=False
EndIf
callfso.DeleteFile(filespec)
Setfso=Nothing
DeleteFile=True
Endfunction

PublicfunctionRenameFile(filespec1,filespec2)
'修改一个文件
Dimfso
Setfso=CreateObject("Scripting.FileSystemObject")
IfErr.number<>0Then
Response.Write("修改文件名时发生错误!请查看错误信息
"&Err.number&"
"&Err.Description)
Err.Clear
RenameFile=False
EndIf
callfso.CopyFile(filespec1,filespec2,True)
callfso.DeleteFile(filespec1)
Setfso=Nothing
RenameFile=True
Endfunction

EndClass
%>