counter.asp

来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 513 行 · 第 1/2 页

<%@language=vbscript codepage=936 %>
<%
Option Explicit
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Response.Buffer = True
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
%>
<!--#include file="Conn_Counter.asp"-->
<!--#include file="../Include/PowerEasy.Common.Security.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 = ReplaceBadChar(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