纯编码实现Access数据库的建立或压缩!!
1
2'#######以下是一个类文件，下面的注解是调用类的方法################################################
3'# 注意：如果系统不支持建立Scripting.FileSystemObject对象，那么数据库压缩功能将无法使用
4'# Access 数据库类
5'# CreateDbFile 建立一个Access 数据库文件
6'# CompactDatabase 压缩一个Access 数据库文件
7'# 建立对象方法:
8'# Set a = New DatabaseTools
9'# by (萧寒雪) s.f.
10'#########################################################################################
11
12Class DatabaseTools
13
14Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
15'建立数据库文件
16'If DbVer is 0 Then Create Access97 dbFile
17'If DbVer is 1 Then Create Access2000 dbFile
18On error resume Next
19If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
20If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
21If DbExists(SavePath & dbFileName) Then
22Response.Write ("对不起，该数据库已经存在!")
23CreateDBfile = False
24Else
25Dim Ca
26Set Ca = Server.CreateObject("ADOX.Catalog")
27If Err.number<>0 Then
28Response.Write ("无法建立，请检查错误信息
<br/>
1" & Err.number & "
<br/>
1" & Err.Description)
2Err.Clear
3Exit function
4End If
5If DbVer=0 Then
6call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName)
7Else
8call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName)
9End If
10Set Ca = Nothing
11CreateDBfile = True
12End If
13End function
14
15Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)
16'压缩数据库文件
17'0 为access 97
18'1 为access 2000
19On Error resume next
20If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
21If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
22If DbExists(SavePath & dbFileName) Then
23Response.Write ("对不起，该数据库已经存在!")
24CompactDatabase = False
25Else
26Dim Cd
27Set Cd =Server.CreateObject("JRO.JetEngine")
28If Err.number<>0 Then
29Response.Write ("无法压缩，请检查错误信息
<br/>
1" & Err.number & "
<br/>
1" & Err.Description)
2Err.Clear
3Exit function
4End If
5If DbVer=0 Then
6call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data
7Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
8Else
9call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
10SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
11SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
12End If
13'删除旧的数据库文件
14call DeleteFile(SavePath & dbFileName)
15'将压缩后的数据库文件还原
16call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
17Set Cd = False
18CompactDatabase = True
19End If
20end function
21
22Public function DbExists(byVal dbPath)
23'查找数据库文件是否存在
24On Error resume Next
25Dim c
26Set c = Server.CreateObject("ADODB.Connection")
27c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
28If Err.number<>0 Then
29Err.Clear
30DbExists = false
31else
32DbExists = True
33End If
34set c = nothing
35End function
36
37Public function AppPath()
38'取当前真实路径
39AppPath = Server.MapPath("./")
40End function
41
42Public function AppName()
43'取当前程序名称
44AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
45End Function
46
47Public function DeleteFile(filespec)
48'删除一个文件
49Dim fso
50Set fso = CreateObject("Scripting.FileSystemObject")
51If Err.number<>0 Then
52Response.Write("删除文件发生错误!请查看错误信息
<br/>
1" & Err.number & "
<br/>
1" & Err.Description)
2Err.Clear
3DeleteFile = False
4End If
5call fso.DeleteFile(filespec)
6Set fso = Nothing
7DeleteFile = True
8End function
9
10Public function RenameFile(filespec1,filespec2)
11'修改一个文件
12Dim fso
13Set fso = CreateObject("Scripting.FileSystemObject")
14If Err.number<>0 Then
15Response.Write("修改文件名时发生错误!请查看错误信息
<br/>
1" & Err.number & "
<br/>
1" & Err.Description)
2Err.Clear
3RenameFile = False
4End If
5call fso.CopyFile(filespec1,filespec2,True)
6call fso.DeleteFile(filespec1)
7Set fso = Nothing
8RenameFile = True
9End function
10
11End Class