📄 count.asp

📁 淘客网上商店网站程序淘客网上商店网站程序淘客网上商店网站程序
💻 ASP
字号:
<!--#include file="Conn.asp"-->
<!--#Include File="Inc/Cl_ClsSysTem.asp"-->
<!--#Include File="Inc/Cl_ClsCount.asp"-->
<%
Dim Style
Dim XMLDoc,Node,ConfigFilePath
Dim XMLCache,NodeCache,ShowTemplate

Call Page_Load()
Call CloseAllObj()
If Not (XMLDoc Is Nothing) Then Set XMLDoc = Nothing

Sub Page_Load()
	Style=LCase(Request.QueryString("Style"))
	Select Case Style
	Case ""
		Call OutJs("参数错误，调用已中止！")
		Exit Sub
	Case "none"
		Set Count = New Cls_Count
		Count.ActiveOnline
		Set Count = Nothing
		Exit Sub
	Case "online"
		Set Count = New Cls_Count
		Count.ActiveOnline
		Set Count = Nothing
	End Select
	ConfigFilePath = Server.MapPath(InstallDir & DatabaseDir & "count.config")
	Set XmlDoc = Server.CreateObject("MSXML.DOMDocument")
	XmlDoc.Async = False
	If Not XmlDoc.load(ConfigFilePath) Then
		'XmlDoc.loadxml "<?xml version=""1.0"" encoding=""gb2312""?><Root/>"
		'XmlDoc.Save ConfigFilePath
		Call OutJs("数据不存在，调用已中止！")
		Exit Sub
	End If
	Set Node = XmlDoc.DocumentElement.SelectSingleNode("Item[@Style='"&Style&"']")
	If Node Is Nothing Then
		Call OutJs("数据不存在，调用已中止！")
		Exit Sub
	End If
	If Not IsObject(Application(Cl.CacheName & "_countlist")) Then
		Set XMLCache = Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLCache.appendChild(XMLCache.createElement("Root"))
		Application.Lock
		Set Application(Cl.CacheName & "_countlist") = XMLCache
		Application.UnLock
		Set XMLCache = Nothing
	End If
	Set XMLCache = Application(Cl.CacheName & "_countlist")
	Set NodeCache = XMLCache.DocumentElement.SelectSingleNode("Item[@Style='"&Style&"']")
	If NodeCache Is Nothing Then
		Call UpdateCountCache()
	Else
		Dim RefreshTime,LastTime
		RefreshTime = Cl.GetClng(Node.selectSingleNode("@RefreshTime").text)
		LastTime = Node.selectSingleNode("@LastTime").text
		If RefreshTime>0 and IsDate(LastTime) Then
			If CLng(Datediff("n",LastTime,now())) > RefreshTime Then
				Call UpdateCountCache()
			Else
				ShowTemplate = NodeCache.selectSingleNode("Show").text
			End If
		Else
			Call UpdateCountCache()
		End If
	End if
	Call OutJs(FixJs(ShowTemplate))
	'XMLCache.Save Server.MapPath(InstallDir & DatabaseDir & "count_temp.xml")
	Set XMLCache = Nothing
End Sub

Sub UpdateCountCache()
	Dim Attributes,ChildNode,createCDATASection
	Rem 取得处理过标签的模版
	ShowTemplate = GetShowTemplate
	Rem 更新最后时间
	Node.Attributes.getNamedItem("LastTime").Text = FormatDateTime(Now(),0)
	XmlDoc.Save ConfigFilePath
	If Not (NodeCache Is Nothing) Then
	XMLCache.DocumentElement.RemoveChild(NodeCache)
	End if
	Rem 创建节
	Set NodeCache = XMLCache.createNode(1,"Item","")
	Set Attributes = XMLCache.createAttribute("Style")
	Attributes.text = Node.getAttribute("Style")
	NodeCache.Attributes.setNamedItem(Attributes)
	Set ChildNode = XMLCache.createNode(1,"Show","")
	Set createCDATASection = XMLCache.createCDATASection(ShowTemplate)
	ChildNode.appendChild(createCDATASection)
	NodeCache.appendChild(ChildNode)
	XMLCache.documentElement.appendChild(NodeCache)
	Rem 更新缓存
	Application.Lock
	Set Application(Cl.CacheName & "_countlist") = XMLCache
	Application.UnLock
End Sub

Function GetShowTemplate()
	Dim StyleTemplate
	StyleTemplate = Node.selectSingleNode("Template").text
	Set Count = New Cls_Count
	On Error Resume Next
	Dim regEx,Matches,Match
	Dim TempValue,ArrayStr,DataStr
	Set regEx		= New RegExp
	regEx.IgnoreCase= True
	regEx.Global	= True
	regEx.Pattern	= "{\$.[^{\$}]*}"
	Set Matches		= regEx.Execute(StyleTemplate)
	For Each Match in Matches
		TempValue	= Match.Value
		TempValue	= Replace(TempValue,"{$","")
		TempValue	= Replace(TempValue,"}","")
		TempValue	= Replace(TempValue,"(",",")
		TempValue	= Replace(TempValue,")","")
		TempValue	= Replace(TempValue,Chr(34),"")
		ArrayStr	= Split(TempValue,",")
		Select Case LCase(ArrayStr(0))
		Case "online" 'Count.Web_Online(sType) 在线用户统计
			DataStr = Count.Web_Online(CLng(ArrayStr(1)))
		Case "visit" 'Count.CountInfo(sType,0) 访问量统计
			DataStr = Count.CountInfo(CLng(ArrayStr(1)),0)
		Case "modulecount" 'ModuleCount(sModuleID,sType)
			DataStr = ModuleCount(CLng(ArrayStr(1)),CLng(ArrayStr(2)))
		Case "channelcount" 'ChannelCount(sChannelID,sType)
			DataStr = ChannelCount(CLng(ArrayStr(1)),CLng(ArrayStr(2)))
		Case "usercount" 'UserCount(sType)
			DataStr = UserCount(CLng(ArrayStr(1)))
		Case "guestbookcount" 'GuestBookCount(sType)
			DataStr = GuestBookCount(CLng(ArrayStr(1)))
		Case Else
			DataStr = Match.Value
		End Select
		StyleTemplate = Replace(StyleTemplate,Match.Value,DataStr)
		ArrayStr	= Empty
		DataStr		= Empty
		TempValue	= Empty
	Next
	Set Count = Nothing
	GetShowTemplate = StyleTemplate
End Function
Rem 留言统计
Function GuestBookCount(sType)
	Dim rsCount
	Select Case sType
	Case 0 '留言总数
		Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest")
	Case 1 '已审
		Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest where Status=1")
	Case 2 '待审
		Set rsCount = Cl.Execute("select count(GuestID) from Cl_Guest where Status=0")
	Case 3 '回复总数
		Set rsCount = Cl.Execute("select count(GuestID) from Cl_GuestReply where Status=1")
	Case Else
		GuestBookCount= 0 : Exit Function
	End Select
	GuestBookCount = rsCount(0)
	rsCount.Close : Set rsCount = Nothing
End Function
Rem 用户统计
Function UserCount(sType)
	Dim rsCount
	Select Case sType
	Case 0
		Set rsCount = Cl.Execute_U("select Count(UserID) from " & Db.UserTable)
	Case 1
		Set rsCount = Cl.Execute_U("select Count(UserID) from " & Db.UserTable & " where "&Db.UserGroupID&" in (6,7)")
	Case Else
		UserCount= 0 : Exit Function
	End Select
	UserCount = rsCount(0)
	rsCount.Close : Set rsCount = Nothing
End Function
Rem 频道统计
Function ChannelCount(sChannelID,sType)
	Cl.Load_ChannelSetting(sChannelID)
	Dim rsCount,ModuleName
	Select Case CLng(Cl.Channel.selectSingleNode("@moduleid").text)
	Case 1 : ModuleName = "Article"
	Case 2 : ModuleName = "Soft"
	Case 3 : ModuleName = "Photo"
	Case 4 : ModuleName = "Movie"
	Case 5 : ModuleName = "Product"
	Case Else : ModuleCount = 0 : Exit Function
	End Select
	Select Case sType
	Case 0
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where ChannelID="&sChannelID&" and Deleted="&FalseType)
	Case 1
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where ChannelID="&sChannelID&" and Status=1 and Deleted="&FalseType)
	Case 2
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where ChannelID="&sChannelID&" and Status=0 and Deleted="&FalseType)
	Case 3 '===(3) 阅读
		Set rsCount = Cl.Execute("select sum(Hits) From Cl_"&ModuleName&" where ChannelID="&sChannelID&" ")
	Case 4 '===(4) 评论总数
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where ChannelID="&sChannelID&"")
	Case 5 '===(5) 已审评论
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where ChannelID="&sChannelID&" and Status=1")
	Case 6 '===(6) 待审评论
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where ChannelID="&sChannelID&" and Status=0")
	Case 7 '===(7) 专题总数
		Set rsCount = Cl.Execute("select count(SpecialID) from Cl_Special where ChannelID="&sChannelID&"")
	Case Else
		ChannelCount = 0 : Exit Function
	End Select
	ChannelCount = rsCount(0)
	rsCount.Close : Set rsCount = Nothing
End Function
Rem 模块统计
Function ModuleCount(sModuleID,sType)
	Dim rsCount,ModuleName
	Select Case sModuleID
	Case 1 : ModuleName = "Article"
	Case 2 : ModuleName = "Soft"
	Case 3 : ModuleName = "Photo"
	Case 4 : ModuleName = "Movie"
	Case 5 : ModuleName = "Product"
	Case Else : ModuleCount = 0 : Exit Function
	End Select
	Select Case sType
	Case 0
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where Deleted="&FalseType)
	Case 1
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where Status=1 and Deleted="&FalseType)
	Case 2
		Set rsCount = Cl.Execute("select count(InfoID) from Cl_"&ModuleName&" where Status=0 and Deleted="&FalseType)
	Case 3 '===(3) 阅读
		Set rsCount = Cl.Execute("select sum(Hits) From Cl_"&ModuleName)
	Case 4 '===(4) 评论总数
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment")
	Case 5 '===(5) 已审评论
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where Status=1")
	Case 6 '===(6) 待审评论
		Set rsCount = Cl.Execute("select count(CommentID) from Cl_Comment where Status=0")
	Case 7 '===(7) 专题总数
		Set rsCount = Cl.Execute("select count(SpecialID) from Cl_Special")
	Case Else
		ModuleCount = 0 : Exit Function
	End Select
	ModuleCount = rsCount(0)
	rsCount.Close : Set rsCount = Nothing
End Function

Function FixJs(ByVal Str)
	Str = Replace(Str,vbCrlf,"<br />")
	Str = Replace(Str,Chr(10),"<br />")
	Str = Replace(Str,Chr(13),"<br />")
	Str = Replace(Str,"'", "\'")
	FixJs = Str
End Function
Rem 输出JS
Sub OutJs(Str)
	Response.Write("document.write ('" & Str & "');")
End Sub

'==================================================
'CreateLive CMS Version 4.0
'							Powered by Aspoo.Net
'
'邮箱: support@aspoo.cn		Info@aspoo.cn
'ＱＱ: 3315263				596197794
'网站: www.aspoo.cn			www.aspoo.com
'论坛: bbs.aspoo.cn			bbs.aspoo.com
'
'Copyright (C) 2005-2007 Aspoo.Net All Rights Reserved.
'==================================================
%>
⌨️ 快捷键说明

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