1
2'#######以下是一个类文件，下面的注解是调用类的方法
3'# 注意：如果系统不支持建立Scripting.FileSystemObject对象，
4那么数据库压缩功能将无法使用
5'# Access 数据库类
6'# CreateDbFile 建立一个Access 数据库文件
7'# CompactDatabase 压缩一个Access 数据库文件
8'# 建立对象方法:
9'# Set a = New DatabaseTools
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
7Source=" & SavePath &
8dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" &
9SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
10Else
11call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data
12Source=" & SavePath &
13dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath
14& dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
15End If
16'删除旧的数据库文件
17call DeleteFile(SavePath & dbFileName)
18'将压缩后的数据库文件还原
19call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
20Set Cd = False
21CompactDatabase = True
22End If
23end function
24
25Public function DbExists(byVal dbPath)
26'查找数据库文件是否存在
27On Error resume Next
28Dim c
29Set c = Server.CreateObject("ADODB.Connection")
30c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
31If Err.number<>0 Then
32Err.Clear
33DbExists = false
34else
35DbExists = True
36End If
37set c = nothing
38End function
39
40Public function AppPath()
41'取当前真实路径
42AppPath = Server.MapPath("./")
43End function
44
45Public function AppName()
46'取当前程序名称
47AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
48End Function
49
50Public function DeleteFile(filespec)
51'删除一个文件
52Dim fso
53Set fso = CreateObject("Scripting.FileSystemObject")
54If Err.number<>0 Then
55Response.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