counter.asp

QQ呱唧网

<!--#include file="conn_counter.asp"-->
<%
Response.Buffer = True 
Response.Expires = -1
Dim Ip,Sip,Area,Address,Scope,Referer,WebUrl,Visit
Dim Agent,System,Browser,BcType,Mozilla,Height,Width,Screen,Color,Timezone,Ver
Dim Sql,Rs
Dim StrYear,StrMonth,StrDay,StrHour,Strweek,StrHourLong,StrDayLong,StrMonthLong,OldDay
Dim Num,I,ExTime
Dim Province,OnlineNum,ShowInfo
Dim DayNum,AllNum,StartDate,StatDayNum,AveDayNum
Set Rs=Server.CreateObject("ADODB.RECORDSET")

VisitRecord=5000		'保留访问记录数
Extime=10				'同IP刷新时间间隔
OnlineTime=20			'在线用户的保留时间


If Extime="" Or isnumeric(Extime)=0 Then Extime=10
If OnlineTime="" Or isnumeric(OnlineTime)=0 Then OnlineTime=10

Ip=Request.ServerVariables("REMOTE_ADDR")
If Ip<>Application("OldIp") Or DateDiff("N",Application("OldTime"),Time)>ExTime Then
	Application("OldIp")=Ip
	Application("OldTime")=Time
	Update()
End If

Sql="Select Ip From Visitor Where Vtime >= dateadd('n',-"& OnlineTime &",now()) Group By Ip"
rs.Open sql,conn_counter,1,1
OnlineNum=rs.RecordCount
rs.Close
Sql="Select * From InfoList"
Rs.Open Sql,conn_counter,1,1
if not Rs.bof and not rs.eof then
	DayNum=Rs("DayNum")
	AllNum=Rs("TotalNum")
	StartDate=Rs("StartDate")
	StatDayNum=DateDiff("D",StartDate,Date)+1
	if StatDayNum<=0 or isnumeric(StatDayNum)=0 then
	   AveDayNum=StatDayNum
	Else
	   AveDayNum=Cint(AllNum/StatDayNum)
	end if
end if
Rs.Close
Set Rs=Nothing
call CloseConn_counter()


style=Request("style")
select case style
case "simple"
	ShowInfo="总访问量：" & AllNum & "人次<br>当前在线：" & OnlineNum & "人"
case "all"
	ShowInfo=ShowInfo&"总访问量：" & AllNum & "人次<br>"
'	ShowInfo=ShowInfo&"统计天数：" & StatDayNum & "天<br>"
	ShowInfo=ShowInfo&"今日访问：" & DayNum & "人次<br>"
	ShowInfo=ShowInfo&"日均访问：" & AveDayNum & "人次<br>"
'	ShowInfo=ShowInfo&"当前在线：" & OnlineNum & "人"
case else
	ShowInfo="总访问量：" & AllNum & "人次<br>"
'	ShowInfo=ShowInfo&"当前在线：" & OnlineNum & "人"
end select
if style<>"none" then
	Response.Write "document.write(" & chr(34) & ShowInfo & chr(34) & ")"
end if



sub Update()
	SIp=Ip
	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
	Sip=0
	else
	Sip=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
	end if

	Sql="Select Top 1 Area,Address From IpInfo Where StartIp<="&Sip&" and EndIp>="&Sip&" Order By EndIp-StartIp Asc"
	Rs.Open Sql,conn_counter,1,1
	If Rs.Eof Or Rs.Bof Then
	   Area="其它地区"
	   Address="其它地区"
	Else
	   Area=Rs("Area")
	   Address=Rs("Area")&Rs("Address")
	End If
	Rs.Close

	Province="北京天津上海重庆黑龙江吉林辽宁江苏浙江安徽河南河北湖南湖北山东山西内蒙古陕西甘肃宁夏青海新疆西藏云南贵州四川广东广西福建江西海南香港澳门台湾内部网未知"
	if instr(Province,left(area,2))>0 then
		Scope="ChinaNum"
	Else
		Scope="OtherNum"
	End if

	Referer=Request.QueryString("Referer")
	If Referer="" Then Referer="直接输入或书签导入"
	WebUrl=Left(Referer,Instr(8,Referer,"/"))
	If WebUrl="" Then WebUrl="直接输入或书签导入"
	Width=Request.QueryString("Width")
	Height=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
	Color=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
	Timezone=Request.QueryString("Timezone")
	If Timezone="" Or isnumeric(Timezone)=0 Then 
	   Timezone="其它"
	Else
		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

	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 FVisit"
	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

	Mozilla=Request.ServerVariables("HTTP_USER_AGENT")
	Agent=Mozilla
	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)
		 System=Replace(System,"Windows","Win")
	case 2:
		 Browser=Agent(1)
		 System=Agent(2)
		 System=Replace(System,")","")
		 System=Replace(System,"Windows","Win")
	End Select
	System=Replace(System," ","")
	System=Replace(System,"Win","Windows")
	System=Replace(System,"NT5.0","2000")
	System=Replace(System,"NT5.1","XP")
	System=Replace(System,"NT5.2","2003")
	Browser=Replace(Browser," ","")

	Screen=left(Screen,10)
	System=Left(System,20)
	Browser=Left(Browser,20)
	WebUrl=Left(WebUrl,50)
	Referer=left(Referer,100)

	Call DelOutVisit()
	Sql="Select * From Visitor Order By Id DESC"
	Rs.Open Sql,conn_counter,1,3
	Rs.Addnew
	Rs("VTime")=Now()
	Rs("IP")=Ip
	Rs("Address")=Address
	Rs("Browser")=Browser
	Rs("System")=System
	Rs("Screen")=Screen
	Rs("Color")=Color
	Rs("Timezone")=Timezone
	Rs("Referer")=Referer
	Rs.Update
	Rs.Close

	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 InfoList"
	Rs.Open Sql,conn_counter,1,3
	Rs("TotalNum")=Rs("TotalNum")+1
	Rs(Scope)=Rs(Scope)+1
	If IsNull(Rs("StartDate")) Then Rs("StartDate")=StrDayLong
	If IsNull(Rs("OldDay")) Then Rs("OldDay")=StrDayLong
	OldDay=Rs("OldDay")
	Rs.Update
	Rs.Close

	ModiMaxNum StrMonthLong,"OldMonth","MonthNum","MonthMaxDate","MonthMaxNum"
	ModiMaxNum StrDayLong,"OldDay","DayNum","DayMaxDate","DayMaxNum"
	ModiMaxNum StrHourLong,"OldHour","HourNum","HourMaxTime","HourMaxNum"

	AddNum System,"FSystem","TSystem","TSysNum"
	AddNum Browser,"FBrowser","TBrowser","TBrwNum"
	AddNum Mozilla,"FMozilla","TMozilla","TMozNum"
	AddNum Screen,"FScreen","TScreen","TScrNum"
	AddNum Color,"FColor","TColor","TColNum"
	AddNum Timezone,"FTimezone","TTimezone","TTimNum"
	AddNum Referer,"FRefer","TRefer","TRefNum"
	AddNum Weburl,"FWeburl","TWeburl","TWebNum"
	AddNum Address,"FAddress","TAddress","TAddNum"
	AddNum Area,"FArea","TArea","TAreNum"
	AddNum Ip,"FIp","TIp","TIpNum"
	AddNum StrDayLong,"StatDay","TDay",StrHour
	AddNum "Total","StatDay","TDay",StrHour
	AddNum StrYear,"StatYear","TYear",StrMonth
	AddNum "Total","StatYear","TYear",StrMonth
	AddNum StrMonthLong,"StatMonth","TMonth",StrDay
	AddNum "Total","StatMonth","TMonth",StrDay
	AddNum "Total","StatWeek","TWeek",StrWeek
	If DateDiff("Ww",Cdate(OldDay),Date)>0 Then
	   Sql="Delete * From StatWeek Where TWeek='Current'"
	   conn_counter.Execute(Sql)
	End If
	AddNum "Current","StatWeek","TWeek",StrWeek
end sub

Sub ModiMaxNum(CurData,OldData,OldNum,MaxData,MaxNum)
    Sql="Select * From InfoList"
    Rs.Open Sql,conn_counter,1,3
    If Rs(OldData)=CurData Then
       Rs(OldNum)=Rs(OldNum)+1
    Else
       Rs(OldData)=CurData
       Rs(OldNum)=1
    End If
    If Rs(OldNum)>Rs(MaxNum) Then 
       Rs(MaxNum)=Rs(OldNum)
       Rs(MaxData)=CurData
    End If
    Rs.Update
    Rs.Close
End Sub

Sub AddNum(Data,TableName,CompareField,AddField)
    Sql="Select * From "&TableName&" Where "&CompareField&"='"&Data&"'"
    Rs.Open Sql,conn_counter,1,3
    If Rs.Eof Or Rs.Bof Then
       Rs.AddNew
       Rs(CompareField)=Data
       Rs(AddField)=1
    Else
       If Isnumeric(Rs(AddField))=0 Then
          Rs(AddField)=1
       Else
	      Rs(AddField)=Rs(AddField)+1
       End If
    End If
    Rs.Update
    Rs.Close
End Sub

Sub DelOutVisit()
    Dim rsOut,VisitCount,OutNum
    VisitCount = 0
    Set rsOut = conn_counter.Execute("select count(ID) From Visitor")
    VisitCount = rsOut(0)
    If VisitCount > VisitRecord Then
        OutNum = VisitCount - VisitRecord
        Set rsOut = conn_counter.Execute("select top " & OutNum & " ID From Visitor order by ID asc")
        While Not rsOut.EOF
            conn_counter.Execute ("delete from Visitor where ID=" & rsOut(0))
            rsOut.movenext
        Wend
    End If
    rsOut.Close
    Set rsOut = Nothing
End Sub
%>