苦寒竹

用asp代码实现ACCESS里面的： 工具->数据库使用工具->压缩和修复数据库

根据以下俩函数（过程）自己写个表单：

sub yasuo2()
'    call CompressData()
'    Sub CompressData()
    If Not IsObject(Conn) Then
        CheckData Conn,GetConnstr
    End If
    Set Conn = Nothing
    Dim DBPath
    DBPath = Server.MapPath(Request.Form("Data_Path"))
    Dim BoolIs97
    BoolIs97 = Request.Form("boolIs97")
    CompactDB DBPath,boolIs97
'End Sub
end sub
'=====================压缩参数=========================
Sub CompactDB(DBPath, boolIs97)
    On Error Resume Next
    Dim Fso, Engine, strDBPath,JET_3X
    strDBPath = Left(DBPath,InstrRev(DBPath,"\"))
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If Err.Number <> 0 Then
        Err.Clear()
    response.write "<div style=""color:#ff0000;"">当前站点可能不支持FSO组件，压缩操作跳过。</div>"
        Exit Sub
    End If
    If Fso.FileExists(DBPath) Then
            Fso.CopyFile DBPath,strDBPath & "CompactDBTemp.mdb"
            Set Engine = CreateObject("JRO.JetEngine")
            If BoolIs97 = "True" Then
                Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "CompactDBTemp.mdb", _
                "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "CompactDBTemp1.mdb;" _
                & "Jet OLEDB:Engine Type=" & JET_3X
            Else
                Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "CompactDBTemp.mdb", _
                "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "CompactDBTemp1.mdb"
            End If
        Fso.CopyFile strDBPath & "CompactDBTemp1.mdb",DBPath
        Fso.DeleteFile(strDBPath & "CompactDBTemp.mdb")
        Fso.DeleteFile(strDBPath & "CompactDBTemp1.mdb")
        Set Fso = nothing
        Set Engine = nothing
        If Err.Number <> 0 Then
            Err.Clear()
            response.write "<div style=""color:#ff0000;""><b>出错原因" & Err.Description & "操作,压缩操作跳过。</b></div>"
            Exit Sub
        End If
    response.write "<div style=""color:#ff0000;"">你的数据库, " & Replace(DBPath,"\","\\") & ", 已经压缩成功!</div>"
    Else
        response.write "<div style=""color:#ff0000;"">数据库名称或路径不正确. 请重试!</div>"
    End If
End Sub

来源：http://bbs.blueidea.com/thread-2873347-1-1.html

jsw0528

复制内容到剪贴板

代码:

'========================
'函数名：CompactDB
'作  用：压缩数据库
'参  数：dbpath --- 数据库(相对)路径
'========================
function CompactDB(dbpath)
        dim fso,strOldDB,strNewDB
        set fso = CreateObject("Scripting.FileSystemObject")
        strOldDB = Server.MapPath(dbpath)
        strNewDB = Server.MapPath("tempdb.bak")
        if fso.FileExists(strOldDB) then
                Set Engine = Server.CreateObject("JRO.JetEngine")
                strPvd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
                Engine.CompactDatabase strPvd & strOldDB , strPvd & strNewDB
                set Engine = nothing
                fso.DeleteFile strOldDB
                fso.MoveFile strNewDB, strOldDB
                set fso = nothing
        else
                Response.Cookies("msg") = "找不到指定的数据库文件"
                Response.Redirect("database.asp")
                set fso = nothing
                Response.End()
        End if
End function


'=========================================
'函数名：BackupDB
'作  用：备份数据库
'参  数：dbpath --- 数据库(相对)路径
'        bkdbpath --- 备份数据库(相对)路径
'=========================================
function BackupDB(dbpath,bkdbpath)
        dim fso,strDBpath,strbkDBpath
        set fso = CreateObject("Scripting.FileSystemObject")
        strDBpath = Server.MapPath(dbpath)
        strbkDBpath = Server.MapPath(bkdbpath)
        if fso.FileExists(strDBpath) then
                fso.CopyFile strDBpath , strbkDBpath
                Response.Cookies("msg") = "成功压缩＆备份数据库"
                Response.Redirect("database.asp")
                set fso = nothing
                Response.End()
        else
                Response.Cookies("msg") = "找不到指定的数据库文件"
                Response.Redirect("database.asp")
                set fso = nothing
                Response.End()
        End if
End function


'=========================================
'函数名：RestoreDB
'作  用：还原数据库
'参  数：bkdbpath --- 备份数据库(相对)路径
'        dbpath --- 数据库(相对)路径
'=========================================
function RestoreDB(bkdbpath,dbpath)
        dim fso,strDBpath,strbkDBpath
        set fso = CreateObject("Scripting.FileSystemObject")
        strbkDBpath = Server.MapPath(bkdbpath)
        strDBpath = Server.MapPath(dbpath)
        if fso.FileExists(strbkDBpath) then
                fso.CopyFile strbkDBpath , strDBpath
                Response.Cookies("msg") = "数据库已从备份 "& mid(bkdbpath,14) &" 中恢复"
                Response.Redirect("database.asp")
                set fso = nothing
                Response.End()
        else
                Response.Cookies("msg") = "找不到指定的备份文件"
                Response.Redirect("database.asp")
                set fso = nothing
                Response.End()
        End if
End function

jsw0528

怎么调用我写的这些函数，就不用说了吧

提示：压缩数据库前先关闭数据库连接