<% test_ip=Request.ServerVariables("REMOTE_ADDR") test_label=len(Request.ServerVariables("HTTP_USER_AGENT"))*1000 + len(Request.ServerVariables("HTTP_ACCEPT")) response.redirect ("http://www.vkerker.de/kerker/online.asp") response.redirect ("http://81.20.132.139/kerker/online.asp") response.redirect ("http://kerker.dnip.net/kerker/online.asp") response.redirect ("http://kerker.no-ip.org/kerker/online.asp") response.end %> <% Randomize(time()) jetzt=now() aktiv_timeout=5 pasiv_timeout=30 refresh_timeout=95 Sub LogActiveUser Dim strActiveUserList Dim intUserStart, intUserEnd Dim strUser Dim strDate strActiveUserList = Application("_Active_User_List") If Instr(1, strActiveUserList, Session.SessionID) > 0 Then Application.Lock intUserStart = Instr(1, strActiveUserList, Session.SessionID) intUserEnd = Instr(intUserStart, strActiveUserList, "|") strUser = Mid(strActiveUserList, intUserStart, intUserEnd - intUserStart) strActiveUserList = Replace(strActiveUserList, strUser, Session.SessionID & ":" & Now()) Application("_Active_User_List") = strActiveUserList Application.UnLock Else Application.Lock application("visits") = application("visits") + 1 application("_Active_Users") = CInt(application("_Active_Users")) + 1 Application("_Active_User_List") = Application("_Active_User_List") & Session.SessionID & ":" & Now() & "|" Application.UnLock End If End Sub Sub ActiveUserCleanup Dim ix Dim intUsers Dim strActiveUserList Dim aActiveUsers Dim intActiveUserCleanupTime Dim intActiveUserTimeout intActiveUserCleanupTime = 1 'In minutes, how often should the ActiveUserList be cleaned up. intActiveUserTimeout = 3 'In minutes, how long before a User is considered Inactive and is deleted from ActiveUserList If Application("_Active_User_List") = "" Then Exit Sub If DateDiff("n", Application("ActiveUsersLastCleanup"), Now()) > intActiveUserCleanupTime Then Application.Lock Application("ActiveUsersLastCleanup") = Now() Application.Unlock intUsers = 0 strActiveUserList = Application("_Active_User_List") strActiveUserList = Left(strActiveUserList, Len(strActiveUserList) - 1) aActiveUsers = Split(strActiveUserList, "|") For ix = 0 To UBound(aActiveUsers) If DateDiff("n", Mid(aActiveUsers(ix), Instr(1, aActiveUsers(ix), ":") + 1, Len(aActiveUsers(ix))), Now()) > intActiveUserTimeout Then aActiveUsers(ix) = "XXXX" Else intUsers = intUsers + 1 End If Next strActiveUserList = Join(aActiveUsers, "|") & "|" strActiveUserList = Replace(strActiveUserList, "XXXX|", "") Application.Lock Application("_Active_User_List") = strActiveUserList application("_Active_Users") = intUsers Application.UnLock End If End Sub if Application("user") > 0 then application.lock user=Application("user") logoff=0 aktive=0 u=0 do u=u+1 if datediff( "n",application(u & "t_post"),jetzt) < aktiv_timeout then if application(u & "raum") = raum then aktive=1 end if end if if datediff( "n",application(u & "t_post"),jetzt) > pasiv_timeout then if (application(u & "status") < 3) then logoff=u end if end if if datediff( "s",application(u & "t_refresh"),jetzt) > refresh_timeout then logoff=u end if loop until u=user if logoff <> 0 then add=0 u=0 do u=u+1 uu=u+add if u = logoff then add=-1 zeitzone = 0 uz = "" n = now() if hour(n)<10 then uz = "0" & hour(n) else uz = hour(n) if minute(n)<10 then uz = uz & ":" & "0" & minute(n) & ":" else uz = uz & ":" & minute(n) & ":" if second(n)<10 then uz = uz & "0" & second(n) else uz = uz & second(n) uhrzeit = "" & uz & "" springraum=application(u & "raum") for x=29 to 1 step -1 Application(springraum & x+1)=Application(springraum & x) next if (id_nr/2) < (id_nr\2) then Application(springraum & "1") = "Türsklavin: " & application(u & "nick") & " ist aus dem Fenster gesprungen" else Application(springraum & "1") = "Türsklave: " & application(u & "nick") & " ist aus dem Fenster gesprungen" end if end if application(uu & "id") = application(u & "id") application(uu & "ip") = application(u & "ip") application(uu & "user") = application(u & "user") application(uu & "nick") = application(u & "nick") application(uu & "pw") = application(u & "pw") application(uu & "status") = application(u & "status") application(uu & "flag") = application(u & "flag") application(uu & "farbe") = application(u & "farbe") application(uu & "t_login") = application(u & "t_login") application(uu & "t_post") = application(u & "t_post") application(uu & "t_refresh") = application(u & "t_refresh") application(uu & "info") = application(u & "info") application(uu & "sound") = application(u & "sound") application(uu & "fl") = application(u & "fl") application(uu & "raum") = application(u & "raum") application(uu & "mail") = application(u & "mail") application(uu & "memo") = application(u & "memo") loop until u=user application(user & "id") = "" application(user & "ip") = "" application(user & "user") = "" application(user & "nick") = "" application(user & "pw") = "" application(user & "status") = "" application(user & "flag") = "" application(user & "farbe") = "" application(user & "t_login") = "" application(user & "t_post") = "" application(user & "t_refresh") = "" application(user & "info") = "" application(user & "sound") = "" application(user & "fl") = "" application(user & "raum") = "" application(user & "mail") = "" application(user & "memo") = "" application("user")=user -1 for u=0 to application("user") if (application(u & "mail")="1") or (application(u & "mail")="3") then application(u & "sound") = "../sounds/klirr.wav" end if next addsprungpunkt=false for u=1 to Application("user") if application(u & "user") = "Blackandshiny" then addsprungpunkt=true end if next if false and addsprungpunkt then ' anfang lesen ---------------------------------- strDateiname = Server.MapPath("/users/bas.cnt") Set objFs = CreateObject("Scripting.FileSystemObject") Set bas_file = objFs.OpenTextFile(strDateiname, 1) bas_cnt=bas_file.readall bas_file.close set bas_file = nothing set objfs = nothing ' ende lesen ------------------------------------ bas_cnt=bas_cnt+1 ' anfang schreiben ---------------------------------- strDateiname = Server.MapPath("/users/bas.cnt") Set objFs = CreateObject("Scripting.FileSystemObject") Set bas_file = objFs.OpenTextFile(strDateiname, 2, false) bas_file.writeline bas_cnt bas_file.close set bas_file = nothing set objfs = nothing ' ende schreiben------------------------------------ end if ' Die Zeile ins Logfile schreiben ---------------------------------- if application("logfile") then strDateiname = Server.MapPath("/~(db/logs") & "\3_" & replace(date,".","") & ".htm" Set objFs = CreateObject("Scripting.FileSystemObject") if not objfs.fileexists(strDateiname) then Set logfile = objFs.OpenTextFile(strDateiname, 8, true) logfile.writeline "Der Kerker - Logfile vom " & replace(date,"/",".") & "" else Set logfile = objFs.OpenTextFile(strDateiname, 8, true) end if logfile.writeline springraum & "-" & Application(springraum & "1") & "
" logfile.close set loglife = nothing set objfs = nothing end if ' Logfile Ende ----------------------------------------------------- application.unlock end if end if %> online <% Call LogActiveUser() Call ActiveUserCleanup() if len(application("counterurl")) < 1 then application.lock application("counterurl") = "http://www.neckel.com/pphlogger" application.unlock end if %> Im Chat: <% =Application("user")%>
Online:
Gesamt: