具体见下：
Class DatabaseTools
　　　　Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
　　　　　　　　　' 建立数据库文件:DbVer为0创建Access97 数据库,为1则创建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
%>