ASP備份數據庫和還原數據庫

<%
sub BackupSQL(db,bak) '备份SQL数据库
  dim sql,bkfolder,bkdbname
  bkdbname=Server.MapPath(bak)
  bkfolder=left(bkdbname,instrrev(bkdbname,"\"))
  If not CheckDir(bkfolder) Then
    response.write "目标路径不存在，请修正后再备份。"
    Exit Sub
  End if
  sql="backup database " &db& " to disk='" &bkdbname& "' with INIT" 
  Call ask.Execute(SQL)
  if Err.Number<>0 then
    response.write sql
    response.write "错误："&err.Descripting
  else
    response.write "数据备份成功！"
  end if
end sub



sub BackupAC(db,bak) '备份ACCESS数据库
        'On error resume next
        Dim fso,FileConnStr,Fileconn,Dbpath,bkfolder,bkdbname
        Dbpath=server.mappath(db)
        bkdbname=Server.MapPath(bak)
        bkfolder=left(bkdbname,instrrev(bkdbname,"\"))
        If CheckDir(bkfolder)=False Then
            response.write "目标路径 " &bkfolder& " 不存在，请修正后再备份。"
            Exit Sub
        End if    
        
        FileConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Dbpath
        Set Fileconn = Server.CreateObject("ADODB.Connection")
        Fileconn.open FileConnStr
        If Err Then
            Response.Write Err.Description
            Err.Clear
            Set Fileconn = Nothing
            Response.Write "要备份的文件并非合法的数据库。"
            Exit Sub
        Else
            Set Fileconn = Nothing
        End If
        Set Fso=server.createobject("scripting.filesystemobject")
        If Fso.fileexists(dbpath) then
            Fso.copyfile dbpath, bkdbname
            response.write "备份数据库成功，您备份的数据库文件为" & bak
        Else
            response.write "找不到您所需要备份的文件。"
        End if
end sub



sub Restore(bak,target) '恢复数据库
    dim fso,Dbpath,backpath,TestConn,targetdb,targetfolder
    if bak="" then
      response.write "请输入您要恢复成的数据库全名"    
    else
      Dbpath=server.mappath(bak)
    end if
    targetdb=server.mappath(target)
    targetfolder=left(targetdb,instrrev(targetdb,"\"))
    If not CheckDir(targetfolder) Then
        response.write "目标路径不存在，请修正后再恢复。"
        Exit Sub
    End if
    
    Set TestConn = Server.CreateObject("ADODB.Connection")
    'On Error Resume Next
    TestConn.open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Dbpath
    If Err Then
        Response.Write Err.Description
        Err.Clear
        Set TestConn = Nothing
        Response.Write "备份的文件并非合法的数据库。"
        Response.End 
    Else
        Set TestConn = Nothing
    End If
    Set Fso=server.createobject("scripting.filesystemobject")

    if fso.fileexists(dbpath) then
        fso.copyfile Dbpath, targetdb
        response.write "成功恢复数据库到：" & target
    else
        response.write "备份目录下并无您的备份文件！"    
    end if
end sub


sub Compact(bak,ac97) '压缩数据库
Dim dbPath, fso, Engine, strDBPath,JET_3X
dbPath=Server.MapPath(bak)
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(dbPath) Then
    fso.CopyFile dbpath,strDBPath & "temp.mdb"
    Set Engine = CreateObject("JRO.JetEngine")
    If ac97 = "True" Then
        Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb;" _
        & "Jet OLEDB:Engine Type=" & JET_3X
    Else
        Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb", _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp1.mdb"
    End If
    fso.CopyFile strDBPath & "temp1.mdb",dbpath
    fso.DeleteFile(strDBPath & "temp.mdb")
    fso.DeleteFile(strDBPath & "temp1.mdb")
    Set fso = nothing
    Set Engine = nothing
    Response.write "你的数据库, " & bak & ", 已经压缩成功!" & vbCrLf
Else
    Response.write "数据库名称或路径不正确. 请重试!" & vbCrLf
End If
end sub


Function CheckDir(FolderPath)  '检查某一目录是否存在
    dim fso1
    Set fso1 = Server.CreateObject(Script_FSO)
    If fso1.FolderExists(FolderPath) then
       '存在
       CheckDir = True
    Else
       '不存在
       CheckDir = False
    End if
    Set fso1 = nothing
End Function