% 'response.buffer = true response.CacheControl = "must-revalidate, no-store" Dim namn Dim alder Dim dagar Dim MinCon Dim rs Dim SQL Dim nummer Dim basta(100) Dim farg Dim tid_timeout Dim adoCon Function farger(alder) farger="202040" If alder > 431 Then farger="404040" ElseIf alder > 439 Then farger="606060" ElseIf alder > 447 Then farger="808080" ElseIf alder > 455 Then farger="A0A0A0" ElseIf alder < 01 Then farger="FF0000" ElseIf alder < 03 Then farger="EE0000" ElseIf alder < 05 Then farger="DD0000" ElseIf alder < 07 Then farger="CC0000" ElseIf alder < 09 Then farger="BB0000" ElseIf alder < 11 Then farger="AA0000" ElseIf alder < 13 Then farger="990000" ElseIf alder < 15 Then farger="880000" ElseIf alder < 17 Then farger="770000" ElseIf alder < 19 Then farger="660000" ElseIf alder < 22 Then farger="550000" ElseIf alder < 25 Then farger="440000" ElseIf alder < 28 Then farger="330000" ElseIf alder < 30 Then farger="220000" End If End Function Function senaste (minuter) If minuter < 91 Then senaste = minuter & " minuter" ElseIf minuter < 1441 Then senaste = minuter \ 60 & " timmar och " & minuter - (minuter \ 60)* 60 & " minuter" Else senaste = minuter \ 1440 & " dagar och " & (minuter - (minuter \ 1440)* 1440) \ 60 & " timmar" End If End Function Function dublett(namn) Dim i Dim ledig ledig = 0 For i = 1 To 99 If basta(i)=namn Then dublett=True : Exit Function If ledig=0 And basta(i)="" Then ledig=i : Exit For Next basta(ledig)=namn dublett=False End Function Sub sjurovarlistan ' Sjurövarlistan uppdaterad = DateDiff("n",Application("SjuUppdat") , Now) If uppdaterad > 0 Or Len(Application("SjuTopp")) < 50 Then ' Gammal eller obefintlig sjurövarlista Set adoCon = Server.CreateObject("ADODB.Connection") Set rs = Server.CreateObject("ADODB.Recordset") strAccessDB = "C:\Inetpub\www.telder.com\admin\dbasen.mdb" strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strAccessDB 'This one is for Access 2000 adoCon.Open strCon SjuTopp ="" SQL = "SELECT *" SQL = SQL & " FROM tblSjurovare WHERE tblSjurovare.datum > #" & DateAdd("n", -43820, Now) & "#" SQL = SQL & " ORDER BY tblSjurovare.tid ASC" rs.Open SQL, adoCon ' nolladublett Do While not rs.EOF namn = rs("namn") If dublett(namn) = False Then alder=DateDiff("n", rs("datum"), Now) SjuTopp = SjuTopp & "
| Namn | " NyTopp = Nytopp & VbCrLf & "Tid | " NyTopp = Nytopp & VbCrLf & "Ø tid | " NyTopp = Nytopp & VbCrLf & " " Response.Write(NyTopp) sjurovarlistan %>
|---|