counter.asp

一本关于大学的书

<!--#include file="Conn_Counter.asp"-->
<%

Dim Ip,LastIPCache,Sip,Address,Scope,Referer,VisitorKeyword,WebUrl,Visit,StatIP,strIP
Dim Agent,System,Browser,BcType,Mozilla,Height,Width,Screen,Color,Timezone,Ver,VisitTimezone
Dim StrYear,StrMonth,StrDay,StrHour,Strweek,StrHourLong,StrDayLong,StrMonthLong,OldDay
Dim Num,I,nYesterDayNum,CacheData
Dim Province,OnlineNum,ShowInfo
Dim OnNowTime,style
Dim RegCount_Fill,OnlineTime,VisitRecord,KillRefresh
Dim DayNum,AllNum,TotalView,StartDate,StatDayNum,AveDayNum

call OpenConn_Counter()

Dim Sql,Rs
set Rs=conn_counter.execute("select * from PE_StatInfoList")
if not Rs.bof and not Rs.eof then
	RegCount_Fill = rs("RegFields_Fill")
	OnlineTime=Rs("OnlineTime")
	VisitRecord=Rs("VisitRecord")
	KillRefresh=Rs("KillRefresh")
    DayNum=Rs("DayNum")
    AllNum=Rs("TotalNum")+Rs("OldTotalNum")
    TotalView=Rs("TotalView")+Rs("OldTotalView")
    StartDate=Rs("StartDate")
    StatDayNum=DateDiff("D",StartDate,Date)+1
    if StatDayNum<=0 or isnumeric(StatDayNum)=0 then
    	AveDayNum=StatDayNum
    Else
        AveDayNum=Clng(AllNum/StatDayNum)
    end if
end if
set Rs=nothing

Response.Expires = 0
LastIPCache="Powereasy_LastIP"
if isempty(Application(LastIPCache)) then Application(LastIPCache)="#0.0.0.0#"

Ip=replace(Request.ServerVariables("REMOTE_ADDR"),"'","")

If FoundInArr(RegCount_Fill, "IsCountOnline", ",") = True Then
	If OnlineTime="" Or isnumeric(OnlineTime)=0 Then OnlineTime=100	  
    OnNowTime = dateadd("s",-OnlineTime,now())
    dim rsOnline
	if CountDatabaseType="SQL" then
		set rsonline = conn_counter.execute("select count(UserIP) from PE_Statonline where LastTime>'"&OnNowTime&"'")
	else
		set rsonline = conn_counter.execute("select count(UserIP) from PE_Statonline where LastTime>#"&OnNowTime&"#")
	end if
    OnlineNum = rsonline(0)		' 当前在线人数
    Set rsonline=Nothing 
	if CountDatabaseType="SQL" then
		Set rsonline = conn_counter.execute("select LastTime,OnTime from PE_Statonline where LastTime>'"&OnNowTime&"' and UserIP='"&IP&"'")
    else
		Set rsonline = conn_counter.execute("select LastTime,OnTime from PE_Statonline where LastTime>#"&OnNowTime&"# and UserIP='"&IP&"'")
	end if
	If rsOnline.eof then
		Update()
	Else
		if rsonline(0)=rsonline(1) Then
			Update()
		else
			conn_counter.Execute("Update PE_StatInfoList set TotalView=TotalView+1")
		end if
	End If
	Set rsonline=Nothing
Else
    if instr(Application(LastIPCache),"#" & IP & "#") then	' 如果IP已经存在于保存的列表中，是刷新	
        conn_counter.Execute("Update PE_StatInfoList set TotalView=TotalView+1")
    Else
    	Application.Lock 
    	Application(LastIPCache)=SaveIP(Application(LastIPCache))		' 更新最近需要防刷的IP
    	Application.UnLock
    	Update()
    End If
End If


style=lcase(trim(Request("style")))
select case style
case "simple"
	ShowInfo="总访问量：" & AllNum & "人次<br>"
	If FoundInArr(RegCount_Fill, "IsCountOnline", ",") = True Then
		ShowInfo=ShowInfo&"当前在线：" & OnlineNum & "人"
	End If
case "all"
	ShowInfo=ShowInfo&"总访问量：" & AllNum & "人次<br>"
	ShowInfo=ShowInfo&"总浏览量：" & TotalView & "人次<br>"
'	ShowInfo=ShowInfo&"统计天数：" & StatDayNum & "天<br>"
	If FoundInArr(RegCount_Fill, "FYesterDay", ",") = True Then
		Call GetYesterdayNum()
		ShowInfo=ShowInfo&"昨日访问：" & nYesterDayNum & "人<br>"
	end if
	ShowInfo=ShowInfo&"今日访问：" & DayNum & "人次<br>"
	ShowInfo=ShowInfo&"日均访问：" & AveDayNum & "人次<br>"
	If FoundInArr(RegCount_Fill, "IsCountOnline", ",") = True Then
		ShowInfo=ShowInfo&"当前在线：" & OnlineNum & "人"
	End If
case "common"
	ShowInfo="总访问量：" & AllNum & "人次<br>"
	ShowInfo=ShowInfo&"总浏览量：" & TotalView & "人次<br>"
	If FoundInArr(RegCount_Fill, "IsCountOnline", ",") = True Then
		ShowInfo=ShowInfo&"当前在线：" & OnlineNum & "人"
	End If
end select
if style<>"none" then
	Response.Write "document.write(" & chr(34) & ShowInfo & chr(34) & ")"
end if

Call CloseConn_counter()
sub Update()
	If FoundInArr(RegCount_Fill, "FIP", ",") = True Then
		strIP=split(IP,".")
		if isNumeric(strIP(0))=0 or isNumeric(strIP(1))=0 or isNumeric(strIP(2))=0 or isNumeric(strIP(3))=0 then
			Sip=0
		else
			Sip=cint(strIP(0))*256*256*256+cint(strIP(1))*256*256+cint(strIP(2))*256+cint(strIP(3))-1
		end if
		if (167772159 < Sip and Sip< 184549374) or (2886729727 < Sip and Sip < 2887778302) or (3232235519 < Sip and Sip < 3232301054) then
			StatIP=IP
		else
			StatIP=strIP(0) & "." & strIP(1) & ".*"
		end if
	else
		StatIP=""
	End If
	SIp=Ip
	set rs=server.createobject("adodb.recordset")
	if SIP="127.0.0.1" then
		Address="本机地址"
		Scope="ChinaNum"
	else
		strIP=split(Sip,".")
		if isNumeric(strIP(0))=0 or isNumeric(strIP(1))=0 or isNumeric(strIP(2))=0 or isNumeric(strIP(3))=0 then
			Sip=0
		else
			Sip=cint(strIP(0))*256*256*256+cint(strIP(1))*256*256+cint(strIP(2))*256+cint(strIP(3))-1
		end if

		dim RsAdress
		set RsAdress=conn_counter.execute("Select Top 1 Address From PE_StatIpInfo Where StartIp<="&Sip&" and EndIp>="&Sip&" Order By EndIp-StartIp Asc")
		If RsAdress.Eof Then
			Address="其它地区"
		Else
			Address=RsAdress(0)
		End If
		set RsAdress=nothing
		Province="北京天津上海重庆黑龙江吉林辽宁江苏浙江安徽河南河北湖南湖北山东山西内蒙古陕西甘肃宁夏青海新疆西藏云南贵州四川广东广西福建江西海南香港澳门台湾内部网未知"
		if instr(Province,left(Address,2))>0 then
			Scope="ChinaNum"
		Else
			Scope="OtherNum"
		End if
	end if

	Referer=Request.QueryString("Referer")	
	If Referer="" Then Referer="直接输入或书签导入"
	Referer=ReplaceUrlBadChar(left(Referer,100))

		'response.write"11="&Referer
		'response.end

	If FoundInArr(RegCount_Fill, "FWeburl", ",") = True Then
		WebUrl=Left(Request.QueryString("Referer"),Instr(8,Referer,"/"))
		If WebUrl="" Then WebUrl="直接输入或书签导入"
		WebUrl=ReplaceUrlBadChar(Left(WebUrl,50))
	else
		WebUrl=""
	End If

	Width=ReplaceBadChar(Request.QueryString("Width"))
	Height=ReplaceBadChar(Request.QueryString("Height"))
	If Height="" Or isnumeric(Height)=0 Or Width="" Or isnumeric(Width)=0 Then 
		Screen="其它"
	Else
		Screen=Cstr(Width)&"x"&Cstr(Height)
	End If
	Screen=left(Screen,10)



	Color=ReplaceBadChar(Request.QueryString("Color"))
	If Color="" Or isnumeric(Color)=0 Then 
		Color="其它"
	Else
		Select Case Color
		Case 4:
			 Color="16 色"
		Case 8:
			 Color="256 色"
		Case 16:
			 Color="增强色（16位）"
		Case 24:
			 Color="真彩色（24位）"
		Case 32:
			 Color="真彩色（32位）"
		End Select
	End If


	Mozilla=replace(Request.ServerVariables("HTTP_USER_AGENT"),"'","")
	Mozilla=left(Mozilla,100)
	Agent=Request.ServerVariables("HTTP_USER_AGENT")
	Agent=Split(Agent,";")
	BcType=0
	If Instr(Agent(1),"U") Or Instr(Agent(1),"I") Then BcType=1
	If InStr(Agent(1),"MSIE") Then BcType=2
	Select Case BcType
	Case 0:
		 Browser="其它"
		 System="其它"
	Case 1:
		 Ver=Mid(Agent(0),InStr(Agent(0),"/")+1)
		 Ver=Mid(Ver,1,InStr(Ver," ")-1)
		 Browser="Netscape"&Ver
		 System=Mid(Agent(0),InStr(Agent(0),"(")+1)		 
	case 2:
		 Browser=Agent(1)
		 System=Agent(2)
		 System=Replace(System,")","")		 
	End Select
	System=Replace(Replace(Replace(Replace(Replace(Replace(System," ",""),"Win","Windows"),"NT5.0","2000"),"NT5.1","XP"),"NT5.2","2003"),"dowsdows","dows")
	Browser=Replace(Replace(Browser," ",""),"'","")
	System=Replace(Left(System,20),"'","")

	Browser=Left(Browser,20)

	Timezone=ReplaceBadChar(Request.QueryString("Timezone"))
	If Timezone="" Or isnumeric(Timezone)=0 Then 
	   Timezone="其它"
	   VisitTimezone=0
	Else
		VisitTimezone=Timezone\60
		If Timezone<0 Then
			Timezone="GMT+"&Abs(Timezone)\60&":"&(Abs(Timezone) Mod 60)
		Else
			Timezone="GMT-"&Abs(Timezone)\60&":"&(Abs(Timezone) Mod 60)
		End If
	End If


	If FoundInArr(RegCount_Fill, "FVisit", ",") = True Then
		Visit=Request.Cookies("VisitNum")
		If Visit<>"" Then
			Visit=Visit+1
		Else
			Visit=1
		End If
		Response.Cookies("VisitNum")=Visit
		Response.Cookies("VisitNum").Expires="January 01, 2010"
		Sql="Select * From PE_StatVisit"
		Rs.Open Sql,conn_counter,1,3
		If Rs.Eof Or Rs.Bof Then
			Rs.AddNew
		End If
		If Visit<=10 Then
			If Isnumeric(Rs(Visit-1))=0 Then
				Rs(Visit-1)=1
			Else
				Rs(Visit-1)=Rs(Visit-1)+1
				If Visit>1 Then
				   If Rs(Visit-2)>0 Then Rs(Visit-2)=Rs(Visit-2)-1
				End If
			End If
		End If
		Rs.Update
		Rs.Close
	end if

	Call UpdateVisit()

	StrHour=Cstr(hour(time))
	StrDay=Cstr(Day(Date))
	StrMonth=Cstr(Month(Date))
	StrYear=Cstr(Year(Date))
	StrWeek=Cstr(Weekday(Date))
	StrDayLong=Cstr(Year(Date)&"-"&Month(Date)&"-"&Day(date))
	StrMonthLong=Cstr(Year(Date)&"-"&Month(Date))
	StrHourLong=StrDayLong&" "&Cstr(Hour(Time))&":00:00"

	Sql="Select * From PE_StatInfoList"
	Rs.Open Sql,conn_counter,1,3
	Rs("TotalNum")=Rs("TotalNum")+1
	Rs("TotalView")=Rs("TotalView")+1