<%
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
申明
非源创博文中的内容均收集自网上，若有侵权之处，请及时联络，我会在第一时间内删除．再次说声抱歉!!!
博文欢迎转载，但请给出原文连接。
