<%
'==============================================
'创力统计处理类模块
'Copyright (c) 2005 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

	Private Sub Class_Initialize()
		Cl.GetWeb_Setting
		Cl.ChkUserLogin
		IsSqlDataBase_Count=0    rem 如果是SQL数据库，请改为1

		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.UserLevel=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,UserLevel) Values (" & StatUserID & ",'游客','游客','" & Cl.UserTrueIP & "','" & Now & "','" & Now & "','" & StatsStr & "','" & Agent & "','" & 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 = '" & StatsStr & "',Stats = '" & 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,UserLevel,UserID) Values (" & Session.SessionID & ",'" & Cl.Membername & "','" & Cl.GetUserGroupName(Cl.UserLevel) & "','" & Cl.UserTrueIP & "','" & Now & "','" & Now & "','" & StatsStr & "','" & Agent & "','" & StatsStr & "'," & Cl.UserLevel & "," & 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 = '" & StatsStr & "',Stats = '" & 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
		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

	'IP/来源
	Public Function address(sip)
		Dim aConnStr,aConn
		Dim str1,str2,str3,str4
		Dim  num
		Dim country,city
		Dim irs,SQL
		address="未知"
		If IsNumeric(Left(sip,2)) Then
			If sip="127.0.0.1" Then sip="192.168.0.1"
			str1=Left(sip,InStr(sip,".")-1)
			sip=mid(sip,instr(sip,".")+1)
			str2=Left(sip,instr(sip,".")-1)
			sip=Mid(sip,InStr(sip,".")+1)
			str3=Left(sip,instr(sip,".")-1)
			str4=Mid(sip,instr(sip,".")+1)
			If isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 Then
			Else		
				num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
				Db.ConnValue="Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(Cl.IPDataBase)
				Set AConn=Db.OpenConnection("IP数据库")
				country="亚洲"
				city=""
				sql="select top 1 country,city from Cl_address where ip1 <="&num&" and ip2 >="&num&""
				Set irs=aConn.execute(sql)
				If Not(irs.EOF And irs.bof) Then
					country=irs(0)
					city=irs(1)
				End If
				Set irs=Nothing
				Set aConn = Nothing 
				Cl.SqlQueryNum = Cl.SqlQueryNum+1
			End If
			address=country&city
		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)
		Set Rs=Conn_Count.Execute("Select Count(*) From Cl_Online Where UserID>0")
		str1=Rs(0)
		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 & "Data/Cl_Count.Asp")
		end if
		Set Conn_Count=Db.OpenConnection("统计数据库")
	End Sub
End Class
%>