<html>
<head>
<title>数据库压缩程序</title>
</head>
<%
if session("admin") = "" and session("flag") = "" then
    response.write "   <br><br><br>"
    response.write "    <table align='center' width='300' border='1' cellpadding='0' cellspacing='0' bordercolor='#999999'>"
    response.write "      <tr bgcolor='#999999'> "
    response.write "        <td colspan='2' height='15'> "
    response.write "          <div align='center'><font color='#FFFFFF'>操作: 确认身份失败!</font></div>"
    response.write "        </td>"
    response.write "      </tr>"
    response.write "      <tr> "
    response.write "        <td colspan='2' height='23'> "
    response.write "          <div align='center'><br><br>"
    response.write "      非法登陆,您的操作已经被记录!!! <br><br>"
    response.write "        <a href='javascript:onclick=history.go(-1)'>返回</a>"        
    response.write "        <br><br></div></td>"
    response.write "      </tr>   </table>" 
    response.end
end if    
%>
<body bgcolor="#008000">
<div align="center"> 
  <p><font size="2"><font color="#FF0000"><b>++++++++++++++++++++压缩操作开始++++++++++++++++++++</b></font><br>
    <br>
  <font color="#FFFFFF">注意：由于本程序是通过FSO权限和JET引擎连接模式，因此可能导致数据库出错，请在压缩之前备份原始数据库，以防万一！<br>
    本程序在WIN98SE+PWS、WIN2000+IIS5.0、WINXP+IIS5.1上测试通过，我的ACCESS驱动是OFFICE2000的！如果您有什么问题，请和我联系</font><a href="mailto:xxyf5324@163.com"><font color="#FFFF00">web@gd126.com</font></a><font color="#FFFFFF"><br>
    另外就是由于数据库的压缩比例是根据数据库的内容来定的，所以可能压缩后的效果不太明显，这是正常的，因为在MSACCESS中也只能达到这种效果！在使用之前请确认你的服务器安装了ACCESS的最新驱动，因为在老的OFFICE版本中的ACCESS驱动存在一些问题，所以可能无法执行压缩，另外就是必须要有FSO（filesystemobject)权限，否则也会出错！</font>
    <font color="RED"><br>
    </font></font><font size="2"><br>
    <%

Const JET_3X = 4

Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath
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
       CompactDB = "您所指定的数据库, " & dbpath & ", 已经被压缩" & vbCrLf
Else
       CompactDB = "您所输入的数据库路径或名称未找到，请重试" & vbCrLf
End If

End Function
%></font></p></div>
<form name="xxyf" method="post" action="xxyf.asp">
  <div align="center"><font size="2" color="#FFFFFF">请输入您的数据库全称（包括扩展名，支持任何扩展名的ACCESS数据库，典型的如.MDB、.ASA、.ASP等等）</font><font size="2"><font color="#FFFFFF"><br>
    </font>
    <br>
    <input type="text" name="dbpath">
    <br>
    <br>
    <input type="checkbox" name="boolIs97" value="True">
    <font color="#FFFFFF">检查是否为ACCESS97数据库<br>
    (如果是ACCESS2000的数据库就无须选择)</font><br>
    <br>
    <input type="submit" name="submit" value="确认压缩">
    </font></div>
</form>
<div align="center"><font size="2">
  <%
Dim dbpath,boolIs97
dbpath = request("dbpath")
boolIs97 = request("boolIs97")

If dbpath <> "" Then
       dbpath = server.mappath(dbpath)
       response.write(CompactDB(dbpath,boolIs97))
End If
%>
  <br>
  <font color="#FF0000">
  +++++++++++++++++++++++++代码结束 +++++++++++++++++++++++++</font></font></div> 
