admin_counter.asp

个人网站比较简短

Call CloseConn_Counter

If Not (Action = "ShowConfig" Or Action = "SaveConfig" Or Action = "Init" Or Action = "DoInit" Or Action = "ClientDetail" Or Action = "IPAdd" Or Action = "IPManage" Or Action = "SaveIPAdd" Or Action = "SearchIP" Or Action = "editIP" Or Action = "SaveIPedit" Or Action = "delIP" Or Action = "Compact" Or Action = "CompactData") Then
    Call HistoryList
End If

If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Response.Write "</body></html>"
Call CloseConn


Sub ShowConfig()
    sql = "select * from PE_StatInfoList"
    Set rs = Server.CreateObject("ADODB.Recordset")
    rs.Open sql, Conn_Counter, 1, 3
    If rs.BOF And rs.EOF Then
        Response.Write "<li>网站统计配置数据丢失！"
        Exit Sub
    Else
        MasterTimeZone = rs("MasterTimeZone")
        OnlineTime = rs("OnlineTime")
        IntervalNum = rs("IntervalNum")
        VisitRecord = rs("VisitRecord")
        KillRefresh = rs("KillRefresh")
        OldTotalNum = rs("OldTotalNum")
        OldTotalView = rs("OldTotalView")
        RegCount_Fill = rs("RegFields_Fill")
    End If
    rs.Close
    Set rs = Nothing
    Response.Write "<SCRIPT language=javascript>" & vbCrLf
    Response.Write "function ConfirmModify(){" & vbCrLf
    Response.Write "  if(confirm('强烈建议尽量选择少的统计功能项目，最好一个都不启用！！！'))" & vbCrLf
    Response.Write "      return true;" & vbCrLf
    Response.Write "  else" & vbCrLf
    Response.Write "      return false;" & vbCrLf
    Response.Write " }" & vbCrLf
        
    Response.Write "var tID=0;" & vbCrLf
    Response.Write "function ShowTabs(ID){" & vbCrLf
    Response.Write "  if(ID!=tID){" & vbCrLf
    Response.Write "    TabTitle[tID].className='title5';" & vbCrLf
    Response.Write "    TabTitle[ID].className='title6';" & vbCrLf
    Response.Write "    Tabs[tID].style.display='none';" & vbCrLf
    Response.Write "    Tabs[ID].style.display='';" & vbCrLf
    Response.Write "    tID=ID;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</SCRIPT>" & vbCrLf
    Response.Write "<table width='100%'><tr><td align='left'>您现在的位置：网站统计信息配置</td></tr></table>"
    Response.Write "<form method='POST' action='Admin_Counter.asp?Action=SaveConfig' id='form1' name='form1' onsubmit='return ConfirmModify();'>" & vbCrLf

    Response.Write "<table width='100%'  border='0' align='center' cellpadding='0' cellspacing='0'>" & vbCrLf
    Response.Write "  <tr align='center'>" & vbCrLf
    Response.Write "    <td id='TabTitle' class='title6' onclick='ShowTabs(0)'>基本信息</td>" & vbCrLf
    Response.Write "    <td id='TabTitle' class='title5' onclick='ShowTabs(1)'>初始化设置</td>" & vbCrLf
    Response.Write "    <td id='TabTitle' class='title5' onclick='ShowTabs(2)'>功能项目</td>" & vbCrLf
    Response.Write "    <td id='TabTitle' class='title5' onclick='ShowTabs(3)'>调用代码</td>" & vbCrLf

    Response.Write "    <td>&nbsp;</td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf

    Response.Write "<table width='100%' border='0' align='center' cellpadding='5' cellspacing='0' class='border'>"
    Response.Write "  <tr align='center'>"
    Response.Write "    <td class='tdbg' height='200' valign='top'>"
    Response.Write "      <table width='98%' border='0' cellpadding='2' cellspacing='1' bgcolor='#FFFFFF'>"
    Response.Write "        <tbody id='Tabs' style='display:'>" & vbCrLf
    'Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>" & vbCrLf
    'Response.Write "    <tr class='topbg'> " & vbCrLf
    'Response.Write "      <td height='22' colspan='4'> <a name='SiteCountInfo'></a><strong>网站统计信息配置</strong></td>" & vbCrLf
    'Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong> 服务器所在时区：</strong></td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='MasterTimeZone' type='text' id='MasterTimeZone' value='" & MasterTimeZone & "' size='20' maxlength='50'>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>在线用户的保留时间：</strong><br>" & vbCrLf
    Response.Write "      用户切换页面至其他网站或者关闭浏览器后，在线名单将在上述时间内删除该用户。这个间隔越小，网站统计的当前时刻在线名单越准确；这个间隔越大，网站统计的在线人数越多。" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='OnlineTime' type='text' id='OnlineTime' value='" & OnlineTime & "' size='20' maxlength='50'>" & vbCrLf
    Response.Write "      秒      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>自动标记在线间隔：</strong><br>" & vbCrLf
    Response.Write "      客户端浏览器会每隔上述时间向服务器提交一次在线信息，同时服务器将其标记为在线，这个间隔越小，服务器需要处理的请求越多。</td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='Interval' type='text' id='Interval' value='60' size='20' maxlength='50' disabled>" & vbCrLf
    Response.Write "        秒" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>自动标记在线间隔循环次数：</strong><br>" & vbCrLf
    Response.Write "      此是为了防止用户打开网页，但长时间无任何活动而设置。客户端浏览器向服务器提交在线信息次数超过此次数，立即停止提交。" & vbCrLf
    Response.Write "</td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='IntervalNum' type='text' id='IntervalNum' value='" & IntervalNum & "' size='20' maxlength='50'>" & vbCrLf
    Response.Write "        次" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>保留访问记录数：</strong><br>" & vbCrLf
    Response.Write " 保存访问明细(最后访问)条目数。</td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='VisitRecord' type='text' id='VisitRecord' value='" & VisitRecord & "' size='20' maxlength='50'>" & vbCrLf
    Response.Write "        条" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong> 保留访问IP数(大于20小于800的数字)： </strong><br>" & vbCrLf
    Response.Write "      当不启用“在线人数统计”功能时，系统将以保留访问者IP的方式来防止刷新，即同一个IP访问多次或者在网站内切换页面，均只计算浏览量而不计算访问量。    </td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='KillRefresh' type='text' id='KillRefresh' value='" & KillRefresh & "' size='20' maxlength='50'>" & vbCrLf
    Response.Write "        个" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "        </tbody>" & vbCrLf

    Response.Write "        <tbody id='Tabs' style='display:none'>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>使用本系统前的访问量：</strong>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='OldTotalNum' type='text' id='OldTotalNum' value='" & OldTotalNum & "' size='20' maxlength='9'>" & vbCrLf
    Response.Write "        人次" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "        <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong> 使用本系统前的浏览量：</strong>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "        <input name='OldTotalView' type='text' id='OldTotalView' value='" & OldTotalView & "' size='20' maxlength='9'>" & vbCrLf
    Response.Write "        人次" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "        </tbody>" & vbCrLf

    Response.Write "        <tbody id='Tabs' style='display:none'>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>功能项目:</strong><br>" & vbCrLf
    Response.Write "      统计太多的项目会减慢访问速度，耗费太多网站资源，一段时间不想分析的功能项目建议不要起用！<br><font color='red'>强烈建议尽量选择少的功能项目，最好一个都不启用！！！</font><br>" & vbCrLf
    Response.Write "      </td><td>" & vbCrLf
    Response.Write "        <table width='100%'><tr>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "      <input name='RegFields_Fill' type='checkbox' value='IsCountOnline'" & vbCrLf
    If FoundInArr(RegCount_Fill, "IsCountOnline", ",") = True Then Response.Write " checked"
    Response.Write "      >启用“在线人数统计”功能</td><td><input name='RegFields_Fill' type='checkbox' value='FIP'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FIP", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端IP地址分析</td><td><input name='RegFields_Fill' type='checkbox' value='FAddress'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FAddress", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端地址分析 </td></tr><tr class='tdbg'><td><input name='RegFields_Fill' type='checkbox' value='FRefer'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FRefer", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端链接页面分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FTimezone'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FTimezone", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端时区分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FWeburl'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FWeburl", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端来访网站分析  </td></tr><tr class='tdbg'><td><input name='RegFields_Fill' type='checkbox' value='FBrowser'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FBrowser", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端浏览器分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FMozilla'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FMozilla", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端字串分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FSystem'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FSystem", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端操作系统分析 </td></tr> <tr class='tdbg'><td><input name='RegFields_Fill' type='checkbox' value='FScreen'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FScreen", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端屏幕大小分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FColor'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FColor", ",") = True Then Response.Write " checked"
    Response.Write "      >客户端屏幕色彩分析  </td><td><input name='RegFields_Fill' type='checkbox' value='FKeyword'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FKeyword", ",") = True Then Response.Write " checked"
    Response.Write "      >搜索关键词分析 </td></tr> <tr class='tdbg'><td><input name='RegFields_Fill' type='checkbox' value='FVisit'"
    If FoundInArr(RegCount_Fill, "FVisit", ",") = True Then Response.Write " checked"
    Response.Write "      >访问次数统计分析 </td><td><input name='RegFields_Fill' type='checkbox' value='FYesterDay'" & vbCrLf
    If FoundInArr(RegCount_Fill, "FYesterDay", ",") = True Then Response.Write " checked"
    Response.Write "      >启用昨日统计  </td><td>" & vbCrLf

    Response.Write "      </td></tr>" & vbCrLf
    Response.Write "      </table>" & vbCrLf
    Response.Write "   </td></tr>" & vbCrLf
    Response.Write "        </tbody>" & vbCrLf
    
    Response.Write "        <tbody id='Tabs' style='display:none'>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong>统计计数代码类型：</strong><br>" & vbCrLf
    Response.Write "      [请先选择您想要的输出信息类型]</td>" & vbCrLf
    Response.Write "      <td colspan='3'> " & vbCrLf
    Response.Write "      <select name='select'  onChange='setFileFileds(this.value)'>" & vbCrLf
    Response.Write "        <option value='1' selected>显示简单样式信息</option>" & vbCrLf
    Response.Write "        <option value='2'>显示普通样式信息</option>" & vbCrLf
    Response.Write "        <option value='3'>显示复杂样式信息</option>" & vbCrLf
    Response.Write "        <option value='4'>统计但不显示信息</option>" & vbCrLf
    Response.Write "      </select>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong> 显示数据代码：</strong><br>" & vbCrLf
    Response.Write "      请将此代码拷贝到您需要做统计的页面，此代码不仅用于向放置了此代码的页面输出统计数据，而且还对该页面计数。<br></td>" & vbCrLf
    Response.Write "      <td colspan='3'><textarea name='selectKey' cols='50' rows='5' id='selectKey'><script src='{$InstallDir}Count/CounterLink.asp?style=simple'></script></textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf

    Response.Write "    <tr class='tdbg'> " & vbCrLf
    Response.Write "      <td width='300' height='25' class='tdbg5'><strong> 前台显示在线链接代码：</strong><br>" & vbCrLf
    Response.Write "      请将此代码拷贝到您需要显示在线列表链接的模板中，此代码仅用于向放置了此代码的页面显示在线列表链接，而不对该页面计数。<br></td>" & vbCrLf
    Response.Write "      <td colspan='3'><textarea name='LinkContent' cols='50' rows='5' id='LinkContent'><a href='{$InstallDir}Count/ShowOnline.asp' target='_blank'>网站在线情况详细列表</a></textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "        </tbody>" & vbCrLf
    Response.Write "        </table>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    
    Response.Write "  <p align='center'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveConfig'>" & vbCrLf
    Response.Write "        <input name='cmdSave' type='submit' id='cmdSave' value=' 保存设置 '>" & vbCrLf
    Response.Write "      </p>" & vbCrLf

    Response.Write "</form>" & vbCrLf

End Sub
Sub SaveConfig()
    Dim sqlConfig, rsConfig
    sqlConfig = "select * from PE_StatInfoList"
    Set rsConfig = Server.CreateObject("ADODB.Recordset")
    rsConfig.Open sqlConfig, Conn_Counter, 1, 3
    If rsConfig.BOF And rsConfig.EOF Then
        rsConfig.AddNew
    End If
    rsConfig("MasterTimeZone") = PE_CLng(Trim(Request("MasterTimeZone")))
    rsConfig("OnlineTime") = PE_CLng(Trim(Request("OnlineTime")))
    rsConfig("VisitRecord") = PE_CLng(Trim(Request("VisitRecord")))
    rsConfig("IntervalNum") = PE_CLng(Trim(Request("IntervalNum")))
    rsConfig("KillRefresh") = PE_CLng(Trim(Request("KillRefresh")))
    rsConfig("OldTotalNum") = PE_CLng(Trim(Request("OldTotalNum")))
    rsConfig("OldTotalView") = PE_CLng(Trim(Request("OldTotalView")))
    rsConfig("RegFields_Fill") = ReplaceBadChar(Trim(Request("RegFields_Fill")))
    rsConfig.Update
    rsConfig.Close
    Set rsConfig = Nothing
    Call WriteSuccessMsg("网站统计配置保存成功！", ComeUrl)
End Sub


Sub Infolist()
    Dim StartDate, StatDayNum, AllNum, TotalView, CountNum, AveDayNum, DayNum
    Dim MonthMaxNum, MonthMaxDate, DayMaxNum, DayMaxDate, HourMaxNum, HourMaxTime, ZoneNum, ChinaNum, OtherNum
    Dim MaxBrw, MaxBrwNum, MaxSys, MaxSysNum, MaxScr, MaxScrNum, MaxAre, MaxAreNum, MaxWeb, MaxWebNum, MaxColor, MaxColorNum
    strGuide = "网站综合统计信息"
    sql = "Select * From PE_StatInfoList"

    Set rs = Server.CreateObject("adodb.recordset")
    rs.Open sql, Conn_Counter, 1, 1
    If Not rs.BOF And Not rs.EOF Then
        DayNum = rs("DayNum")
        AllNum = rs("TotalNum")
        TotalView = rs("TotalView")
        MonthMaxNum = rs("MonthMaxNum")
        MonthMaxDate = rs("MonthMaxDate")
        DayMaxNum = rs("DayMaxNum")
        DayMaxDate = rs("DayMaxDate")
        HourMaxNum = rs("HourMaxNum")
        HourMaxTime = rs("HourMaxTime")
        ChinaNum = rs("ChinaNum")
        OtherNum = rs("OtherNum")
        StartDate = rs("StartDate")
        StatDayNum = DateDiff("D", StartDate, Date) + 1
        If StatDayNum <= 0 Or IsNumeric(StatDayNum) = 0 Then
           AveDayNum = StatDayNum