admin_counter.asp

个人网站比较简短

            ElseIf Action = "FMozilla" Then
                Response.Write "<a title='" & rs(0) & "'>" & Left(rs(0), 40) & "</a>"
            Else
                Response.Write rs(0)
            End If
            Response.Write "    </td>"
            Response.Write "    <td align=left >&nbsp;&nbsp;" & rs(1) & "</td>"
            Response.Write "    <td align=left >" & FormatNumber(Int(rs(1) / TotalNum * 10000) / 100, 2, -1) & "%</td>"
            Response.Write "    <td align=left ><img src='../Images/bar.gif' width='" & rs(1) / TotalNum * MaxWidth & "' height='12'></td>"
            Response.Write "  </tr>"
            StatItemNum = StatItemNum + 1
            If StatItemNum >= MaxPerPage Then Exit Do
            rs.MoveNext
        Loop
        Response.Write "</table>"
        If TotalPut > 0 Then
            Response.Write ShowPage(strFileName, TotalPut, MaxPerPage, CurrentPage, True, True, "个访问记录", True)
        End If
    End If
    rs.Close
    Set rs = Nothing
End Sub

Sub FOnline()
    Dim OnNowTime
    OnNowTime = DateAdd("s", -OnlineTime, Now())
    strGuide = "当前在线用户分析"
    If CountDatabaseType = "SQL" Then
        sql = "select * from PE_StatOnline where LastTime>'" & OnNowTime & "' order by OnTime desc"
    Else
        sql = "select * from PE_StatOnline where LastTime>#" & OnNowTime & "# order by OnTime desc"
    End If

    Set rs = Server.CreateObject("adodb.recordset")
    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>" & TotalPut & "</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 VisitorNum, LNowTime
        VisitorNum = 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=center nowrap height='22'>编号</td>"
        Response.Write "    <td align=center nowrap>访问者IP</td>"
        Response.Write "    <td align=center nowrap>上站时间</td>"
        Response.Write "    <td align=center nowrap>最后刷新时间</td>"
        Response.Write "    <td align=center nowrap>已停留时间</td>"
        Response.Write "    <td align=center nowrap>所在页面 及 客户端信息</td>"
        Response.Write "  </tr>"
        
        Do While Not rs.EOF
            LNowTime = Cstrtime(CDate(Now() - rs("Ontime")))
            Response.Write "  <tr class='tdbg'>"
            Response.Write "    <td align=center width='8%' nowrap>" & VisitorNum & "</td>"
            Response.Write "    <td align=left width='15%' nowrap>" & rs("UserIP") & "</td>"
            Response.Write "    <td align=left width='17%' nowrap><a title=" & rs("OnTime") & ">" & TimeValue(rs("OnTime")) & "</a></td>"
            Response.Write "    <td align=left width='15%' nowrap>" & TimeValue(rs("LastTime")) & "</td>"
            Response.Write "    <td align=left width='15%' nowrap>" & LNowTime & "</td>"
            Response.Write "    <td align=left width='45%' nowrap title='所在页面: " & rs("UserPage") & vbCrLf & "客户端信息: " & rs("UserAgent") & "'><a href=" & rs("UserPage") & " target=""_blank"">" & Left(Findpages(rs("UserPage")), 35) & "</a>"
            Response.Write "    </td>"
            Response.Write "  </tr>"
            VisitorNum = VisitorNum + 1
            If VisitorNum >= MaxPerPage Then Exit Do
            rs.MoveNext
        Loop
        Response.Write "</table>"
        If TotalPut > 0 Then
            Response.Write ShowPage(strFileName, TotalPut, MaxPerPage, CurrentPage, True, True, "个在线用户", True)
        End If
    End If
    rs.Close
    Set rs = Nothing
End Sub

Function Findpages(furl)
    Dim Ffurl
    If furl <> "" Then
    Ffurl = Split(furl, "/")
    Findpages = Replace(furl, Ffurl(0) & "//" & Ffurl(2), "")
    If Findpages = "" Then Findpages = "/"
    Else
    Findpages = ""
    End If
End Function

Function Cstrtime(Lsttime)
    Dim Dminute, Dsecond
    Cstrtime = ""
    Dminute = 60 * Hour(Lsttime) + Minute(Lsttime)
    Dsecond = Second(Lsttime)
    If Dminute <> 0 Then Cstrtime = Dminute & "'"
    If Dsecond < 10 Then Cstrtime = Cstrtime & "0"
    Cstrtime = Cstrtime & Dsecond & """"
End Function

Sub HistoryList()
    Response.Write "<form name='form1' method='post' action='Admin_Counter.asp'>"
    Response.Write "  <table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='120'><strong>网站统计查询：</strong></td>"
    Response.Write "      <td>报表类型： "
    Response.Write "        <select name='type' size='1' class='Select' onChange=change_type()>"
    Response.Write "          <option value='1' selected>日报表</option>"
    Response.Write "          <option value='2'>月报表</option>"
    Response.Write "          <option value='3'>年报表</option>"
    Response.Write "        </select>"
    Response.Write "        <select name='qyear' size='1' class='Select' onChange=change_it()>"
    For i = 2003 To 2010
        If i = Year(Date) Then
            Response.Write "<option value='" & i & "' selected>" & i & "</option>"
        Else
            Response.Write "<option value='" & i & "'>" & i & "</option>"
        End If
    Next
    Response.Write "        </select>"
    Response.Write "        年"
    Response.Write "        <select name='qmonth' size='1' onChange=change_it()>"
    For i = 1 To 12
        If i = Month(Date) Then
            Response.Write "<option value='" & i & "' selected>" & i & "</option>"
        Else
            Response.Write "<option value='" & i & "'>" & i & "</option>"
        End If
    Next
    Response.Write "        </select>"
    Response.Write "        月"
    Response.Write "        <select name='qday' size='1' >"
    Dim year29, monthdays
    year29 = Year(Date) Mod 4
    Select Case Month(Date)
    Case 2
        If year29 = 0 Then
            monthdays = 29
        Else
            monthdays = 28
        End If
    Case 4
        monthdays = 30
    Case 6
        monthdays = 30
    Case 9
        monthdays = 30
    Case 11
        monthdays = 30
    Case Else
        monthdays = 31
    End Select
    For i = 1 To monthdays
        If i = Day(Date) Then
            Response.Write "<option  value='" & i & "' selected>" & i & "</option>"
        Else
            Response.Write "<option  value='" & i & "'>" & i & "</option>"
        End If
    Next
    Response.Write "        </select>"
    Response.Write "        日"
    Response.Write "        <input type='submit' name='Search' value='查询'>"
    Response.Write "      </td>"
    Response.Write "      <td width='120' align='center'> </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
End Sub

Sub AutoAnalyse()
    Response.Write "<script language = 'JavaScript'>" & vbCrLf
    Response.Write "function CheckForm(){" & vbCrLf
    Response.Write "  if(confirm('确实要进行统计数据自动分析吗？'))" & vbCrLf
    Response.Write "  {" & vbCrLf
    Response.Write "    return True;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "  else" & vbCrLf
    Response.Write "  {" & vbCrLf
    Response.Write "    return false;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</script>" & vbCrLf
    Response.Write "<br>" & vbCrLf
    Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>" & vbCrLf
    Response.Write "  <tr class='title'>" & vbCrLf
    Response.Write "    <td height='22' align='center'><strong> 统 计 数 据 自 动 分 析 </strong></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class='tdbg'>" & vbCrLf
    Response.Write "    <td height='150'>" & vbCrLf
    Response.Write "      <form name='myform' method='post' action='Admin_Counter.asp' onSubmit='return CheckForm();'>" & vbCrLf
    Response.Write "        <p align='center'>" & vbCrLf
    Response.Write "        <font color='#FF0000'><b>请慎用此功能，因为一旦清除将无法恢复！</b></font>" & vbCrLf
    Response.Write "        <br>此操作将清除数据库中近期访问记录表的数据，用于近期对网站的访问统计数据进行统计分析时使用。" & vbCrLf
    Response.Write "        </p>" & vbCrLf
    Response.Write "        <p align='center'>" & vbCrLf
    Response.Write "        <input name='Action' type='hidden' id='Action' value='DoAutoAnalyse'>" & vbCrLf
    Response.Write "        <input type='submit' name='Submit' value=' 统计数据自动分析 '>" & vbCrLf
    Response.Write "        </p>" & vbCrLf
    Response.Write "      </form>" & vbCrLf
    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
End Sub

Sub Init()
    Response.Write "<script language = 'JavaScript'>" & vbCrLf
    Response.Write "function CheckForm(){" & vbCrLf
    Response.Write "  if(confirm('确实要进行初始化吗？一旦清除将无法恢复！'))" & vbCrLf
    Response.Write "  {" & vbCrLf
    Response.Write "    return True;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "  else" & vbCrLf
    Response.Write "  {" & vbCrLf
    Response.Write "    return false;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</script>" & vbCrLf
    Response.Write "<br>" & vbCrLf
    Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>" & vbCrLf
    Response.Write "  <tr class='title'>" & vbCrLf
    Response.Write "    <td height='22' align='center'><strong> 数 据 初 始 化 </strong></td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr class='tdbg'>" & vbCrLf
    Response.Write "    <td height='150'>" & vbCrLf
    Response.Write "      <form name='myform' method='post' action='Admin_Counter.asp' onSubmit='return CheckForm();'>" & vbCrLf
    Response.Write "        <p align='center'>" & vbCrLf
    Response.Write "        <font color='#FF0000'><b>请慎用此功能，因为一旦清除将无法恢复！</b></font>" & vbCrLf
    Response.Write "        <br>此操作将清除数据库中的所有统计数据，用于系统初始化时及需要对网站的访问统计数据进行重新统计时使用。" & vbCrLf
    Response.Write "        </p>" & vbCrLf
    Response.Write "        <p align='center'>" & vbCrLf
    Response.Write "        <input name='Action' type='hidden' id='Action' value='DoInit'>" & vbCrLf
    Response.Write "        <input type='submit' name='Submit' value=' 统计数据初始化 '>" & vbCrLf
    Response.Write "        </p>" & vbCrLf
    Response.Write "      </form>" & vbCrLf
    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
End Sub

Sub ShowCompact()
    Response.Write "<form method='post' action='Admin_Counter.asp?action=CompactData'>"
    Response.Write "<table class='border' width='100%' border='0' align='center' cellpadding='0' cellspacing='0'>"
    Response.Write " <tr class='title'>"
    Response.Write "     <td align='center' height='22' valign='middle'><b>统计数据库在线压缩</b></td>"
    Response.Write " </tr>"
    Response.Write " <tr class='tdbg'>"
    Response.Write "     <td align='center' height='150' valign='middle'>"
    Response.Write "      <br>"
    Response.Write "      <br>"
    Response.Write "      压缩前，建议先备份统计数据库，以免发生意外错误。 <br>"
    Response.Write "      <br>"
    Response.Write "      <br>"
    Response.Write " <input name='