纯编码实现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 (无法压缩，请检查错误信息pactDatabase(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.number
[Ctrl+A 全选 注:如需引入外部Js需刷新才能执行]