📄 database_compact.asp

📁 一个很好的asp cms管理系统
💻 ASP
字号:
<%
Option Explicit
'----------------------------------------------------------------------------------
'本页:
'   数据库管理页面
'说明:
'
'----------------------------------------------------------------------------------
%>
<!--#include file="inc/Config.class.asp"-->
<!--#include file="inc/DBControl.class.asp"-->
<!--#include file="inc/FunctionLib.class.asp"-->
<!--#include file="inc/Manager.class.asp"-->
<!--#include file="inc/Template.class.asp"-->
<%
Dim Cfg, Db, FLib, Tpl, Admin
Set Cfg = New Config
Set Db = New DBControl
Set FLib = New FunctionLib
Set Admin = New Manager
Set Tpl = New TemplateEngine

If Not Admin.Logined Then
    FLib.Alert "对不起，你已经超时或未登录","./",1
    Response.End
End If

If Not Admin.CheckPopedom("TSYS_GROUP3_DB") Then
    FLib.Alert "权限不足", "BACK", 0
    Response.End
ENd If

Dim Work
    Work = Request("Work")

Db.Open()
%>
<html>
<head>
<title></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="inc/style.css" type="text/css">
<SCRIPT LANGUAGE="JavaScript" src="inc/FunctionLib.js"></script>
</head>

<body>
<%
Select Case Work
    Case "DoCompact"
        DoCompact()
    Case "BakDB"
        BakDB()
    Case "DoBakDB"
        DoBakDB()
    Case "ExeCuteSql"
        ExeCuteSql()
    Case "DoExeCuteSql"
        DoExeCuteSql()
    Case Else
        CompactDB()
End Select
%>
<%
Function CompactDB()
%>
<table width="100%" border="0" cellspacing="0" cellpadding="0" class="tabTitleBar">
  <tr> 
    <td>系统管理 &gt; 压缩数据库</td>
  </tr>
</table>
<table width="100%" border="0" cellpadding="3" cellspacing="1" class="ContentTabBg">
  <tr> 
    <td height="105" align="center" class="BarTitle"><form name="form1" method="post" action="?">
        <table width="700" border="0" cellpadding="3" cellspacing="0">
          <tr> 
            <td height="32" align="center" class="BarText">定期对Access数据进行压缩操作,可以极大地减小库文件大小,提高数据读取性能...<br>
              建意在压缩数据库前对数据库进行一次<a href="?Work=BakDB">备份</a>！</td>
          </tr>
          <tr> 
            <td align="center"><input name="Submit" type="submit" class="input_button" value="确  定"> 
              <input name="Submit3" type="button" class="input_button" value="返  回" onClick="window.history.back();"> 
              <input name="Work" type="hidden" id="Work4" value="DoCompact"> </td>
          </tr>
        </table>
      </form></td>
  </tr>
</table>
<%
End Function

Function BakDB()
%>
<table width="100%" border="0" cellspacing="0" cellpadding="0" class="tabTitleBar">
  <tr> 
    <td>系统管理 &gt; 备份数据库</td>
  </tr>
</table>
<table width="100%" border="0" cellpadding="3" cellspacing="1" class="ContentTabBg">
  <tr> 
    <td height="105" align="center" bgcolor="#F6f6f6"><form action="?" method="post" name="form2" id="form2">
        <table width="700" border="0" cellpadding="3" cellspacing="0">
          <tr> 
            <td height="27" align="center" class="BarText">数据库&quot;<%=Cfg.DataBase_FilePath%>&quot;将备份至与当前库相同的目录下</td>
          </tr>
          <tr> 
            <td align="center"><input name="Submit2" type="submit" class="input_button" value="确  定"> 
              <input name="Submit32" type="button" class="input_button" value="返  回" onClick="window.history.back();"> 
              <input name="Work" type="hidden" id="Work22" value="DoBakDB"> </td>
          </tr>
        </table>
      </form></td>
  </tr>
</table>
<%
End Function

Function ExeCuteSql()
%>
<table width="100%" border="0" cellspacing="0" cellpadding="0" class="tabTitleBar">
  <tr> 
    <td>系统管理 &gt; 执行Sql脚本</td>
  </tr>
</table>
<table width="100%" border="0" cellpadding="3" cellspacing="1" class="ContentTabBg">
  <tr> 
    <td height="105" align="center" bgcolor="#F6f6f6" class="BarTitle"><form action="?" method="post" name="form4" id="form4">
        <table width="700" border="0" cellpadding="3" cellspacing="0">
          <tr> 
            <td height="16" class="BarText">注：Access类型数据库一次只允许执行一条Sql语句</td>
          </tr>
          <tr> 
            <td height="300" align="center" valign="top"> <textarea name="content" wrap="OFF" class="input_text" id="Content" style="width:100%;height:100%"></textarea> 
            </td>
          </tr>
          <tr> 
            <td align="center"><input name="Submit4" type="submit" class="input_button" value="确  定"> 
              <input name="Submit22" type="reset" class="input_button" value="还  原"> 
              <input name="Submit34" type="button" class="input_button" value="返  回" onClick="window.history.back();"> 
              <input name="Work" type="hidden" id="Work" value="DoExeCuteSql"> 
            </td>
          </tr>
        </table>
      </form></td>
  </tr>
</table>
<%End Function%>
</body>
</html>
<%
'//压缩数据库
Sub DoCompact()
    Dim TargetDB, ResourceDB
    Dim oJetEngine
    Dim Fso
    Const Jet_Conn_Partial = "Provider=Microsoft.Jet.OLEDB.4.0; Data source="
    Set oJetEngine = Server.CreateObject("JRO.JetEngine")
    Set Fso = Server.CreateObject(Cfg.FileSystemObject_Name)

    Db.Close()
    ResourceDB = Cfg.DataBase_FilePath

    If Fso.FileExists(ResourceDB) Then
        '建立临时文件
        TargetDB = ResourceDB &".tmp"
        If Fso.FileExists(TargetDB) Then
            Fso.DeleteFile(TargetDB)
        End If

        oJetEngine.CompactDatabase Jet_Conn_Partial & ResourceDB, Jet_Conn_Partial & TargetDB
        Fso.DeleteFile ResourceDB
        Fso.MoveFile TargetDB, ResourceDB

    End If

    Set Fso = Nothing
    Set oJetEngine = Nothing

    Db.Open()
    FLib.AddLog "压缩数据库"
    Db.Close()

    FLib.Alert "执行完毕", "BACK", 0
    Response.End
End Sub

'//备份数据库
Sub DoBakDB()

    Dim TargetDB,ResourceDB
    Dim Fso
    Set Fso= Server.CreateObject(Cfg.FileSystemObject_Name)
    '关闭数据库链接
    Db.Close()

    ResourceDB = Cfg.DataBase_FilePath
    If Fso.FileExists(ResourceDB) Then
        '原数据库文是否存在
        If Fso.FileExists(ResourceDB) Then
            '建立原备份文件
            TargetDB = ResourceDB & ".bak"
            Fso.CopyFile ResourceDB, TargetDB, True
        End If
    End If

    Db.Open()
    FLib.AddLog "备份数据库"
    Db.Close()

    FLib.Alert "执行完毕", "BACK", 0
    Response.End
End Sub

'////////////////////////////
'//执行Sql操作
Sub DoExeCuteSql()

    Dim content
    content = Request("content")

    '    On Error Resume Next

    Db.Conn.BeginTrans
    Db.ExeCute(content)
    If Err.Number<>0 Then
        Db.Conn.Rollback
        FLib.Alert "执行失败！", "BACK", 0
    Else
        Db.Conn.CommitTrans
        FLib.Alert "执行成功！", "BACK", 0
    End If

    FLib.AddLog "执行Sql脚本：" & content
    Response.End
End Sub
%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -