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

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