爱站内页反链
爱站首页反链
神马是否收录
360网站安全检测
搜狗是否收录
360是否收录
百度是否收录
百度年收录
网站年龄
百度安全
百度查询
导出链接
网站ip查询
网站ICP备案批量查询
搜狗快照
百度快照
百度反链批量查询
搜狗PR批量查询
谷歌PR批量查询
神马权重批量查询
360移动权重批量查询
站长移动权重批量查询
爱站移动权重批量查询
360权重查询
站长PC权重批量查询
爱站PC权重批量查询
搜狗总收录批量查询
360日收录批量查询
360总收录批量查询
百度月收录批量查询
百度周收录批量查询
百度日收录批量查询
百度网站收录批量查询
获取网站IP
获取网站描述
获取网站关键词
获取网站标题
HTTP状态码
搜狗权重
搜狗反链
神马总收录
百度预计流量
ALEXA排名
360反链
当前位置
博文首页
> 纯编码实现Access数据库的建立或压缩
最大化
缩小
纯编码实现Access数据库的建立或压缩
作者:admin
时间:2021-08-28 18:52
<% '#######以下是一个类文件,下面的注解是调用类的方法################################################ '# 注意:如果系统不支持建立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 %>
[Ctrl+A 全选 注:引入外部Js需再刷新一下页面才能执行]
jsjbwy
上一篇:
用XML+FSO+JS实现服务器端文件的选择效果
下一篇:没有了
立即下载 - IIS7 站长工具包
最新
更多<<
纯编码实现Access数据库的建立或压缩
用XML+FSO+JS实现服务器端文件的选择效果
FMC_WBL的博客:操作系统核心之 处理器管理
同一个帐号不能同时登陆的问题
跨越fso、wsh、 application写文件
FMC_WBL的博客:操作系统核心之 作业管理与设备管理
用ASP设计购物推车
ASP中Web页面间的数据传递方式
ASP得到文件的大小类型最后修改时间
FMC_WBL的博客:数据通信之信道与编码
FMC_WBL的博客:计算机网络之通信编码与网络通信模型
FMC_WBL的博客:Java核心技术之什么是反射
FMC_WBL的博客:Java核心技术之 深入理解注解(Annotation)
FMC_WBL的博客:Java核心技术之面向对象
FMC_WBL的博客:Java核心技术之stream详解+Java8及以后的新特性
FMC_WBL的博客:Java核心技术之核心类的使用(Spring Guava Stri
FMC_WBL的博客:LeetCodet283.移动零
FMC_WBL的博客:LeetCode70.爬楼梯
FMC_WBL的博客:LeetCode15.三数之和
FMC_WBL的博客:LeetCode141.环形链表
FMC_WBL的博客:LeetCode206.反转链表
FMC_WBL的博客:LeetCode24. 两两交换链表中的节点
FMC_WBL的博客:LeetCode142.环形链表II
FMC_WBL的博客:LeetCode25. K 个一组翻转链表
FMC_WBL的博客:LeetCode26.删除排序数组中的重复项
FMC_WBL的博客:LeetCode1122. 数组的相对排序(20201114每日一题
FMC_WBL的博客:LeetCode189.旋转数组
FMC_WBL的博客:LeetCode21. 合并两个有序链表
FMC_WBL的博客:LeetCode452. 用最少数量的箭引爆气球(20201123
梦想橡皮擦,专栏100例写作模式先行者:28分钟完成一款Python游
推荐
更多<<
立志欲坚不欲锐,成功在久不在速度:Error: Request failed with
Centos7 yum安装git服务器
码农小胖哥:Java开发中POJO和JSON互转时如何忽略隐藏字段