admin_counter.asp

个人网站比较简短

    strGuide = "全部年访问统计分析"
    StatItem = "月份"
    sql = "Select * From PE_StatYear Where TYear='Total'"
    Call Stable
End Sub

Sub StatMonth()
    If Request("Type") = "" Then
       QMonth = CStr(Year(Date) & "-" & Month(Date))
    Else
       Search = "查询结果："
    End If
    SYear = Mid(QMonth, 1, InStr(QMonth, "-") - 1)
    SMonth = Mid(QMonth, InStr(QMonth, "-") + 1)
    Select Case SMonth
    Case "2"
        If (SYear Mod 4) = 0 Then
           ItemNum = 29
        Else
           ItemNum = 28
        End If
    Case "4"
        ItemNum = 30
    Case "6"
        ItemNum = 30
    Case "9"
        ItemNum = 30
    Case "11"
        ItemNum = 30
    Case Else
        ItemNum = 31
    End Select
    ReDim Item(ItemNum - 1)
    For i = 0 To ItemNum - 1
      Item(i) = SYear & "年" & SMonth & "月" & i + 1 & "日"
    Next
    strGuide = QMonth & "月访问统计分析"
    StatItem = "日期"
    sql = "Select * From PE_StatMonth Where TMonth='" & QMonth & "'"
    Call Stable
End Sub

Sub StatAllMonth()
    ItemNum = 31
    ReDim Item(ItemNum)
    For i = 0 To ItemNum - 1
      Item(i) = i + 1 & "日"
    Next
    strGuide = "全部月访问统计分析"
    StatItem = "日期"
    sql = "Select * From PE_StatMonth Where TMonth='Total'"
    Call Stable
End Sub

Sub StatWeek()
    Item = Array("星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六")
    ItemNum = 7
    strGuide = "本周访问统计分析"
    StatItem = "星期"
    sql = "Select * From PE_StatWeek Where Tweek='Current'"
    Call Stable
End Sub

Sub StatAllWeek()
    Item = Array("星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六")
    ItemNum = 7
    strGuide = "全部周访问统计分析"
    StatItem = "星期"
    sql = "Select * From PE_StatWeek Where Tweek='Total'"
    Call Stable
End Sub

Sub StatDay()
    If Request("Type") = "" Then
       QDay = CStr(Year(Date) & "-" & Month(Date) & "-" & Day(Date))
    Else
       Search = "查询结果："
    End If
    ItemNum = 24
    ReDim Item(23)
    For i = 0 To ItemNum - 1
      Item(i) = Mid(i + 100, 2) & ":00-" & Mid(i + 101, 2) & ":00"
    Next
    strGuide = QDay & "日访问统计分析"
    StatItem = "小时"
    sql = "Select * From PE_StatDay Where TDay='" & QDay & "'"
    Call Stable
End Sub

Sub StatAllDay()
    ItemNum = 24
    ReDim Item(ItemNum)
    For i = 0 To ItemNum - 1
      Item(i) = Mid(i + 100, 2) & ":00-" & Mid(i + 101, 2) & ":00"
    Next
    strGuide = "全部日访问统计分析"
    StatItem = "小时"
    sql = "Select * From PE_StatDay Where TDay='Total'"
    Call Stable
End Sub

Sub FIP()
    sql = "Select * From PE_StatIp Order By TIpNum DESC"
    strGuide = "访问者IP地址分析"
    StatItem = "IP地址"
    Call Ftable
End Sub

Sub FAddress()
    sql = "Select * From PE_StatAddress Order By TAddNum DESC"
    strGuide = "访问者所在地址分析"
    StatItem = "地址"
    Call Ftable
End Sub

Sub FTimezone()
    sql = "Select * From PE_StatTimezone Order By TtimNum DESC"
    strGuide = "访问者所处时区分析"
    StatItem = "时区"
    Call Ftable
End Sub

Sub FWeburl()
    sql = "Select * From PE_StatWeburl Order By TWebNum DESC"
    strGuide = "访问者来访网站分析"
    StatItem = "来访网站"
    Call Ftable
End Sub

Sub FKeyword()
    sql = "Select * From PE_StatKeyword Order By TKeywordNum DESC"
    strGuide = "访问者搜索关键词分析"
    StatItem = "关 键 词"
    Call Ftable
End Sub

Sub FReferer()
    sql = "Select * From PE_StatRefer Order By TRefNum DESC"
    strGuide = "访问者链接页面分析"
    StatItem = "链接页面"
    Call Ftable
End Sub

Sub FSystem()
    sql = "Select * From PE_StatSystem Order By TSysNum DESC"
    strGuide = "访问者所用操作系统分析"
    StatItem = "操作系统"
    Call Ftable
End Sub

Sub FBrowser()
    sql = "Select * From PE_StatBrowser Order By TBrwNum DESC"
    strGuide = "访问者所用浏览器分析"
    StatItem = "浏览器"
    Call Ftable
End Sub

Sub FMozilla()
    sql = "Select * From PE_StatMozilla Order By TMozNum DESC"
    strGuide = "访问者HTTP_USER_AGENT字符串分析"
    StatItem = "USER_AGENT"
    Call Ftable
End Sub

Sub FScreen()
    sql = "Select * From PE_StatScreen Order By TScrNum DESC"
    strGuide = "访问者屏幕大小分析"
    StatItem = "屏幕大小"
    Call Ftable
End Sub

Sub FColor()
    sql = "Select * From PE_StatColor Order By TColNum DESC"
    strGuide = "访问者屏幕显示颜色分析"
    StatItem = "屏幕显示颜色"
    Call Ftable
End Sub

Sub Stable()
    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn_Counter, 1, 1
    If Not rs.BOF And Not rs.EOF Then
        Assay = rs.GetRows
        Rows = ItemNum - 1
    Else
        Rows = -1
    End If
    rs.Close
    Set rs = Nothing
    For i = 0 To Rows
        TotalNum = TotalNum + Assay(i, 0)
    Next
    If Rows >= 0 Then
        ReDim Percent(Rows)
        ReDim Barwidth(Rows)
    End If
    For i = 0 To Rows
        If TotalNum > 0 Then
            Percent(i) = FormatNumber(Int(Assay(i, 0) / TotalNum * 10000) / 100, 2, -1) & "%"
            Barwidth(i) = Assay(i, 0) / TotalNum * MaxWidth
        End If
    Next
    TitleRight = "有效统计：<font color=red>" & TotalNum & "</font>"
    If Rows < 0 Then
        Response.Write "<li>系统中无数据！"
    Else
        Response.Write "<table width='100%'><tr><td align='left'>您现在的位置：网站统计管理&nbsp;&gt;&gt;&nbsp;" & Search & strGuide & "</td><td align='right'>" & TitleRight & "</td></tr></table>"
        Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
        Response.Write "  <tr class=title>"
        Response.Write "    <td align=left width='30%' nowrap height='22'>" & StatItem & "</td>"
        Response.Write "    <td align=left width='20%' nowrap>访问人数</td>"
        Response.Write "    <td align=left width='20%' nowrap>百分比</td>"
        Response.Write "    <td align=left width='30%' nowrap>图示</td>"
        Response.Write "  </tr>"
        For i = 0 To Rows
            Response.Write "  <tr class='tdbg'>"
            Response.Write "    <td align=left>" & Item(i) & "</td>"
            Response.Write "    <td align=left>&nbsp;&nbsp;" & Assay(i, 0) & "</td>"
            Response.Write "    <td align=left>" & Percent(i) & "</td>"
            Response.Write "    <td align=left><img src='../Images/bar.gif' width='" & Barwidth(i) & "' height='10'></td>"
            Response.Write "  </tr>"
        Next
        Response.Write "</table>"
    End If
End Sub

Sub Ftable()
    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn_Counter, 1, 1
    Do While Not rs.EOF
        TotalNum = TotalNum + rs(1)
        rs.MoveNext
    Loop
    rs.Close
    rs.Open sql, Conn_Counter, 1, 1
    If rs.BOF And rs.EOF Then
        Response.Write "<li>系统中无数据！"
    Else
        TotalPut = rs.RecordCount
        TitleRight = TitleRight & "有效统计：<font color=red>" & TotalNum & "</font>"
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > TotalPut Then
            If (TotalPut Mod MaxPerPage) = 0 Then
                CurrentPage = TotalPut \ MaxPerPage
            Else
                CurrentPage = TotalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < TotalPut Then
                rs.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        
        Dim StatItemNum
        StatItemNum = 0
        Response.Write "<table width='100%'><tr><td align='left'>您现在的位置：网站统计管理&nbsp;&gt;&gt;&nbsp;" & Search & strGuide & "</td><td align='right'>" & TitleRight & "</td></tr></table>"
        Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
        Response.Write "  <tr class=title>"
        Response.Write "    <td align=left width='30%' nowrap height='22'>" & StatItem & "</td>"
        Response.Write "    <td align=left width='20%' nowrap>访问人数</td>"
        Response.Write "    <td align=left width='20%' nowrap>百分比</td>"
        Response.Write "    <td align=left width='30%' nowrap>图示</td>"
        Response.Write "  </tr>"
        Do While Not rs.EOF
            Response.Write "  <tr class='tdbg'>"
            Response.Write "    <td align=left nowrap>"
            If (Action = "FWeburl" Or Action = "FReferer") And rs(0) <> "直接输入或书签导入" Then
                Response.Write "<a href='" & rs(0) & "' title='" & rs(0) & "' target='_blank'>" & Left(rs(0), 40) & "</a>"