纯编码实现Access数据库的建立或压缩---中国男护士网

您现在的位置：中国男护士网 >> 考试频道 >> 计算机等级 >> 二级辅导 >> ACCESS >> 辅导 >> 正文

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

【注册男护士专用博客】

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

www.nanhushi.com 佚名不详

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

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
　　%>

分享到 :

文章录入：杜斌责任编辑：杜斌

上一篇文章：远程连接access数据库的方法

下一篇文章：设置在Access项目中检索的记录数

【字体：小大】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口】

联系信息

QQ:88236621
电话:15853773350
E-Mail:malenurse@163.com
免费发布招聘信息
做中国最专业男护士门户网站