compact.asp

自由领域ASP+WAP同学录(V1.0)系统是一套仿ChinaRen的即可用电脑浏览又可以用手机访问的互动同学录单班级系统。这套系统同学录系统可以满足现在WAP普及的今天同学用手机上网交流的需求

<!--#include file=../../INC/txlconst.asp-->
<!--#include file=../../INC/txlfun.asp--><!--
<pre>
┌─ 自由领域ASP+WAP同学录系统 ─────────────────┐
│                                                               │
│  感谢你使用 自由领域ASP+WAP同学录系统(测试版）                │
│  使用本免费源码您必须遵守以下规定                             │
│    不得公开发表代码 不得用做商业用途，不得向其他使用者收费。  │
│                                                               │
│  使用时，请保留此段信息，谢谢配合                             │
│                                                               │
│                                       2004/12/19              │
│                                                               │
└────────────────  http://99167.jahee.com ───┘
</per>
-->
<%
Dim const_txl_HomeUrl
const_txl_HomeUrl = "../../"
%>
<!--#include file=../checkadmin.asp-->
<%
Call OpenDataBase
txl_SiteHead const_txlname&"- 管理员"
Call CloseDataBase
compact
SiteBottom
Response.End()
sub compact
%>
<br>
<table width="90%" border="0" cellspacing="0" cellpadding="0" align="center">
  <tr> 
    <td height="20"> <p> <a href=../help.htm><%=const_txlname%>管理系统</a> &gt;&gt; 
        <a href="../help.htm">管理首页</a>&gt;&gt;<a href="Compact.asp">在线压缩数据库</a><br>
      <%
	  if Request.QueryString("action")="compact" Then
	  	CompactDatabase	
	  Else
	  	if not fsolimit then
	  		call showspaceinfo
	  	end if
	  End If
	  
	  %>
      <p></p></td>
  </tr>
</table>
<%end sub%>
<%sub showspaceinfo
	%>
<table width=96% 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>"
		fsolimitstr=fsolimitstr&"<a href='compact.asp?action=compact'><font color=green>点击此处开始压缩数据库</font></a>"
	end if
	Response.Write(fsolimitstr)
end function

Function CompactDatabase
	Dim fs, Engine
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FileExists(Server.Mappath(const_txl_HomeUrl & const_AccessDatabase)) Then
		Application.Lock()
			application("SiteEnableFlag")=0
			application("SiteDisbledescription")="正在进行数据库压缩,暂停访问……"
		Application.UnLock()
		Response.Write "<p><br><br>压缩数据库开始，同学录暂停一切用户的前台操作......<br>"
		Set Engine = CreateObject("JRO.JetEngine")
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(const_txl_HomeUrl & const_AccessDatabase), "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.Mappath(const_txl_HomeUrl&const_AccessDatabase& ".temp")
		fs.CopyFile Server.Mappath(const_txl_HomeUrl & const_AccessDatabase & ".temp"),Server.Mappath(const_txl_HomeUrl & const_AccessDatabase)
		fs.DeleteFile(Server.Mappath(const_txl_HomeUrl & const_AccessDatabase & ".temp"))
		Set fs = Nothing
		Set Engine = nothing
		Application.Lock()
			application("SiteEnableFlag")=1
			application("SiteDisbledescription")=""
		Application.UnLock()
		Response.write "<p>压缩数据库完成..."
		Response.write "<p>同学录恢复正常访问..."
	Else
		Set fs = Nothing
		Response.Write "<p><br><br>数据库名称或路径不正确. 压缩失败!" & vbCrLf
	End If
End Function
%>