admin_cache.asp

正版创力4.1SQL商业版!!!ASP版。

<!--#include file="Inc/Const.asp"-->
<%
if Cint(Cl.Admin_Purview(0))<>1 then
	Cl.ShowErr("<br /><li>您无此操作权限！</li>")
end If

Dim Action
Action = Trim(Request("Action"))
Header
Select Case LCase(Action)
Case "load"
	Call LoadCache()
Case "show"
	Call ShowCache()
Case "del"
	Call DelCache()
Case Else
	Call ShowCacheList()
End Select
Footer

Sub DelCache()
	Dim tCacheName,sLen
	tCacheName	= Trim(Request("Name"))
	sLen		= Len(Cl.CacheName&"_day_")
	Application.Lock
	Application.Contents.Remove(tCacheName)
	If CStr(Left(tCacheName,sLen))=CStr(Cl.CacheName&"_day_") Then
	Application.Contents.Remove(tCacheName&"_-time")
	End if
	Application.unLock
	Call Cl.OutMsg(0,"恭喜您，缓存更新成功，请按确定返回！","Admin_Cache.asp")
End Sub

Sub ShowCache()
	Dim tCacheName,i
	tCacheName = Trim(Request("Name"))
	Response.Write "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' Class='border'>"
	Response.Write "<tr class='title'><td colspan='2'>缓存数据查看("&tCacheName&")</td></tr>"
	If IsObject(Application(tCacheName)) Then
		Response.write "<tr class='tdbg'><td colspan='2' align='center'>缓存数据为对像，暂不支持查看！</td></tr>"
	ElseIf IsArray(Application(tCacheName)) Then
		Dim Array2
		On Error Resume Next
		Array2 = UBound(Application(tCacheName),2)
		'On Error GoTo 0
		If Err.Number=0 Then
			Response.write "<tr class='tdbg'><td colspan='2' align='center'>缓存数据为多维，暂不支持查看！</td></tr>"
		Else
			On Error GoTo 0
			For i=0 To UBound(Application(tCacheName))
			Response.write "<tr class='tdbg'><td align='right'><b>数组("&i&")内容</b></td><td width='85%'>"
			If Len(Application(tCacheName)(i))<100 Then
			Response.write "<input typt='text' style='width:90%' value='"&Server.HtmlEnCode(Application(tCacheName)(i))&"' readonly='readonly' />"
			Else
			Response.write "<textarea style='width:90%;height:180px;' readonly='readonly'>"&Server.HtmlEnCode(Application(tCacheName)(i))&"</textarea>"
			End if
			Response.write "</td></tr>"
			Next
		End if
	Else
		Response.write "<tr class='tdbg'><td align='right'><b>缓存内容</b></td><td width='85%'>"
		If Len(Application(tCacheName))<100 Then
		Response.write "<input typt='text' style='width:90%' value='"&Server.HtmlEnCode(Application(tCacheName))&"' readonly='readonly' />"
		Else
		Response.write "<textarea style='width:90%;height:380px;' readonly='readonly'>"&Server.HtmlEnCode(Application(tCacheName))&"</textarea>"
		End If
		Response.write "</td></tr>"
	End if
	Response.Write "<tr class='tdbg'><td colspan='2' align='center'><input type='button' value=' 返 回 ' onclick='window.location.href=""Admin_Cache.asp"";'></td></tr>"
	Response.Write "<table>"
End Sub

Sub LoadCache()
	Dim cachelist,i,Cacheobj
	For Each Cacheobj in Application.Contents
		If CStr(Left(Cacheobj,Len(Cl.CacheName)+1))=CStr(Cl.CacheName&"_") Then	
			cachelist=cachelist & "," & Cacheobj
		End If
	Next
	Cachelist=split(cachelist,",")
	Response.Write "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' Class='border'>"
	If UBound(cachelist)>1 Then
	    Response.Write "<tr class='title'><td width='30'><b>序号</b></td><td><b>更新对象</b></td><td width='100'><b>状态</b></td></tr>"
		Application.Lock
		For i=1 to UBound(cachelist)
			Application.Contents.Remove(Cachelist(i))
			Response.Write "<tr class='tdbg'><td align='left'>" & i & "</td><td><font color='#FF6600'>"&cachelist(i)&"</font></td><td>完成</td></tr>"		
		Next
		Application.unLock
		Response.Write "<tr class='tdbg' align='center'><td colspan='3' align='center'>共更新了&nbsp;&nbsp;<font color='#FF6600'>"
		Response.Write UBound(cachelist)
		Response.Write "</font>&nbsp;&nbsp;个缓存对象</td></tr>"	
	Else
		Response.Write "<tr class='tdbg'><td colspan='3' align='center'>所有对象已经更新。</td></tr>"
	End If
	Response.Write "<tr class='tdbg'><td colspan='4' align='center'><input type='button' value=' 返 回 ' onclick='window.location.href=""Admin_Cache.asp"";'></td></tr>"
	Response.Write "<table>"
End Sub

Sub ShowCacheList()
	Dim cachelist,i,Cacheobj
	Dim DayList,TemplateList,OtherList
	Dim sLen
	sLen = Len(Cl.CacheName)
	For Each Cacheobj in Application.Contents
		If CStr(Left(Cacheobj,sLen+5))=CStr(Cl.CacheName&"_day_") Then
			If InStr(Cacheobj,"-time")=0 then
			DayList = DayList & "," & Cacheobj
			End if
		ElseIf CStr(Left(Cacheobj,sLen+10))=CStr(Cl.CacheName&"_template_") Then 
			TemplateList = TemplateList & "," & Cacheobj
		ElseIf CStr(Left(Cacheobj,sLen+1))=CStr(Cl.CacheName&"_") Then	
			OtherList = OtherList & "," & Cacheobj
		End If
	Next
	Response.Write "<table width='100%' border='0' align='center' cellpadding='0' cellspacing='1' Class='border'>"
	Response.Write "<tr class='title'>"
	Response.Write "<td width='50' align='center'><b>序号</b></td>"
	Response.Write "<td align='center'><b>缓存名称</b></td>"
	Response.Write "<td width='80' align='center'><b>属性</b></td>"
	Response.Write "<td width='100' align='center'><b>操作</b></td>"
	Response.Write "</tr>"
	Call GetCacheList(DayList,1)
	Call GetCacheList(TemplateList,2)
	Call GetCacheList(OtherList,3)
	Response.Write "<tr class='tdbg'><td colspan='4' align='center'><input type='button' value=' 更新所有缓存 ' onclick='window.location.href=""Admin_Cache.asp?Action=Load"";'></td></tr>"
	Response.Write "<table>"
End Sub

Sub GetCacheList(sList,sType)
	Dim i
	sList=Split(sList,",")
	If UBound(sList) > 1 Then
		Select Case sType
		Case 1
		Response.Write "<tr><td align='left' colspan='4' class='tdbg'><b>每日更新缓存列表("&UBound(sList)&" 个)</b></td></tr>"
		Case 2
		Response.Write "<tr><td align='left' colspan='4' class='tdbg'><b>模版缓存列表("&UBound(sList)&" 个)</b></td></tr>"
		Case Else
		Response.Write "<tr><td align='left' colspan='4' class='tdbg'><b>其它缓存列表("&UBound(sList)&" 个)</b></td></tr>"
		End Select
		For i=1 To UBound(sList)
		Response.Write "<tr class=""tdbg"" onMouseOut=""this.className='tdbg'"" onMouseOver=""this.className='tdbg2'""><td align='center'>" & i & "</td><td align='left'><font color='#FF6600'>"&sList(i)&"</font></td><td align='center'>"
		If IsObject(Application(sList(i))) then
			Response.Write "<font color='#ff0033'>对像</font>"
		ElseIf IsArray(Application(sList(i))) then
			Response.Write "<font color='#0000ff'>数组</font>"
		Else
			Response.Write "<font color='#000000'>字符</font>"
		End if
		Response.Write "</td><td align='center'>"
		If IsObject(Application(sList(i))) then
			Response.Write "<font color='#888888'>查看</font>"
		Else
			Dim Array2
			On Error Resume Next
			Array2 = UBound(Application(sList(i)),2)
			If Err.Number=0 Then
			Response.Write "<font color='#888888'>查看</font>"	
			Else
			Response.Write "<a href='Admin_Cache.asp?Action=Show&Name="&sList(i)&"'><font color='#0000ff'>查看</font></a>"
			End If
			Err.Clear
		End If
		Response.Write "&nbsp;&nbsp;<a href='Admin_Cache.asp?Action=Del&Name="&sList(i)&"'><font color='#ff0033'>更新</font></a>"
		Response.Write "</td></tr>"
		Next
	End If
End Sub
%>
<%
'<!--
'┌───────────────────────────────────────────────────────┐
'│														 │
'│		CreateLive CMS Version 4.0						 │
'│　　　　　　　　				Powered by Aspoo.CN	 	 │
'│　		　　　　　　　　　　						 │
'│　	邮箱: [e-mail]		[e-mail]　　	 │
'│		ＱＱ: 3315263				596197794			 │
'│		网站: www.aspoo.cn			www.aspoo.com		 │
'│		论坛: bbs.aspoo.cn			bbs.aspoo.com		 │
'│														 │
'│	Copyright (C) 2005-2007 Aspoo.CN All Rights Reserved.	 │
'└───────────────────────────────────────────────────────┘
'-->
%>