<% 'response.buffer = true response.CacheControl = "must-revalidate, no-store" Dim namn Dim alder Dim dagar Dim MinCon Dim rs Dim SQL Dim nummer Dim timmen Dim idag Dim veckan Dim manaden Dim totalt Dim basta(100) Dim farg Dim tid_timeout tid_timeout = 3 ' Hur ofta uppdatera innehållet på denna sidan uppdaterad = DateDiff("n",application("ToppUppdat") , Now) Sub SkrivTempfil Set fileObj=Server.CreateObject("Scripting.FileSystemObject") '---Open file set file1 = fileObj.OpenTextFile("D:\vb\Övervakning\temp.txt", 2, true)' Skriver över gamla filen file1.WriteLine("T" & application("TempThn") & "_" & FormatDateTime(Now,4)) file1.Close set file1=nothing set fileObj=nothing End Sub Function GetHTML(strPage) On Error Resume Next ' Set XMLHttp = Server.CreateObject ("Microsoft.XMLHTTP") Set XMLHttp = Server.CreateObject("MSXML2.ServerXMLHTTP") ' XMLHttp.Open "GET", strPage ,False,"","" ' XMLHttp.Send XMLHttp.Open "GET", strPage ,True,"","" ' True för asynkron begäran Call XMLHttp.Send() If XMLHttp.readyState <> 4 then XMLHttp.waitForResponse 2 End If If Err.Number = 0 Then If XMLHttp.Status = 200 then GetHTML = XMLHttp.ResponseText Else 'GetHTML = "Incorrect URL" GetHTML = "???" End if Else 'GetHTML = Err.Description GetHTML = "????" End If Set XMLHttp = Nothing 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 nolladublett Dim i For i = 1 To 99 ' response.write("
" & i & basta(i)) ' Felkoll! basta(i)="" Next End Sub If uppdaterad > tid_timeout Then ' Räkna ut lite statistik Set MinCon = Server.CreateObject("ADODB.Connection") Set rs = Server.CreateObject("ADODB.Recordset") MinCon.Open = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=C:\Inetpub\www.telder.com\admin\dbasen.mdb" 'SQL = "SELECT tblQuizTopplista.datum" 'SQL = SQL & " FROM tblQuizTopplista" 'rs.Open SQL, MinCon timmen=0 idag=0 veckan=0 manaden=0 totalt=0 'Do while Not rs.EOF ' alder=DateDiff("n", rs("datum"), Now) ' If alder < 60 Then ' timmen=timmen+1 ' idag=idag+1 ' veckan=veckan+1 ' manaden=manaden+1 ' ElseIf alder < 1440 Then ' idag=idag+1 ' veckan=veckan+1 ' manaden=manaden+1 ' ElseIf alder < 10080 Then ' veckan=veckan+1 ' manaden=manaden+1 ' ElseIf alder < 43800 Then ' manaden=manaden+1 ' End If ' totalt=totalt+1 ' rs.MoveNext 'Loop 'rs.close Set rs = MinCon.Execute("SELECT COUNT(*) AS antalPoster FROM tblQuizTopplista") totalt = rs("antalPoster") + 200000 ' + antal arkiverade poster Set rs = MinCon.Execute("SELECT COUNT(*) AS antalPoster FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -43800, Now) & "#") manaden = rs("antalPoster") 'Set rs = MinCon.Execute("SELECT COUNT(*) AS antalPoster FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -10080, Now) & "#") 'veckan = rs("antalPoster") Set rs = MinCon.Execute("SELECT COUNT(*) AS antalPoster FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -1440, Now) & "#") idag = rs("antalPoster") Set rs = MinCon.Execute("SELECT COUNT(*) AS antalPoster FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -60, Now) & "#") timmen = rs("antalPoster") rs.Close application("totalt") = totalt application("manaden") = manaden application("idag") = idag application("timmen") = timmen application("TempThn") = GetHTML("http://www.temperatur.nu/termo/trollhattan/temp.txt") 'application("TempThn") = "avstängd" 'Tempen if len(application("TempThn")) > 2 then application("TempThn") = left(application("TempThn"), len(application("TempThn"))-1) SkrivTempFil() Else 'Nyss laddad sida totalt = application("totalt") manaden = application("manaden") idag = application("idag") timmen = application("timmen") End If %> telder.com med ordspelet quiz

Quiz

Denna delen av telder.com innehåller den gamla versionen av Quiz.

Sidan kommer att finnas kvar ett tag, men bli medlem på nya sidan istället, den är om inte annat snyggare!

Här är länken till nya www.telder.com

/Dick

Quiz! 
Klicka rätt bland tio urvals­frågor på kort­ast möjliga tid
Är du bra, eller vill bli bra på svåra ord, så spela Quiz. Varje fråga slumpas fram bland över 1700 mer eller mindre kluriga ord så att din spel­omgång blir unik. Att spela detta ordspel är helt gratis. För att få med ditt namn i topplistan måste du vara inloggad, men det är enkelt att registrera sig. Nu finns även en topplista för de som lyckats få alla rätt sju spel i rad. Prova bums!

Lite statistik: Quiz har spelats
<% If timmen > 5 Then Response.Write(timmen & " gånger sista timmen,
") If idag > 5 Then Response.Write(idag & " gånger idag,
")%> <%=manaden%> gånger sista månaden, totalt <%=totalt%> gånger.<% If Application("BastSistaTimmen") <> "" Then Response.Write ("

Bäst sista timmen är:
" & Application("BastSistaTimmen") & "
") End If%> 		Veckans
bästa spelare
 <% If Len(application("Topp1")) < 50 Or uppdaterad > tid_timeout Then NyTopp = "" nummer=0 SQL = "SELECT *" SQL = SQL & " FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -10080, Now) & "#" SQL = SQL & " ORDER BY tblQuizTopplista.antal_ratt DESC , tblQuizTopplista.tid, tblQuizTopplista.datum DESC" 'response.write(sql) rs.Open SQL, MinCon 'rs.MoveFirst Do While not rs.EOF namn=rs("anvandare") If namn ="" Then namn="Anonym" If namn <> "Anonym" Then If dublett(namn)= False Then alder=DateDiff("n", rs("datum"), Now) farg="ffffff" If alder < 1400 Then farg="FFFFE0" If alder < 1300 Then farg="FFFFB0" If alder < 1200 Then farg="FFFF90" If alder < 1100 Then farg="FFFF60" If alder < 1000 Then farg="FFFF30" If alder < 900 Then farg="FFFF00" If alder < 800 Then farg="FFE000" If alder < 700 Then farg="FFC000" If alder < 600 Then farg="FFA000" If alder < 500 Then farg="FF8000" If alder < 400 Then farg="FF6000" If alder < 300 Then farg="FF4000" If alder < 200 Then farg="FF2000" If alder < 100 Then farg="FF0000" If alder > 9755 Then farg="F0F0F0" If alder > 9780 Then farg="E0E0E0" If alder > 9805 Then farg="D0D0D0" If alder > 9830 Then farg="C0C0C0" If alder > 9855 Then farg="B0B0B0" If alder > 9880 Then farg="A0A0A0" If alder > 9895 Then farg="909090" If alder > 9910 Then farg="808080" If alder > 9925 Then farg="707070" If alder > 9940 Then farg="606060" If alder > 9955 Then farg="505050" If alder > 9970 Then farg="505050" If alder > 9985 Then farg="505050" If alder > 10000 Then farg="000000" If alder > 10015 Then farg="000000" If alder > 10030 Then farg="000000" dagar=Round(alder/1440,1) If alder <= 91 Then gammalt = alder & " minuter gammalt rekord" ElseIf alder >= 1440 then gammalt = dagar & " dar gammalt rekord" Else gammalt = Round(alder/60,1) & " timmar gammalt rekord" End If NyTopp = NyTopp & "" & vbCrLf nummer = nummer + 1 End If End If rs.MoveNext If nummer => 20 Then Exit Do Loop rs.Close Response.Write(NyTopp) application("Topp1") = NyTopp application("Topp1Nummer") = nummer Else Response.Write(application("Topp1")) nummer = application("Topp1Nummer") End If %>
Namn Rätt Tid
" & namn & "
" & rs("antal_ratt") & "
" & FormatNumber(Round(rs("tid"),1),1) & "
<% If nummer < 19 Then If strLoggedInUsername="" Then ' Inte inloggad, vet ej om användaren är med på listan Response.Write("Är du med på listan?
Om inte, logga in och spela,
du är garanterad en plats!") ElseIf dublett(strLoggedInUsername) = True Then ' Användaren ÄR med på listan Response.Write("Tipsa gärna dina vänner om Quizzet!") Else Response.Write("Spela Quiz! Du är garanterad
en plats i topplistan!") End If End If%> 		Månadens
bästa spelare
<% If Len(application("Topp2")) < 50 Or uppdaterad > tid_timeout Then NyTopp = "" nummer=0 nolladublett SQL = "SELECT *" SQL = SQL & " FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -43800, Now) & "#" SQL = SQL & " ORDER BY tblQuizTopplista.antal_ratt DESC, tblQuizTopplista.tid, tblQuizTopplista.datum DESC" rs.Open SQL, MinCon ' rs.MoveFirst Do While not rs.EOF namn=rs("anvandare") If namn ="" Then namn="Anonym" If namn <> "Anonym" Then If dublett(namn)= False Then alder=DateDiff("n", rs("datum"), Now) farg="FFFFFF" If alder < 2800 Then farg="FFFFE0" If alder < 2600 Then farg="FFFFB0" If alder < 2400 Then farg="FFFF90" If alder < 2200 Then farg="FFFF60" If alder < 2000 Then farg="FFFF30" If alder < 1800 Then farg="FFFF00" If alder < 1600 Then farg="FFE000" If alder < 1400 Then farg="FFC000" If alder < 1200 Then farg="FFA000" If alder < 1000 Then farg="FF8000" If alder < 800 Then farg="FF6000" If alder < 600 Then farg="FF4000" If alder < 400 Then farg="FF2000" If alder < 200 Then farg="FF0000" If alder > 42200 Then farg="F0F0F0" If alder > 42300 Then farg="E0E0E0" If alder > 42400 Then farg="D0D0D0" If alder > 42500 Then farg="C0C0C0" If alder > 42600 Then farg="B0B0B0" If alder > 42700 Then farg="A0A0A0" If alder > 42800 Then farg="909090" If alder > 42900 Then farg="808080" If alder > 43300 Then farg="404040" If alder > 43400 Then farg="303030" If alder > 43500 Then farg="202020" If alder > 43600 Then farg="101010" If alder > 43700 Then farg="000000" dagar=Round(alder/1440,1) If dagar > 1 then gammalt = dagar & " dar gammalt rekord" Else gammalt = Round(alder/60,1) & " timmar gammalt rekord" End If NyTopp = NyTopp & "" & vbCrLf nummer = nummer + 1 End If End If rs.MoveNext If nummer => 20 Then Exit Do Loop rs.Close Response.Write(NyTopp) application("Topp2") = NyTopp application("ToppUppdat") = Now Else Response.Write(application("Topp2")) End If%>
Namn Rätt Tid
" & namn & "
" & rs("antal_ratt") & "
" & FormatNumber(Round(rs("tid"),1),1) & "

Röd-orange-gul är nya på listan, grå-svart är på väg ut...
Temperaturen i Trollhättan: <% Response.Write Application("TempThn") & "°C" %>
<% Set MinCon = Nothing Set rs = Nothing %>