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

<% 
'#######以下是一个类文件，下面的注解是调用类的方法################################################ 
'# 注意：如果系统不支持建立Scripting.FileSystemObject对象，那么数据库压缩功能将无法使用 
'# Access 数据库类 
'# CreateDbFile 建立一个Access 数据库文件 
'# CompactDatabase 压缩一个Access 数据库文件 
'# 建立对象方法: 
'# Set a = New DatabaseTools 
'# by (萧寒雪) s.f. 
'######################################################################################### <!--more-->

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

现在已可以压缩有密码的数据库，代码如下，但是压缩之后的数据库密码就没有了！如何解决？

<%
Const JET_3X = 4

Function CompactDB(dbPath, boolIs97)
    Dim fso, Engine, strDBPath
    strDBPath = left(dbPath,instrrev(DBPath,"\"))
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(dbPath) Then    
        Set Engine = CreateObject("JRO.JetEngine")

        If boolIs97 = "True" Then
            Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
            "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='XXXXXXXX';Data Source=" & strDBPath & "temp.mdb;" _
            & "Jet OLEDB:Engine Type=" & JET_3X
        Else
        Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='XXXXXXXX';Data Source=" & dbpath, _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
        End If

        fso.CopyFile strDBPath & "temp.mdb",dbpath
        fso.DeleteFile(strDBPath & "temp.mdb")
        Set fso = nothing
        Set Engine = nothing

        CompactDB = "你的数据库, " & dbpath & ", 已经压缩成功!" & vbCrLf

    Else
        CompactDB = "数据库名称或路径不正确. 请重试!" & vbCrLf
    End If

End Function
%>