?? acdatadispose.asp
字號:
<!--#include file="../../Config/Config.asp"-->
<%if session("AdminName")="" then
Response.redirect "/"&SysPath&""&ManageUrl&"/Login.asp"
Response.end
End if
YzShopCartDataPath="..\..\"&DatabasePath&"\" '數(shù)據(jù)庫路徑
YzShopCartDataName=request("YzShopCartDataName")
YzShopCartDataNameNew=request("YzShopCartDataNameNew")
Action=trim(request("Action"))
mdb="../../Config/AcData.asp"
Bkmdb="AcDataBk.asp"
%>
<html>
<head>
<title>管理數(shù)據(jù)庫</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="../../css/site.css" rel="stylesheet" type="text/css">
</head>
<body>
<div align="center">
<%
select case Action
case "Rename" '數(shù)據(jù)庫更名
call DataRename()
case "Backup" '數(shù)據(jù)庫備份
call DataBackup()
case "Restore" '數(shù)據(jù)庫恢復
call DataRestore()
case "Compress" '數(shù)據(jù)庫壓縮
call DataCompress()
case else
call main()
end select
if FoundErr=True then
call Error_Msg(ErrMsg)
end if
sub DataRename() '###數(shù)據(jù)庫更名
Founderr=False
if YzShopCartDataNameNew="" then
FoundErr=True
ErrMsg=ErrMsg+"<li>數(shù)據(jù)庫名稱不能為空!</li>"
end if
if YzShopCartDataName=YzShopCartDataNameNew then
FoundErr=True
ErrMsg=ErrMsg+"<li>數(shù)據(jù)庫名沒有任何改動！</li>"
end if
if FoundErr=True then
call Error_Msg(ErrMsg)
response.end
end if
if founderr=false then
Set fs=Server.CreateObject("Scripting.FileSystemObject")
fs.CopyFile Server.MapPath(""&YzShopCartDataPath&YzShopCartDataName&""),Server.MapPath(""&YzShopCartDataPath&YzShopCartDataNameNew&"")
Set TS1 = fs.CreateTextFile(Server.MapPath(""&mdb&""), True)
TS1.write "<"&chr(37)&"Dataname="&chr(34)&YzShopCartDataNameNew&chr(34)&chr(37)&">"
Set TS1 = Nothing
fs.DeleteFile Server.MapPath(""&YzShopCartDataPath&YzShopCartDataName&""),True
Set fs=nothing
call Succeed_Msg("成功將數(shù)據(jù)庫文件名 <font color=red>"&YzShopCartDataName&"</font> 改為 <font color=red>"&YzShopCartDataNameNew&"</font>!")
end if
end sub
sub DataRestore() '###數(shù)據(jù)庫恢復
dim backpath
Dbpath=request.form("Dbpath")
backpath=request.form("backpath")
if dbpath="" then
ErrMsg=ErrMsg+ "請輸入您要恢復成的數(shù)據(jù)庫全名"
call Error_Msg(ErrMsg)
response.end
else
Dbpath=server.mappath(Dbpath)
end if
backpath=server.mappath(backpath)
Set Fso=server.createobject("scripting.filesystemobject")
if fso.fileexists(dbpath) then
fso.copyfile Dbpath,Backpath
call Succeed_Msg( "恢復數(shù)據(jù)庫成功！")
else
ErrMsg=ErrMsg+ "備份目錄下無備份文件！"
call Error_Msg(ErrMsg)
response.end
end if
end sub
sub DataCompress() '###數(shù)據(jù)庫壓縮
dim dbpath,boolIs97
dbpath = request("dbpath")
boolIs97 = request("boolIs97")
If dbpath <> "" Then
dbpath = server.mappath(dbpath)
response.write(CompactDB(dbpath,boolIs97))
end if
end sub
'=====================壓縮參數(shù)=========================
Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath,JET_3X
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;Data Source=" & strDBPath & "temp.mdb;" _
& "Jet OLEDB:Engine Type=" & JET_3X
Else
Engine.Compactdatabase "Provider=Microsoft.Jet.OLEDB.4.0;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
call Succeed_Msg("數(shù)據(jù)庫, " & dbpath & ", 已經(jīng)壓縮成功!" )
Else
ErrMsg = ErrMsg+ "數(shù)據(jù)庫名稱或路徑不正確. 請重試!" & vbCrLf
call Error_Msg(ErrMsg)
End If
End Function
sub main()
ErrMsg=ErrMsg+ "數(shù)據(jù)庫操作錯誤！"
call Error_Msg(ErrMsg)
response.end
end sub
sub DataBackup() '###備份數(shù)劇庫
Dbpath=request.form("Dbpath")
Dbpath=server.mappath(Dbpath)
bkfolder=request.form("bkfolder")
bkdbname=request.form("bkdbname")
Set Fso=server.createobject("scripting.filesystemobject")
if fso.fileexists(dbpath) then
If CheckDir(bkfolder) = True Then
fso.copyfile dbpath,bkfolder& "\"& bkdbname
Set TS1 = fso.CreateTextFile(Server.MapPath(""&Bkmdb&""), True)
TS1.write "<"&chr(37)&"BackupName="&chr(34)&bkDBname&chr(34)&chr(37)&">"
Set TS1 = Nothing
else
MakeNewsDir bkfolder
fso.copyfile dbpath,bkfolder& "\"& bkdbname
Set TS1 = fso.CreateTextFile(Server.MapPath(""&Bkmdb&""), True)
TS1.write "<"&chr(37)&"BackupName="&chr(34)&bkDBname&chr(34)&chr(37)&">"
Set TS1 = Nothing
end if
call Succeed_Msg( "<li>數(shù)據(jù)庫備份成功，數(shù)據(jù)庫備份路徑為" &bkfolder& "\"& bkdbname)
else
ErrMsg=ErrMsg+"<li>沒有找到備份目錄!</li>"
call Error_Msg(ErrMsg)
response.end
end if
end sub
'------------------檢查某一目錄是否存在-------------------
Function CheckDir(FolderPath)
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso1 = CreateObject("Scripting.FileSystemObject")
If fso1.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso1 = nothing
End Function
'-------------根據(jù)指定名稱生成目錄-----------------------
Function MakeNewsDir(foldername)
dim f
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set f = fso1.CreateFolder(foldername)
MakeNewsDir = True
Set fso1 = nothing
End Function
dim errmsg,sucmsg
sub Error_Msg(ErrMsg)
response.write "<br><br><br><br><br><br><br><br>"& vbCrLf
response.write "<TITLE>錯誤報告！ Error Information</TITLE>"& vbCrLf
response.write "<META http-equiv=Content-Type content=""text/html; charset=gb2312"">"& vbCrLf
response.write "<LINK href=""../../css/site.css"" type=text/css rel=stylesheet>"& vbCrLf
response.write "<BR><BR>"& vbCrLf
response.write " <TABLE align=center bgColor=#DEDFDE cellpadding=""2"" cellspacing=""0"" border=0 style=""border: outset 2px;width:65%;"">"& vbCrLf
response.write " <TR> "& vbCrLf
response.write " <TD height=18 style=""FILTER: progid:DXImageTransform.Microsoft.Gradient(startColorStr='#294184', endColorStr='#A5CBF7', gradientType='1')""><b><font color=#FFFFFF>錯誤報告！ Error Information</FONT></b></td>"& vbCrLf
response.write " <TD align=right bgColor=#A5CBF7><a href=javascript:history.go(-1)><img src=""../images/close.gif"" width=""18"" height=""15"" border=0 align=""absmiddle""></a></td>"& vbCrLf
response.write " </tr>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD colSpan=2>"& vbCrLf
response.write " <FIELDSET><LEGEND accessKey=F align=left>產(chǎn)生錯誤的可能原因：</LEGEND>"& vbCrLf
response.write " <TABLE align=center cellSpacing=2 cellPadding=2 width=""90%"" border=0>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD>"&ErrMsg&"</TD>"& vbCrLf
response.write " </TD></TR>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD height=25 align=middle colSpan=2><BR><INPUT onclick=javascript:history.go(-1) type=submit value="" 確 定 "" name=submit class=""button""></TD></TR></TABLE></FIELDSET> "& vbCrLf
response.write " </TD></TR></TABLE></TD></TR></TABLE>"& vbCrLf
end sub
'********成功提示信息****************
sub Succeed_Msg(SucMsg)
response.write "<br><br><br><br><br><br><br><br>"& vbCrLf
response.write "<TITLE>成功信息！ Success Information</TITLE>"& vbCrLf
response.write "<META http-equiv=Content-Type content=""text/html; charset=gb2312"">"& vbCrLf
response.write "<LINK href=""../../css/site.css"" type=text/css rel=stylesheet>"& vbCrLf
response.write "<BR><BR>"& vbCrLf
response.write " <TABLE align=center bgColor=#DEDFDE cellpadding=""2"" cellspacing=""0"" border=0 style=""border: outset 2px;width:65%;"">"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " "& vbCrLf
response.write " <TD height=18 style=""FILTER: progid:DXImageTransform.Microsoft.Gradient(startColorStr='#102873', endColorStr='#A5CBF7', gradientType='1')""><b><font color=#FFFFFF>成功信息！ Success Information</FONT></b></td>"& vbCrLf
response.write " <TD align=right bgColor=#A5CBF7><a href=javascript:history.go(-1)><img src=""../images/close.gif"" width=""18"" height=""15"" border=0 align=""absmiddle""></a></td>"& vbCrLf
response.write " </tr>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD colSpan=2>"& vbCrLf
response.write " <FIELDSET><LEGEND accessKey=F align=left>操作成功！</LEGEND>"& vbCrLf
response.write " <TABLE align=center cellSpacing=2 cellPadding=2 width=""90%"" border=0>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD>"&SucMsg&"</TD>"& vbCrLf
response.write " </TD></TR>"& vbCrLf
response.write " <TR>"& vbCrLf
response.write " <TD height=25 align=middle colSpan=2><BR><INPUT onclick=javascript:location.href='"&Request.ServerVariables("HTTP_REFERER")&"' type=submit value="" 確 定 "" name=submit class=""button""></TD></TR></TABLE></FIELDSET> "& vbCrLf
response.write " </TD></TR></TABLE></TD></TR></TABLE><BR><BR>"& vbCrLf
end sub
%>
</div>
</body>
</html>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -