📄 db_compact.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../Inc/Session.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2006-2008 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New DB_BackUp
KSCls.Execute()
Set KSCls = Nothing
Class DB_BackUp
Private KSCMS
Private Sub Class_Initialize()
Set KSCMS=New CommonCls
End Sub
Private Sub Class_Terminate()
Call KSCMS.CloseConn()
Set KSCMS=Nothing
End Sub
Sub Execute()
If Not KSCMS.ReturnPowerResult(0, "KMCT20003") Then '检查压缩数据库的权限
Response.Write("<Script>parent.frames['BottomFrame'].location.href='javascript:history.back();';</script>")
Response.End
End If
Response.Write "<html>"
Response.Write "<head>"
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
Response.Write "<title>备份数据库</title>"
Response.Write "<link href=""../Inc/Admin_Style.CSS"" rel=""stylesheet"" type=""text/css"">"
Response.Write ("<body oncontextmenu=""return false;"" scroll=no>")
Response.Write "<table width=""100%"" border=""0"" cellspacing=""0"" cellpadding=""0"" class=""sortbutton"">"
Response.Write " <tr>"
Response.Write " <td height=""23"" align=""center""><strong>数据库压缩和修复管理</strong>"
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "</table>"
Response.Write "<table width=""100%"" height=""100%"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
Response.Write " <tr> "
Response.Write " <td align=""center"" valign=""top""> <br> <strong><br>"
Response.Write " </strong> <table width=""560"" border=""0"" cellpadding=""2"" cellspacing=""1"">"
Response.Write " <tr> "
Response.Write " <td height=""25"" align=""center""> "
if request("action")="Backup" then
if CompactDatabase(DBPath,Application("ConnStr"))=true then
Response.Write "<font color=green>主数据库压缩和修复成功!</font>"
else
Response.Write "<font color=red>操作失败!</font>"
end if
elseif Request("Action")="Backup1" then
if CompactCollectDatabase(CollectDBPath,Application("CollcetConnStr"))=true then
Response.Write "<font color=green>采集数据库压缩和修复成功!</font>"
else
Response.Write "<font color=red>操作失败!</font>"
end if
end if
Response.Write "</td>"
Response.Write " </tr>"
if Application("DataBaseType")=0 then
Response.Write " <tr> "
Response.Write " <form method=""post"" action=""?action=Backup"">"
Response.Write " <td> <fieldset>"
Response.Write " <legend>主数据库信息</legend>"
dim filesize:filesize=KSCMS.GetFieSize(server.mappath(DBPath))
dim ReclaimedSpace:ReclaimedSpace=CLng(conn.Properties("Jet OLEDB:Compact Reclaimed Space Amount").Value)
dim LocaleIdentifier:LocaleIdentifier=Conn.Properties("Locale Identifier").Value
Response.Write " <table width=""96%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""2"">"
Response.Write " <tr> "
Response.Write " <td width=""23%"" height=""22"" align=""right""><strong>数据库路径：</strong></td>"
Response.Write " <td width=""77%""><font color=#ff6600>" & server.mappath(DBPath) & "</font></td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>压缩前大小：</strong></td>"
Response.Write " <td height=""22"">" & FormatNumber(filesize, 0, False, False, True) & " 字节</td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>压缩后大小：</strong></td>"
Response.Write " <td height=""22"">" & FormatNumber(filesize - ReclaimedSpace, 0, False, False, True) & " 字节 (总计可以减少" & FormatNumber(ReclaimedSpace, 0, True, False, True)& " 字节)</td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>地区标识符：</strong></td>"
Response.Write " <td height=""22"">" & GetLocaleName(LocaleIdentifier) & "</td>"
Response.Write " </tr>"
Response.Write " </table>"
Response.Write " </fieldset>"
Response.Write " <table width=""100%"" border=""0"">"
Response.Write " <tr><td height=""50"" align=center>"
Response.Write " <input type=submit value=""开始压缩"">"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write " </table>"
Response.Write " </td>"
Response.Write " </form>"
Response.Write " </tr>"
end if
Response.Write " <tr> "
Response.Write " <form method=""post"" action=""?action=Backup1"">"
Response.Write " <td><br> <fieldset>"
Response.Write " <legend>采集数据库信息</legend>"
conn.close
Set conn = Server.CreateObject("ADODB.Connection")
conn.open Application("CollcetConnStr")
filesize=KSCMS.GetFieSize(server.mappath(CollectDBPath))
ReclaimedSpace=CLng(conn.Properties("Jet OLEDB:Compact Reclaimed Space Amount").Value)
LocaleIdentifier=Conn.Properties("Locale Identifier").Value
Response.Write " <table width=""96%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""2"">"
Response.Write " <tr> "
Response.Write " <td width=""23%"" height=""22"" align=""right""><strong>数据库路径：</strong></td>"
Response.Write " <td width=""77%""><font color=#ff6600>" & server.mappath(CollectDBPath) & "</font></td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>压缩前大小：</strong></td>"
Response.Write " <td height=""22"">" & FormatNumber(filesize, 0, False, False, True) & " 字节</td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>压缩后大小：</strong></td>"
Response.Write " <td height=""22"">" & FormatNumber(filesize - ReclaimedSpace, 0, False, False, True) & " 字节 (总计可以减少" & FormatNumber(ReclaimedSpace, 0, True, False, True)& " 字节)</td>"
Response.Write " </tr>"
Response.Write " <tr> "
Response.Write " <td height=""22"" align=""right""><strong>地区标识符：</strong></td>"
Response.Write " <td height=""22"">" & GetLocaleName(LocaleIdentifier) & "</td>"
Response.Write " </tr>"
Response.Write " </table>"
Response.Write " </fieldset>"
Response.Write " <table width=""100%"" border=""0"">"
Response.Write " <tr><td height=""50"" align=center>"
Response.Write " <input type=submit value=""开始压缩"">"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write " </table>"
Response.Write " </td>"
Response.Write " </form>"
Response.Write " </tr>"
Response.Write " </table>"
Response.Write " 说明：避免不可预测的错误发生，请在压缩之前备份原始数据库！"
Response.Write " </td>"
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "</body>"
Response.Write "</html>"
End Sub
'**********************************************************************
'函数名：CompactDatabase
'作用：压缩主数据库
'参数：DBPath--数据库位置,ConnStr---数据库连接字符串
'**********************************************************************
Public Function CompactDatabase(DBPath, ConnStr)
On Error Resume Next
Dim strTempFile, fso, jro, ver, strCon, strTo, LCID
Set fso = Server.CreateObject(KSCMS.GetConfig("FsoObjName"))
strTempFile = DBPath
strTempFile = Left(strTempFile, InStrRev(strTempFile, "\")) & fso.GetTempName
Set jro = Server.CreateObject("JRO.JetEngine")
LCID = Conn.Properties("Locale Identifier").Value
'关闭数据库
Conn.Close
strTo = "Provider=Microsoft.Jet.OLEDB.4.0; Locale Identifier=" & LCID & "; Data Source=" & Server.MapPath(strTempFile) & "; Jet OLEDB:Engine Type=" & ver
jro.CompactDatabase ConnStr, strTo
CompactDatabase = False
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
fso.DeleteFile Server.MapPath(DBPath)
fso.MoveFile Server.MapPath(strTempFile), Server.MapPath(DBPath)
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
CompactDatabase = True
End If
End If
Set jro = Nothing
Set fso = Nothing
'重新打开数据库
Conn.Open ConnStr
End Function
'**********************************************************************
'函数名：CompactDatabase
'作用：压缩采集数据库
'参数：DBPath--数据库位置,ConnStr---数据库连接字符串
'**********************************************************************
Public Function CompactCollectDatabase(DBPath, ConnStr)
On Error Resume Next
Dim strTempFile, fso, jro, ver, strCon, strTo, LCID
Set conn = Server.CreateObject("ADODB.Connection")
conn.open Application("CollcetConnStr")
Set fso = Server.CreateObject(KSCMS.GetConfig("FsoObjName"))
strTempFile = DBPath
strTempFile = Left(strTempFile, InStrRev(strTempFile, "\")) & fso.GetTempName
Set jro = Server.CreateObject("JRO.JetEngine")
LCID = Conn.Properties("Locale Identifier").Value
'关闭数据库
Conn.Close
strTo = "Provider=Microsoft.Jet.OLEDB.4.0; Locale Identifier=" & LCID & "; Data Source=" & Server.MapPath(strTempFile) & "; Jet OLEDB:Engine Type=" & ver
jro.CompactDatabase ConnStr, strTo
CompactCollectDatabase = False
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
fso.DeleteFile Server.MapPath(DBPath)
fso.MoveFile Server.MapPath(strTempFile), Server.MapPath(DBPath)
If Err Then
fso.DeleteFile Server.MapPath(strTempFile)
Else
CompactCollectDatabase = True
End If
End If
Set jro = Nothing
Set fso = Nothing
'重新打开数据库
Conn.Open ConnStr
End Function
'得到数据库的地区标识符
Function GetLocaleName(lcid)
Select Case lcid
Case 1033 GetLocaleName = "常规"
Case 2052 GetLocaleName = "中文标点"
Case 133124 GetLocaleName = "中文笔画"
Case 1028 GetLocaleName = "中文笔画(台湾)"
Case 197636 GetLocaleName = "中文拼音(台湾)"
Case 1050 GetLocaleName = "克罗地亚语"
Case 1029 GetLocaleName = "捷克语"
Case 1061 GetLocaleName = "爱沙尼亚语"
Case 1036 GetLocaleName = "法语"
Case 66615 GetLocaleName = "格鲁吉亚语(现代)"
Case 66567 GetLocaleName = "德语(电话簿)"
Case 1038 GetLocaleName = "匈牙利语"
Case 66574 GetLocaleName = "匈牙利语(技术术语)"
Case 1039 GetLocaleName = "冰岛语"
Case 1041 GetLocaleName = "日语"
Case 66577 GetLocaleName = "日语(Unicode)"
Case 1042 GetLocaleName = "韩语"
Case 66578 GetLocaleName = "韩语(Unicode)"
Case 1062 GetLocaleName = "拉脱维亚语"
Case 1036 GetLocaleName = "立陶宛语"
Case 1071 GetLocaleName = "FYRO 马其顿语"
Case 1044 GetLocaleName = "挪威语/丹麦语"
Case 1045 GetLocaleName = "波兰语"
Case 1048 GetLocaleName = "罗马尼亚语"
Case 1051 GetLocaleName = "斯洛伐克语"
Case 1060 GetLocaleName = "斯洛文尼亚语"
Case 1034 GetLocaleName = "西班牙语(传统)"
Case 3082 GetLocaleName = "西班牙语(西班牙)"
Case 1053 GetLocaleName = "瑞典语/芬兰语"
Case 1054 GetLocaleName = "泰国语"
Case 1055 GetLocaleName = "土耳其语"
Case 1058 GetLocaleName = "乌克兰语"
Case 1066 GetLocaleName = "越南语"
Case Else GetLocaleName = "未知"
End Select
End Function
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -