Besuchszähler aus der GLOBAL.ASA

[Flaimo]

in der microsoft IIS newsgroup hat jemand vor einiger zeit das hier gepostet. habs selber nicht getestet. bei mir wuerde sowieso immer nur 1 dortstehen ;-)

------------------------------

du benotigst eine datenbank mit den mit zwei feldern! (bei mir Sessions &
TrackDate)
diese sollte sich in einem Verz. befindet in welchem schreibrechte gestetzt
sind.

jetzt benoetigts du nur noch folgendes Script:

<SCRIPT LANGUAGE="VBScript" RUNAT="Server">

On Error Resume Next

Sub Application_OnStart
Application("ActiveUsers") = 0
End Sub

Sub Session_OnStart
Dim SQL, RS, oConn, TotalSessions, TodaySessions
Dim DBDriver, DBPath, DBUser, DBPass

Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Open "DSN=nxs-ecards"

SQL = "Select Sessions From Sessions Where TrackDate = '" & Date() & "'"
Set RS = oConn.Execute(SQL)

If RS.EOF Then
  NewTotal = 1
  SQL = "Insert Into Sessions (TrackDate, Sessions) "
  SQL = SQL & "Values ('" & Date() & "', " & NewTotal & ")"
Else
  NewTotal = CInt(RS("Sessions")) + 1
  SQL = "Update Sessions Set Sessions = " & NewTotal & " "
  SQL = SQL & "Where TrackDate = '" & Date() & "'"
End If

Set RS = Nothing

oConn.Execute(SQL)

SQL = "Select Sum(Sessions) As TotalSessions From Sessions"
Set RS = oConn.Execute(SQL)
TotalSessions = RS("TotalSessions")
Set RS = Nothing

SQL = "Select Sessions From Sessions "
SQL = SQL & "Where TrackDate = '" & Date() & "'"
Set RS = oConn.Execute(SQL)
TodaySessions = RS("Sessions")
Set RS = Nothing

oConn.Close
Set oConn = Nothing

Session.Timeout = 10
Session("Start") = Now

Application.Lock
  Application("TotalSessions") = TotalSessions
  Application("TodaySessions") = TodaySessions
  Application("ActiveUsers") = Application("ActiveUsers") + 1
Application.Unlock
End Sub

Sub Session_OnEnd
Application.Lock
  Application("ActiveUsers") = Application("ActiveUsers") - 1
Application.UnLock
End Sub

</SCRIPT>

------------------------------------

auf einer anderen seite hab ich mal dieses script gefunden:

------------------------------------

<SCRIPT LANGUAGE="VBScript" RUNAT="Server">

On Error Resume Next

Sub Application_OnStart
Application("ActiveUsers") = 0
End Sub

Sub Session_OnStart
Dim SQL, RS, oConn, TotalSessions, TodaySessions
Dim DBDriver, DBPath, DBUser, DBPass

Set oConn = Server.CreateObject("ADODB.Connection")
oConn.Open "DSN=nxs-ecards"

SQL = "Select Sessions From Sessions Where TrackDate = '" & Date() & "'"
Set RS = oConn.Execute(SQL)

If RS.EOF Then
  NewTotal = 1
  SQL = "Insert Into Sessions (TrackDate, Sessions) "
  SQL = SQL & "Values ('" & Date() & "', " & NewTotal & ")"
Else
  NewTotal = CInt(RS("Sessions")) + 1
  SQL = "Update Sessions Set Sessions = " & NewTotal & " "
  SQL = SQL & "Where TrackDate = '" & Date() & "'"
End If

Set RS = Nothing

oConn.Execute(SQL)

SQL = "Select Sum(Sessions) As TotalSessions From Sessions"
Set RS = oConn.Execute(SQL)
TotalSessions = RS("TotalSessions")
Set RS = Nothing

SQL = "Select Sessions From Sessions "
SQL = SQL & "Where TrackDate = '" & Date() & "'"
Set RS = oConn.Execute(SQL)
TodaySessions = RS("Sessions")
Set RS = Nothing

oConn.Close
Set oConn = Nothing

Session.Timeout = 10
Session("Start") = Now

Application.Lock
  Application("TotalSessions") = TotalSessions
  Application("TodaySessions") = TodaySessions
  Application("ActiveUsers") = Application("ActiveUsers") + 1
Application.Unlock
End Sub

Sub Session_OnEnd
Application.Lock
  Application("ActiveUsers") = Application("ActiveUsers") - 1
Application.UnLock
End Sub

</SCRIPT>