[asp]基于application和session的简明网站访问统计程序

我自己写的一个基于application和session的asp简明统计程序.

原创作品,转载请注明出处。

<SCRIPT LANGUAGE = "VBSCRIPT" RUNAT="SERVER">
'===============================================================
'简明网站访问统计程序
'Author: 不见不散
'Version: 1.1
'撰写时间: 2006-1-21
'===============================================================
 Sub Application_OnStart
  '==============
  '在线人数
  '==============
  Application("online") = 0
  '==============
  '连接数据库
  '==============
  Application("str_conn") = "Provider = Microsoft.jet.oledb.4.0;data source = " & Server.MapPath("database\spider.mdb")
  Dim conn
  Set conn = Server.CreateObject("Adodb.Connection")
  conn.open Application("str_conn")
  '==============
  '获取数据
  '==============
  Dim rs,sql,TimeNow
  Set rs = Server.CreateObject("Adodb.RecordSet")
  sql = "Select * from stat"
  TimeNow = now()
  rs.open sql,conn,1,3
  '同一天的Application重启； 
  If Day(rs("today")) = Day(TimeNow) Then
   Application("now") = rs("today")
   '总访问记录
   Application("total") = rs("totalCount")
   '今天访问数
   Application("today") = rs("todayCount")
   '昨天访问数
   Application("yestoday") = rs("yestodayCount")
  '不同天的Application重启；
  Else
   '更新时间
   rs("today") = TimeNow
   '重获时间
   Application("now") = TimeNow
   '总访问记录
   Application("total") = rs("totalCount")
   '今天记录设为1
   Application("today") = 1
   '昨天记录
   Application("yestoday") = rs("todayCount")
  End If
   rs.Update
  '=============
  '清理
  '=============
  rs.Close
  Set rs = Nothing
  conn.Close
  Set conn = Nothing
 End Sub
'================================================================
 Sub Application_OnEnd
  '================
  '连接数据库
  '================
  Dim conn
  Set conn = Server.CreateObject("Adodb.Connection")
  conn.open Application("str_conn")
  '================
  '获取数据
  '================
  Dim rs,sql,TimeNow
  sql = "Select * From stat Order by id"
  TimeNow = now()
  Set rs = Server.CreateObject("Adodb.RecordSet")
  rs.Open sql,conn,1,3
 
  rs("totalCount") = Application("total")
  rs("yestodayCount") = Application("yestoday")
  rs("todayCount") = Application("today")
  rs("today") = TimeNow
  rs.Update
  '===============
  '清理
  '===============
  rs.close
  Set rs = Nothing
  conn.Close
  Set conn = Nothing
 End Sub
'================================================================
 Sub Session_OnStart
  '===========
  '是否换天
  '===========
  If Day(Application("now")) <> Day(now()) Then
   Application("now") = now()
   Application("yestoday") = Application("today")
   Application("today") = 1
  End If
 
  '在线计数
  Application.Lock()
  Application("online") = Application("online") + 1
 
  '访问计数
  Application("total") = Application("total") + 1
  Application("today") = Application("today") + 1
  Application.UnLock()
 End Sub
'================================================================
 Sub Session_OnEnd
  If Day(Application("now")) <> Day(now()) Then
   Application("now") = now()
   Application("yestoday") = Application("today")
   Application("today") = 0
  End If

  Dim StartTime
   StartTime = (Timer/60) mod 30
  If StartTime > 25 Then
   Call randRun
  End If
 
  Application.Lock()
  Application("online") = Application("online") - 1
  Application.UnLock()
 End Sub
'================================================================
 Sub randRun
  '=============================
  '随机储存，减少丢失数据机率。
  '=============================
  Dim StartTime,TimeNow
   StartTime = (Timer/60) mod 60
   TimeNow = now()
  Dim rs,sql,conn
   Set conn = Server.CreateObject("Adodb.Connection")
   conn.open Application("str_conn")
   Set rs = Server.CreateObject("Adodb.RecordSet")
   sql = "select * from stat order by id"
   rs.Open sql,conn,1,3
   rs("totalCount") = Application("total")
   rs("todayCount") = Application("today")
   rs("yestodayCount") = Application("yestoday")
   rs("today") = TimeNow
   rs.Update
   rs.Close
   Set rs = Nothing
 End Sub
</SCRIPT>