<!--#include file=admin_sb.asp-->
<br><%
'====================================================================
' 请你保留这段说明，这并不会影响你的速度.   电脑交流:http://www.cnscu.cn
' 程序制作：横云			  掌上校园收倾心整理收集于互联网,感谢你的支持!
' 升级时间： 2008-2-5  		主页地址：HTTP://wap.cnscu.cn
' E-Mail: cnscu@126.com   	客服QQ:554904632 QQ群:30493504 QQ群2:46659883
'====================================================================
%> <table width="100%" border="0" cellspacing="0" cellpadding="0" align="center">
  <tr> 
    <td height="20">在线压缩数据库</a><br>
      <%
	  if Request("action")="compact" Then
		dim Dbpath,boolIs97 
		if request("boolIs97")<>"" then boolIs97=request("boolIs97") else boolIs97=true end if 
		if request("Dbpath")<>"" then Dbpath="../"&trim(request("Dbpath")) end if
		if Dbpath<>"" then
		Dbpath = server.mappath(Dbpath)
		response.write(CompactDatabase(Dbpath,boolIs97))
		else
		Response.Write("数据库地址不能为空")
		end if
	  Else
	  	if not fsolimit then
	  		call showspaceinfo
%>
<form name="pollform3sdx" method="post" action="admin_db_compact.asp">
  <input type="hidden" name="action" value=compact>

<table width="100%" height="1" border="0" align=center cellpadding="5" cellspacing="1" bgcolor="#336699" class="tableBorder"> 
<tr> 
<td bgcolor="#FFFFFF" class="forumrow">请输入数据库的相绝对路径:<br/>数据库： 
<input type="text" name="Dbpath" value=<%=const_AccessDatabase%>> 
  
<input name="submit3" type="submit" value="开始压缩"></td> 
</tr> 
<tr> 
<td bgcolor="#FFFFFF" class="forumrow"><input type="checkbox" name="boolIs97" value="True"> 
如果使用 Access 97 数据库请选择 (默认为 Access 2000 数据库)<br> 
<br>-------------------------------------------------------------------<br> 
注意：所有路径都是相对与程序空间根目录的相对路径 </td>  
</td> 
</tr><%
	  	end if
	  End If
	  
	  %>
      <p></p></td>
  </tr>
</table></form>
<%sub showspaceinfo
	%>
<table width=100% align="center">
        <tr> 
     </td>
        </tr>
      </table>
<%
end sub
function fsolimit()
	on error resume next
	fsolimit=false
	dim fsolimitstr,testfso
	Set testfso = CreateObject("Scripting.FileSystemObject") 
	if not isobject(testfso) then	'不支持FSO
		fsolimit=true
		fsolimitstr="注意：此功能需要FSO的支持，您现在使用的服务器<font color=""red"">不支持</font>该组件,所以该功能无法实现！"
	else
		fsolimit=false
		fsolimitstr="注意：此功能需要FSO的支持，您现在使用的服务器<font color=""green"">支持</font>该组件。<br><br>"
	end if
	Response.Write(fsolimitstr)
end function



	Function CompactDatabase(dbPath, boolIs97) 
	Dim fso, Engine, strDBPath,JET_3X 
	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 boolIs97 = "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 

	CompactDatabase = "你的数据库已经压缩成功!" & vbCrLf 

	Else 
		CompactDatabase = "数据库名称或路径不正确. 请重试!或用备份数据库压缩!" & vbCrLf 
	End If 

	End Function 
%>