📄 cl_clscount.asp

📁 淘客网上商店网站程序淘客网上商店网站程序淘客网上商店网站程序
💻 ASP
字号:
<%
'==============================================
'创力统计处理类模块
'Copyright (C) 2005-2007 Aspoo.CN
'Email: Info@aspoo.cn   http://www.aspoo.cn
'Date：2005-6-18
'==============================================
'==============================================
'在线人数调用：
'Web_Online(0)	------(总在线人数)
'Web_Online(1)	------(在线用户人数)
'Web_Online(2)	------(在线游客人数)
'==============================================
'访问量调用：
'CountInfo(0,0) ------(开始统计时间)
'CountInfo(1,0) ------(今日访问量)
'CountInfo(2,0) ------(今日浏览量)
'CountInfo(3,0) ------(昨日访问量)
'CountInfo(4,0) ------(昨日浏览量)
'CountInfo(5,0) ------(总访问量)
'CountInfo(6,0) ------(总浏览量)
'CountInfo(7,0) ------(最高在线记录)
'CountInfo(8,0) ------(最高在线发生时间)
'==============================================

Class Cls_Count
	Public CountInfo, Web_Online
	Public CountDataBase,IsSqlDataBase_Count
	Public Browser,version,platform,IsSearch
	Public MaxOnline,MaxOnlineDate,Agent
	Public TotalOnline,UserOnline

	Private Sub Class_Initialize()
		Cl.Get_WebSetting
		Cl.ChkUserLogin
		IsSqlDataBase_Count=0    rem 如果是SQL数据库，请改为1
		TotalOnline = 0  rem 增加总在线人数
		UserOnline = 0  rem 增加在线用户人数
		Cl.Name="CountInfo"
		If Cl.ObjIsEmpty() Then LoadCountInfo
		CountInfo=Cl.Value
		Cl.Name="Web_Online"
		Cl.Reloadtime	= 60
		If Cl.ObjIsEmpty() Then RefreshOnlineNum
		Web_Online		= Split(Cl.Value,"||")
		Web_Online(0)	= Clng(Web_Online(0))
		Web_Online(1)	= Clng(Web_Online(1))
		Web_Online(2)	= Clng(Web_Online(2))
		If Web_Online(0) < 0  Or Web_Online(1) < 0 or Web_Online(2) < 0 Or Web_Online(1) > Web_Online(0) or (Web_Online(1)+Web_Online(2))<>Web_Online(0) Then RefreshOnlineNum
		Cl.Reloadtime=14400
		Browser = "unknown" : Version  = "unknown"
		Platform= "unknown" : IsSearch = False
	End Sub

	Public Sub ActiveOnline()
		Dim RefreshPageLastTime,strScriptName
		RefreshPageLastTime = Session(Cl.CacheName & "UserID")(1)
		strScriptName = Trim(Session(Cl.CacheName & "UserID")(3))
		If Not IsDate(RefreshPageLastTime) Then RefreshPageLastTime = Now()
		'当在120秒内刷新同一个页面则不更新数据
		If DateDiff("s",RefreshPageLastTime,Now()) < 120 And strScriptName = Trim(Get_ScriptName) Then Exit Sub
		'更新数组
		RefreshPageLastTime		= Session(Cl.CacheName & "UserID")
		RefreshPageLastTime(1)	= Now()
		RefreshPageLastTime(3)	= Get_ScriptName
		Session(Cl.CacheName & "UserID") = RefreshPageLastTime
		UserActiveOnline
	End Sub

	Private Sub UserActiveOnline()
		Dim Actcome,SQl,Rs
		Dim uip,StatsStr
		uip = Cl.UserTrueIP
		StatsStr=Left(Get_ScriptName,250)
		ConnectionCount
		Agent=Request.ServerVariables("HTTP_USER_AGENT")
		If Cl.UserID = 0 or Cl.UserGroupID=5 Then
			Dim StatUserID
			StatUserID = Session(Cl.CacheName & "UserID")(0)
			SQL = "Select ID,Username From [Cl_Online] Where ID = " & Ccur(StatUserID)
			Set Rs = Conn_Count.Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				If ChkIsSearch(Agent) Then Exit Sub '不记录搜索引擎的客人
				SQL = "Insert Into [Cl_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,NowPage,Agent,Stats,UserGroupID) Values (" & StatUserID & ",'游客','游客','" & Cl.UserTrueIP & "','" & Now & "','" & Now & "','" & Cl.CheckStr(StatsStr) & "','" & Cl.CheckStr(Agent) & "','" & Cl.CheckStr(StatsStr) & "',5)"
				'更新缓存在线数据
				Web_Online(0)=Web_Online(0)+1
				Web_Online(2)=Web_Online(2)+1
				Cl.Name="Web_Online"
				Cl.value=Web_Online(0)&"||"&Web_Online(1)&"||"&Web_Online(2)
			Else
				SQL = "Update [Cl_Online] Set Lastimebk = '" & Now & "',NowPage = '" & Cl.CheckStr(StatsStr) & "',Stats = '" & Cl.CheckStr(StatsStr) & "' Where ID = " & Ccur(StatUserID)
			End If
			Set Rs = Nothing
			Conn_Count.Execute(SQL)
		Else
			SQL = "Select ID,Username From [Cl_Online] Where UserID = " & Cl.UserID
			Set Rs = Conn_Count.Execute(SQL)
			If Rs.Eof And Rs.Bof Then
				SQL = "Insert Into [Cl_Online](ID,Username,Userclass,Ip,Startime,Lastimebk,NowPage,Agent,Stats,UserGroupID,UserID) Values (" & Session.SessionID & ",'" & Cl.Membername & "','" & Cl.GetUserGroupName(Cl.UserGroupID) & "','" & Cl.UserTrueIP & "','" & Now & "','" & Now & "','" & Cl.CheckStr(StatsStr) & "','" & Cl.CheckStr(Agent) & "','" & Cl.CheckStr(StatsStr) & "'," & Cl.UserGroupID & "," & Cl.UserID & ")"
				'更新缓存在线数据
				Web_Online(0)=Web_Online(0)+1
				Web_Online(1)=Web_Online(1)+1
				Cl.Name="Web_Online"
				Cl.value=Web_Online(0)&"||"&Web_Online(1)&"||"&Web_Online(2)
			Else
				SQL = "Update [Cl_Online] Set Lastimebk = '" & Now & "',NowPage = '" & Cl.CheckStr(StatsStr) & "',Stats = '" & Cl.CheckStr(StatsStr) & "' Where UserID = " & Cl.UserID
			End If
			Rs.Close
			Set Rs = Nothing
			Conn_Count.Execute(SQL)
		End If
		RefreshKillIP  '更新访问量
		'更新在线峰值
		If Web_Online(0) > CLng(CountInfo(7,0)) Then
			Conn_Count.Execute("update [Cl_CountInfo] set Maxonline="&Web_Online(0)&",MaxonlineDate='"& Now &"'") 
			Cl.Name="CountInfo"
			LoadCountInfo
		End If
		Cl.SqlQueryNum = Cl.SqlQueryNum+1
		Rem 删除超时用户
		OnlineQuery
		Set Conn_Count=Nothing
	End Sub

	Public Sub GetBrowser(sAgent)
		Dim Tmpstr,i
		'sAgent="Opera/7.23 (X11; Linux i686; U)  [en]"	
		If Left(sAgent,7) ="Mozilla" Then '有此标识为浏览器
			sAgent=Split(sAgent,";")
			If InStr(sAgent(1),"MSIE")>0 Then
				Browser="Microsoft IE "
				version=Trim(Left(Replace(sAgent(1),"MSIE",""),6))
			ElseIf InStr(sAgent(4),"Netscape")>0 Then 
				Browser="Netscape "
				tmpstr=Split(sAgent(4),"/")
				version=tmpstr(UBound(tmpstr))
			ElseIf InStr(sAgent(4),"rv:")>0 Then
				Browser="Mozilla "
				tmpstr=Split(sAgent(4),":")
				version=tmpstr(UBound(tmpstr))
				If InStr(version,")") > 0 Then 
					tmpstr=Split(version,")")
					version=tmpstr(0)
				End If
			End If
			If UBound(sAgent)>2 Then
				platform = UserPlatForm(sAgent(2),sAgent(3),UBound(sAgent))
			Else
				platform = UserPlatForm(sAgent(2),"",UBound(sAgent))
			End If
		ElseIf Left(sAgent,5) ="Opera" Then 
			sAgent=Split(sAgent,"/")
			Browser="Mozilla "
			tmpstr=Split(sAgent(1)," ")
			version=tmpstr(0)
			If UBound(sAgent)>2 Then
				platform = UserPlatForm(sAgent(1),sAgent(3),UBound(sAgent))
			Else
				platform = UserPlatForm(sAgent(1),"",UBound(sAgent))
			End If
		Else
			'识别搜索引擎
			Dim botlist
			Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
			Botlist=split(Botlist,",")
			For i=0 to UBound(Botlist)
				If InStr(sAgent,Botlist(i))>0  Then 
					platform=Botlist(i)&"搜索器"
					Exit For
				End If
			Next 
		End If
		If version<>"unknown" Then 
			Dim Tmpstr1
			Tmpstr1=Trim(Replace(version,".",""))
			If Not IsNumeric(Tmpstr1) Then
				version="unknown"
			End If
		End If
	End Sub

    Public Function ChkIsSearch(sAgent)
		ChkIsSearch=False
		'识别搜索引擎
		Dim botlist,i
		Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
		Botlist=split(Botlist,",")
		For i=0 to UBound(Botlist)
			If InStr(sAgent,Botlist(i))>0  Then 
				ChkIsSearch=True
				Exit For
			End If
		Next 
	End Function

	Private Function UserPlatForm(UserAgent1,UserAgent2,UserAgentNum)
		If InStr(UserAgent1,"NT 5.2")>0 Then
			UserPlatForm="Windows 2003"
		ElseIf InStr(UserAgent1,"Windows CE")>0 Then
			UserPlatForm="Windows CE"
		ElseIf InStr(UserAgent1,"NT 5.1")>0 Then
			UserPlatForm="Windows XP"
		ElseIf InStr(UserAgent1,"NT 4.0")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"NT 5.0")>0 Then
			UserPlatForm="Windows 2000"
		ElseIf InStr(UserAgent1,"NT")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"9x")>0 Then
			UserPlatForm="Windows ME"
		ElseIf InStr(UserAgent1,"98")>0 Then
			UserPlatForm="Windows 98"
		ElseIf InStr(UserAgent1,"95")>0 Then
			UserPlatForm="Windows 95"
		ElseIf InStr(UserAgent1,"Win32")>0 Then
			UserPlatForm="Win32"
		ElseIf InStr(UserAgent1,"Linux")>0 Then
			UserPlatForm="Linux"
		ElseIf InStr(UserAgent1,"SunOS")>0 Then
			UserPlatForm="SunOS"
		ElseIf InStr(UserAgent1,"Mac")>0 Then
			UserPlatForm="Mac"
		ElseIf UserAgentNum>2 Then
			If InStr(UserAgent2,"NT 5.1")>0 Then UserPlatForm="Windows XP"
			If InStr(UserAgent2,"Linux")>0 Then UserPlatForm="Linux"
		End If
	End Function

	Public Sub OnlineQuery()
		Dim SQL,SQL1
		Dim TempNum,TempNum1
		Cl.Name="delOnline_time"
		If Cl.ObjIsEmpty() Then Cl.Value=Now()
		If DateDiff("s",Cl.Value,Now()) > Clng(Cl.Web_Setting(48))*10 Then
			Cl.Value=Now()
			ConnectionCount
			If IsSqlDataBase_Count = 1 Then
				SQL = "Delete From [Cl_Online] Where UserID=0 And Datediff(Mi, Lastimebk, Getdate()) > " & Clng(Cl.Web_Setting(48))
				SQL1 = "Delete From [Cl_Online] Where UserID>0 And Datediff(Mi, Lastimebk, Getdate()) > " & Clng(Cl.Web_Setting(48))
			Else
				SQL = "Delete From [Cl_Online] Where UserID=0 And Datediff('s', Lastimebk, '" & Now() & "') > " & Cl.Web_Setting(48) & "*60" 
				SQL1 = "Delete From [Cl_Online] Where UserID>0 And Datediff('s', Lastimebk, '" & Now() & "') > " & Cl.Web_Setting(48) & "*60"
			End If
			Conn_Count.Execute SQL,TempNum
			Conn_Count.Execute SQL1,TempNum1
			Cl.SqlQueryNum = Cl.SqlQueryNum + 2
			if TempNum>0 or TempNum1>0 then
				'如果删除客人数大于0
				If TempNum>0 Then
					Web_Online(0) = Web_Online(0) - TempNum
					Web_Online(2) = Web_Online(2) - TempNum
				End If
				'如果删除用户数大于0
				If TempNum1>0 Then
					Web_Online(0) = Web_Online(0) - TempNum1
					Web_Online(1) = Web_Online(1) - TempNum1
				End If
				Cl.Name="Web_Online"
				Cl.Value=Web_Online(0)&"||"&Web_Online(1)&"||"&Web_Online(2)
			end if
		End If
	End Sub

	Public Sub DelOnline(IsUser,sUID,sID)
		ConnectionCount
		Dim SQL,TempNum
		if IsUser=1 then
			if Not IsNumeric(sUID) then Exit Sub
			SQL = "Delete From [Cl_Online] Where UserID="&Clng(sUID)
		else
			if Not IsNumeric(sID) then Exit Sub
			SQL = "Delete From [Cl_Online] Where ID="&Ccur(sID)
		end if
		Conn_Count.Execute SQL,TempNum
		If TempNum>0 Then
			'更新缓存在线数据
			Web_Online(0) = Web_Online(0) - TempNum
			if IsUser=1 then
				Web_Online(1) = Web_Online(1) - TempNum
			else
				Web_Online(2) = Web_Online(2) - TempNum
			end if
			Cl.Name="Web_Online"
			Cl.Value=Web_Online(0)&"||"&Web_Online(1)&"||"&Web_Online(2)
		End If
		Set Conn_Count=Nothing
	End Sub
	'刷新在线数据缓存
	Public Sub RefreshOnlineNum
		ConnectionCount
		Dim Rs,str0,str1,str2
		Set Rs=Conn_Count.Execute("Select Count(*) From Cl_Online")
		str0=Rs(0) + TotalOnline
		Set Rs=Conn_Count.Execute("Select Count(*) From Cl_Online Where UserID>0")
		str1=Rs(0) + UserOnline
		Set Rs=Nothing:Set Conn_Count=Nothing
		str2=str0-str1
		Cl.Value=str0&"||"&str1&"||"&str2
		Cl.SqlQueryNum = Cl.SqlQueryNum+2
	End Sub
	Public Sub LoadCountInfo
		ConnectionCount
		Dim Rs
		Set Rs=Conn_Count.Execute("Select StartDate,ToDayNum,ToDayView,YesterDayNum,YesterDayView,TotalNum,TotalView,MaxOnline,MaxOnlineDate,LastVisitDate From Cl_CountInfo")
		if datediff("D",Rs("LastVisitDate"),now())>0 then
			Conn_Count.Execute("Update Cl_CountInfo set YesterDayNum=ToDayNum,YesterDayView=ToDayView,ToDayNum=0,ToDayView=0,LastVisitDate='"&Now&"'")
			Set Rs=Conn_Count.Execute("Select StartDate,ToDayNum,ToDayView,YesterDayNum,YesterDayView,TotalNum,TotalView,MaxOnline,MaxOnlineDate,LastVisitDate From Cl_CountInfo")
		end if
		Cl.Value=Rs.GetRows(1)
		Set Rs=Nothing:Set Conn_Count=Nothing
		Cl.SqlQueryNum = Cl.SqlQueryNum+1
	End Sub
	'更新浏览量
	Public Sub RefreshView()
		Conn_Count.Execute("Update Cl_CountInfo Set ToDayView=ToDayView+1,TotalView=TotalView+1")
		Cl.Name="CountInfo"
		CountInfo(2,0)=CountInfo(2,0)+1
		CountInfo(6,0)=CountInfo(6,0)+1
		Cl.Value=CountInfo
		'Set Conn_Count=Nothing
		Cl.SqlQueryNum = Cl.SqlQueryNum+1
	End Sub
	Public Sub RefreshVisit()
		Conn_Count.Execute("Update Cl_CountInfo Set ToDayNum=ToDayNum+1,ToDayView=ToDayView+1,TotalNum=TotalNum+1,TotalView=TotalView+1,LastVisitDate='"&now&"'")
		Cl.Name			= "CountInfo"
		CountInfo(1,0)	= CountInfo(1,0)+1
		CountInfo(2,0)	= CountInfo(2,0)+1
		CountInfo(5,0)	= CountInfo(5,0)+1
		CountInfo(6,0)	= CountInfo(6,0)+1
		Cl.Value		= CountInfo
		Cl.SqlQueryNum	= Cl.SqlQueryNum+1
	End Sub
	Public Sub RefreshKillIP()
		Cl.Name="KillVisitIP"
		if Cl.ObjIsEmpty() then
			Cl.Value="#"&Cl.UserTrueIP&"#"
			RefreshVisit
			Exit Sub
		end if
		if Instr(Cl.Value,"#"&Cl.UserTrueIP&"#")>0 then
			RefreshView   'IP已存在缓存列表，视为浏览
		else
			 'IP不存在缓存列表则更新缓存及访问量
			Cl.Value=VsaveIPS(Cl.Value) 
			RefreshVisit
		end if
	End Sub
	' 更新要保存的IP(修改阿江统计)
	function VsaveIPS(InIPS)
		VsaveIPS=left(InIPS,len(InIPS)-1)
		VsaveIPS=right(VsaveIPS,len(VsaveIPS)-1)
		Dim sInIPS
		sInIPS=split(VsaveIPS,"#")
		if ubound(sInIPS) < 50 then
			VsaveIPS="#" & VsaveIPS & "#" & Cl.UserTrueIP & "#"
		else
			VsaveIPS=replace("#" & VsaveIPS,"#" & sInIPS(0) & "#","#") & "#" & Cl.UserTrueIP & "#"
		end if
	end function
	Public Function Get_ScriptName()
		Get_ScriptName=Request.ServerVariables("HTTP_REFERER")
	End Function
	Public Sub ConnectionCount()
		if IsSqlDataBase_Count=1 then
			Db.ConnValue =  "Provider = Sqloledb; User ID = 登录用户; Password = 登录密码; Initial Catalog = 数据库名; Data Source = (local);"
		else
			Db.ConnValue="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(Cl.WebDir & DatabaseDir & "#Cl_Count.mdb")
		end if
		Set Conn_Count=Db.OpenConnection("统计数据库")
	End Sub
End Class
%>
⌨️ 快捷键说明

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