<%session.lcid=1053%> <% 'On Error Resume Next response.buffer = true response.AddHeader "Pragma", "No-Cache" Dim adoCon 'Database Connection Variable Dim tipsrad Dim spelarkaka Dim KanInteKaka Dim Kaka Dim MittSvar Dim FrageNummer Dim strStatus Dim rs Dim SQL Dim klotter 'Text som skall till klottret från QM Dim basta(100) Dim NyttRekord Dim uppdaterad Dim RsEXIST Dim koFr ' En komplett fråga Dim strLoggedInUsername Dim TidsJustering ' Antal sekunder för att få klotter att stämma TidsJustering = 3600 Function iso2utf(instrang) instrang= Replace(instrang,"å","Ã¥") instrang= Replace(instrang,"ä","ä") instrang= Replace(instrang,"ö","ö") instrang= Replace(instrang,"Å","Ã&") instrang= Replace(instrang,"Ä","Ã") instrang= Replace(instrang,"©","©") instrang= Replace(instrang,"°","°") instrang= Replace(instrang,"à","à") instrang= Replace(instrang,"á","á") instrang= Replace(instrang,"è","è") instrang= Replace(instrang,"ë","ë") instrang= Replace(instrang,"é","é") instrang= Replace(instrang,"ü","ü") iso2utf= Replace(instrang,"Ö","Ã") End Function Sub TillMySQLTopplista(ratt, tid) ' Skapar databasanslutningen. Set MinConn = Server.CreateObject("Adodb.Connection") ' Här är det jag förklarade innan. MinConn.Open "Driver={MySQL ODBC 3.51 Driver};server=localhost;uid=wosusr12;pwd=heTdu3h;database=wos12;" MinConn.Execute("INSERT INTO qz_topp (user_identity, ratt, tid, datum, old_nummer) VALUES( '" & iso2utf(strLoggedInUsername) & "','" & ratt & "','" & replace(tid, ",", ".") & "', '" & Now & "', 2000)") MinConn.Execute("INSERT INTO qz_topp_arkiv (user_identity, ratt, tid, datum, old_nummer) VALUES( '" & iso2utf(strLoggedInUsername) & "','" & ratt & "','" & replace(tid, ",", ".") & "', '" & Now & "', 2000)") ' Stänger databaskopplingen. MinConn.Close Set MinConn = Nothing End Sub Function DettaSpeletsNummer() ' Skapar databasanslutningen. Set MinConn = Server.CreateObject("Adodb.Connection") MinConn.Open "Driver={MySQL ODBC 3.51 Driver};server=localhost;uid=wosusr12;pwd=heTdu3h;database=wos12;" Set rs = Server.CreateObject("ADODB.Recordset") SQL = "SELECT MAX(spelnummer) AS tot FROM qz_topp" rs.Open SQL, MinConn DettaSpeletsNummer = rs("tot") ' Stänger databaskopplingen. rs.Close MinConn.Close Set rs = Nothing Set MinConn = Nothing End Function Sub Spelnummerkoll Dim SpNu Dim klotter SpNu = DettaSpeletsNummer() klotter = "" if SpNu = 500000 Then klotter = "Grattis " & strLoggedInUsername & ", du spelade spel nummer 500000 och vinner förutom äran dessutom tre Trisslotter" Elseif (SpNu mod 500) = 0 Then klotter = "Spel " & SpNu & " spelades av " & strLoggedInUsername End if If klotter <> "" Then ' Skapar databasanslutningen. Set MinConn = Server.CreateObject("Adodb.Connection") ' Här är det jag förklarade innan. MinConn.Open "Driver={MySQL ODBC 3.51 Driver};server=localhost;uid=wosusr12;pwd=heTdu3h;database=wos12;" MinConn.Execute("INSERT INTO wp_roeptumaar (naam, text, tijd, IP) VALUES( 'QuizMaskinen','" & iso2utf(klotter) & "', '" & DateDiff("s", "01/01/1970 00:00:00", Now()) - TidsJustering & "', '" & Request.ServerVariables("remote_addr") & "')") ' Stänger databaskopplingen. MinConn.Close Set MinConn = Nothing End If End Sub Function platsnamn2(siffra) If siffra < 10 Then platsnamn2 = "*spc**00" & siffra & "**spc*" ElseIf siffra < 100 Then platsnamn2 = "*spc**00" & siffra \ 10 & "**00" & siffra mod 10 & "**spc*" ElseIf siffra < 1000 Then platsnamn2 = "**spc*00" & siffra \ 100 & "**00" & siffra \ 10 & "**00" & siffra mod 10 & "**spc*" Else platsnamn2 = siffra End If End Function Function dublett(namn) ledig = 0 For q = 1 To 99 If basta(q)=namn Then dublett=True : Exit Function If ledig=0 And basta(q)="" Then ledig=q : Exit For Next basta(ledig)=namn dublett=False End Function Sub inpatopplistan If Not RsEXIST Then 'Create a connection odject Set adoCon = Server.CreateObject("ADODB.Connection") Set rs = Server.CreateObject("ADODB.Recordset") 'Initialise the strAccessDB variable with the path and name of the Access Database strAccessDB = "/admin/dbasen.mdb" 'Set an active connection to the Connection object strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(strAccessDB) 'This one is for Access 2000 adoCon.Open strCon RsEXIST = True End If SQL = "SELECT * FROM tblQuizTopplista WHERE tblQuizTopplista.datum > #" & DateAdd("n", -10080, Now) & "#" SQL = SQL & " ORDER BY tblQuizTopplista.antal_ratt DESC , tblQuizTopplista.tid, tblQuizTopplista.datum DESC" rs.Open SQL, adoCon Nummer = 0 NyttRekord = 0 Do While not rs.EOF namn = rs("anvandare") If namn = "" Then namn="Anonym" If dublett(namn) = False Then If namn = "Anonym" Then nummer = nummer - 1 ' Anonym ska ju inte räknas... nummer = nummer + 1 If tipsrad.AntalRatt > rs("antal_ratt") Then 'Nytt rekord, fler rätt än tidigare rekord, överst eller bästa med 9 rätt... NyttRekord = nummer If strLoggedInUsername = "" Then klotter = "" %>Plats <%=nummer%> på veckotopplistan hade varit din, om du varit inloggad!
<% Else klotter = strLoggedInUsername & " klättrar till plats " & NyttRekord End If Exit Do ElseIf tipsrad.AntalRatt = rs("antal_ratt") And (tipsrad.tid / 1000) < rs("tid") And strLoggedInUsername = namn Then ' Bättrat på sitt rekord, lika många rätt som tidigare, men inte stigit i listan ' NyttRekord = nummer ' klotter = "INSERT INTO tblKlotter (datum, anvandare, klotter, ip) VALUES ('" & Now & "','QM','Grattis " & strLoggedInUsername & " som bättrat på sitt resultat på " & platsnamn2(NyttRekord) & "!','" & Request.ServerVariables("remote_addr") & "')" Exit Do ElseIf tipsrad.AntalRatt = rs("antal_ratt") And (tipsrad.tid / 1000) < rs("tid") And strLoggedInUsername <> namn Then ' Bättrat på sitt rekord, lika många rätt som tidigare, och har klivit upp högre i listan NyttRekord = nummer If strLoggedInUsername = "" Then klotter = "" %>Plats <%=NyttRekord%> på veckotopplistan hade varit din, om du varit inloggad!
<% Else klotter = strLoggedInUsername & " klättrar till plats " & NyttRekord End If Exit Do ElseIf tipsrad.AntalRatt = rs("antal_ratt") And (tipsrad.tid / 1000) > rs("tid") And strLoggedInUsername = namn Then ' Sämre tid, ska inte vara med i topplistan Exit Do ElseIf tipsrad.AntalRatt < rs("antal_ratt") And strLoggedInUsername = namn Then ' Färre antal rätt, ska inte vara med i topplistan Exit Do End If End If rs.MoveNext If nummer => 20 Then Exit Do Loop rs.Close ' Set rs = Nothing If (NyttRekord > 0) And klotter <> "" Then ' Nytt rekord som QM ska klottra om ' Skapar databasanslutningen. Set MinConn = Server.CreateObject("Adodb.Connection") ' Här är det jag förklarade innan. MinConn.Open "Driver={MySQL ODBC 3.51 Driver};server=localhost;uid=wosusr12;pwd=heTdu3h;database=wos12;" MinConn.Execute("INSERT INTO wp_roeptumaar (naam, text, tijd, IP) VALUES( 'QuizMaskinen','" & iso2utf(klotter) & "', '" & DateDiff("s", "01/01/1970 00:00:00", Now()) - TidsJustering & "', '" & Request.ServerVariables("remote_addr") & "')") 'Originalraden INSERT INTO wp_roeptumaar (naam, http, email, text, IP,tijd) VALUES ('$vem','','','$text','$ip','$tijd') klotter="" ' Stänger databaskopplingen. MinConn.Close Set MinConn = Nothing 'Skriv ut i en fil Set fileObj=Server.CreateObject("Scripting.FileSystemObject") If (fileObj.FileExists("D:\vb\Övervakning\Klotter.txt"))=true Then '---Open file set file1 = fileObj.OpenTextFile("D:\vb\Övervakning\Klotter.txt",8,true)' 1=Write 2=read 8=append Else '---create file set file1=fileObj.CreateTextFile("D:\vb\Övervakning\Klotter.txt",true) End If file1.WriteLine("QM: " & Time & "Nytt rekord av " & strLoggedInUsername & ", som hamnade på plats " & NyttRekord & " med " & tipsrad.AntalRatt & " rätt på " & (tipsrad.tid / 1000) & " sekunder.") file1.Close set file1=nothing set fileObj=nothing End If End Sub Sub kollaomsjurovare 'Är detta en Sjurövare? If tipsrad.AntalRatt = 10 Then If Not RsEXIST Then Set rs = Server.CreateObject("ADODB.Recordset") RsEXIST = True End If SQL = "SELECT SUM(tblQuizTopplista.antal_ratt) As antr, SUM(tid) As zumma" SQL = SQL & " FROM (SELECT TOP 6 antal_ratt, anvandare, nummer, tid FROM tblQuizTopplista WHERE tblQuizTopplista.anvandare ='" & strLoggedInUsername & "' ORDER BY nummer DESC)" rs.Open SQL, adoCon If rs("antr") = 60 Then' Alla rätt i de senaste sex omgångarna zumma = rs("zumma") + (tipsrad.tid / 1000) ' Lägg ihop tiden för de senaste sju omgångarna... rs.Close SQL = "INSERT INTO tblSjurovare (tid, datum, namn) VALUES ('" & zumma & "','" & Now & "','" & strLoggedInUsername & "')" adoCon.Execute SQL SQL = "DELETE FROM tblSjurovare WHERE namn = '" & strLoggedInUsername & "' AND tid > " & zumma ' Ta bort sämre och äldre poster i Sjurövarlistan SQL = Replace(SQL, ",", ".") adoCon.Execute SQL %>Nu gjorde du en Sjurövare på <%=Round(zumma,1)%> sekunder, i genomsnitt <%=Round(zumma/7,1)%> sekunder!
<% Else rs.Close End If End If ' Set rs = Nothing End Sub Sub spararesultatitopplistan 'Spara resultatet i topplistan If strLoggedInUsername <> "Dick" Then SQL = "INSERT INTO tblQuizTopplista (antal_ratt, tid, datum, anvandare) VALUES ('" & tipsrad.AntalRatt & "','" & tipsrad.tid / 1000 & "','" & Now() & "','" & strLoggedInUsername & "')" ' response.write SQL adoCon.Execute SQL TillMySQLTopplista tipsrad.AntalRatt, tipsrad.tid / 1000 End If End Sub Sub Felsvar(fr_num) ' Skriv ut rätt svar till felaktigt besvarad fråga. Mellanord = "är en" ' Select Case Tipsrad.OrdStatus(fr_num) ' Case "s", "a", "v", "sjuk" ' Mellanord = "betyder" ' Case "pers" ' Mellanord = "är en" ' Case Else ' Mellanord = "betyder" ' End Select If Left(Tipsrad.FelSvar(fr_num),3) = "en " Then Mellanord = "är" If Left(Tipsrad.FelSvar(fr_num),4) = "ett " Then Mellanord = "är" Response.Write("" & Tipsrad.FelFraga(fr_num) & " " & Mellanord & " " & Tipsrad.FelSvar(fr_num) & "") Application("SenasteFelet") = Tipsrad.FelFraga(fr_num) ' För att lägga ut i raden för kolla ord ' If Not IsNull(Tipsrad.FelHjalptext(fr_num)) Then If Len(Tipsrad.FelHjalptext(fr_num)) > 2 Then Response.Write(" (" & Tipsrad.FelHjalptext(fr_num) & ").") ElseIf Right(Tipsrad.FelSvar(fr_num),1) <> "." Then Response.Write(".") End If End Sub RsEXIST = False If Request.QueryString("k") = "y" Then strStatus = "SLUT" KanInteKaka = False Klottrat = True Else ' instansiera DLL genom att använda createobject Set tipsrad = Server.CreateObject("tipsrad.tips") Klottrat = False tipsrad.TotaltAntalFragor(10) tipsrad.DataBasNamn("D:\vb\tipsrad\tipsradsdatabas.mdb") Kaka = Request.Cookies("spelar_id") spelarkaka = tipsrad.kaka(Kaka) If spelarkaka = "" then spelarkaka = "no_good" Response.Cookies("spelar_id") = spelarkaka If isEmpty(Request.Cookies("spelar_id")) = True Then KanInteKaka = True 'Hämta Svaret och vilken fråga det gällde från förra frågan MittSvar = Request.QueryString("mittsvar") FrageNummer = Request.QueryString("FrageNummer") 'Skicka svaret till DLL-filen tipsrad.SvarsFrageNummer(FrageNummer) strStatus = tipsrad.MittSvar(MittSvar) End If 'Här börjar sidan Här börjar sidan Här börjar sidan Här börjar sidan Här börjar sidan Här börjar sidan Här börjar sidan If KanInteKaka = True Then %> telder.com - quiz
Din webbläsare returnerar inga kakor.
Ingen kaka - ingen quizrad!
<% ElseIf strStatus = "OK" Then %> telder.com - quiz <% 'Skicka ut en fråga: kofr = "" & vbcrlf kofr = kofr & "" & vbcrlf & " " & vbcrlf For q = 1 To 5 if tipsrad.FrageNummer = 10 then kofr = kofr & " " & vbcrlf & " " & vbcrlf & _ " " & vbcrlf & " " & vbcrlf Next kofr = kofr & "" & " " & vbcrlf kofr = kofr & "
 
" & vbcrlf kofr = kofr & "  " & tipsrad.FrageNummer & " Vad betyder:
" & vbcrlf kofr = kofr & "    " & tipsrad.Fraga & "?" & vbcrlf & "
" & vbcrlf Else kofr = kofr & "
" & vbcrlf End If kofr = kofr & " " & vbcrlf kofr = kofr & "  " & q & "  " & tipsrad.Alternativ(q) & "  " & vbcrlf kofr = kofr & "
 
" & vbcrlf 'response.write Session("quiznamn") response.write kofr 'session("tips1") = kofr %> <% ElseIf strStatus = "INGET SVAR" Then ' Spara ett nollresultat i topplistan %> telder.com - quiz
Det bidde fel på nåt sätt. Klicka här någonstans för att börja om från början!
<% ElseIf strStatus = "SLUT" And Klottrat = False Then strLoggedInUsername = Session("quiznamn") %> telder.com - quiz <% Else%>Du svarade rätt på <%=tipsrad.AntalRatt%> av 10 frågor på <%=Round(tipsrad.tid / 1000,1)%> sekunder. <% ' Efter en fullbordad spelomgång If strLoggedInUsername <> "Dick" Then ' Addera till statistiken på framsidan ifall den körs cachad application("totalt") = application("totalt") + 1 inpatopplistan 'inpatopplistan inpatopplistan inpatopplistan inpatopplistan inpatopplistan inpatopplistan If strLoggedInUsername <> "" Then kollaomsjurovare 'kollaomsjurovare kollaomsjurovare kollaomsjurovare kollaomsjurovare kollaomsjurovare kollaomsjurovare End If spararesultatitopplistan 'spararesultatitopplistan spararesultatitopplistan spararesultatitopplistan spararesultatitopplistan Spelnummerkoll ' Spelnummerkoll Spelnummerkoll Spelnummerkoll Spelnummerkoll End If %>
<% 'Skriva ut antal rätt och fel.. If tipsrad.AntalRatt = 10 Then %>
Grattis<%If strLoggedInUsername <> "" Then Response.Write (" " & strLoggedInUsername) %>!
Du lyckades svara rätt på alla <%=tipsrad.TotaltAntalFragor%> frågorna på <%=Round(tipsrad.tid / 1000,1)%> sekunder. <% ElseIf tipsrad.AntalRatt = 9 Then %>Inte illa<%If strLoggedInUsername <> "" Then Response.Write (" " & strLoggedInUsername)%>, 9 rätt på <%=Round(tipsrad.tid / 1000,1)%> sekunder.


Frågan du missade:
<%FelSvar(1)%>
Ett par tips:
<% FelSvar(1)%>
<% FelSvar(2)%>
<% End If %>
Spela igen!
Quizfärg:  Gul Grå mBlå
<% ElseIf strStatus = "SLUT" And Klottrat = True Then 'Kolla namnet på spelaren kod = Request.QueryString("h") namn = Request.QueryString("namn") hashkod = MD5(namn) nyhashkod = right(hashkod,24) & left(hashkod,8) 'response.Write(nyhashkod & "
") 'response.Write(kod & "
") if nyhashkod = kod then ' response.Write(namn & " OK
") strLoggedInUsername = namn else strLoggedInUsername = "" end if Session.Timeout=120 Session("quiznamn") = strLoggedInUsername %> telder.com - quiz
Spela Quiz!
Spelet är jätteenkelt, men frågorna är kluriga! Du får tio frågor, klicka så snabbt som möjligt på rätt svar, eller chansa! Spela så många gånger du vill!

   Klicka för att starta!    <%=Session("quizname")%>
<% End If ' Frigöra objektet från minnet If RsEXIST Then Set rs = Nothing adoCon.Close Set adoCon = Nothing End If Set tipsrad = Nothing %>