PtokaX forum

Hi guys

got another pleed.... i used to have this trivia game on my old dchub. Its really gr8 cause it reads all questions from a mysql database so you could also have an intellegance battle between hubs hihi.
It would be great if someone could convert this to Lua
'TeamTrivia with database script 0.1 by Gadget
'This script needs MySQL database server on localhost and working MyODBC driver and ready-made
'databases with questions. No, i will not give email support for this, try http://dc.ww-ei.com forum

Dim sBotName,DB,RS,iQuestions,iHintDelay,iQuestionDelay,iContestDelay,iTicker,iMode,iStartTime
Dim sHint,iQID,sCategory,sQuestion,sAnswer,iAsked,iWrong,iCorrect,iTotalTime,iHints,sLastAsked,iQuestion
Dim iMaxTimeOuts,iTimeOuts,bStopRequest,iQuestionsPerGame,iGameQuestion,iSC,sStreak,iStreak,iCurMonth,iCurDay
Sub Main()
  sBotName          = "#TriviaBot"
  iHintDelay        = 20
  iQuestionDelay    = 30
  iContestDelay     = 120
  iMaxTimeOuts      = 10
  iQuestionsPerGame = 50
  sDBServer         = "localhost"
  sUsername         = "root"
  sPassword         = "password"
  sDBName           = "teamtrivia"
  Set DB = CreateObject("ADODB.Connection")
  DB.Open("driver={MySQL};server="+sDBServer+";uid="+sUsername+";pwd="+sPassword+";database="+sDBName)
  Set RS = createobject("ADODB.Recordset")
  Query="SELECT Count(*) AS Count FROM questions"
  RS.Open Query,DB
  iQuestions=RS("Count")
  RS.Close
  Query="SELECT DISTINCT Category FROM questions"
  RS.Open Query,DB
  Do While Not RS.EOF
    iCategories=iCategories+1
    RS.MoveNext
  Loop
  RS.Close
  Query="SELECT DISTINCT Name FROM scores"
  RS.Open Query,DB
  Do While Not RS.EOF
    iPlayers=iPlayers+1
    RS.MoveNext
  Loop  
  RS.Close
  Query="SELECT Sum(Overall) FROM scores"
  RS.Open Query,DB
  SendMessage("Trivia reset: There are "+CStr(iQuestions)+" questions in "+CStr(iCategories)+" categories. Player count "+CStr(iPlayers)+", overall score "+CStr(RS("Sum(Overall)"))+".")
  SendMessage("Type 'trivia start' to main chat to start the game or 'trivia help' to get instructions.")
  RS.Close
  iQid=0
  frmHub.RegisterBotName(sBotName)
  iMode=-1
  iTimeOuts=0
  bStopRequest=False
  On Error Resume Next
  Set wshShell=CreateObject("WScript.Shell")
  sTmp=wshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaDay")
  iCurDay=CDbl(sTmp)
  sTmp=wshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaMonth")
  iCurMonth=CDbl(sTmp)
  tmrScriptTimer.Interval=5000
  tmrScriptTimer.Enabled=True
  sMatchStart=Now
  iStartTime=Timer
  If sTopList("Game",10)<>"" Then SendMessage("TopTen of previous game:"+sTopList("Game",10))
  ResetMatch
  sStreak=""
  iStreak=0
End Sub

Sub tmrScriptTimer_Timer()
  iTicker=iTicker+5
  If Weekday(Now)<>iCurDay Then ResetDay
  If Month(Now)<>iCurMonth Then ResetMonth
  Select Case iMode
  Case -1
    iTicker=0
    iSC=0
    Exit Sub
  Case 0
    If bStopRequest Then
      bStopRequest=False
      SendMessage("Trivia is stopped.")
      iMode=-1
      Exit Sub
    End If
    iSC=0
    If iTicker=>iContestDelay Then
      SendMessage("Starting new game...")
      ResetMatch
      iMode=1
      iTicker=0
    End If
  Case 1
    If bStopRequest Then
      bStopRequest=False
      SendMessage("Trivia is stopped.")
      iMode=-1
      Exit Sub
    End If
    If iTicker=>iQuestionDelay Then
      GetQuestion
      sHint = ""
      For i = 1 to Len(sAnswer)
        a = Asc(LCase(Mid(sAnswer,i,1)))
        If (a>47 And a<58)Or(a>96 And a<123)Or a=196 Or a=197 Or a=214 Or a=228 Or a=229 Or a=246 Then
          sHint=sHint+"@"
        Else
          sHint=sHint+Mid(sAnswer,i,1)
        End If
      Next
      iGameQuestion=iGameQuestion+1
      SendMessage("Question "+CStr(iGameQuestion)+"/"+CStr(iQuestionsPerGame)+", category "+sCategory+": "+sQuestion+"?")
      iStartTime=Timer
      iSC=5
      iMode=2
      iTicker=0
      iAsked=iAsked+1
    End If
  Case 2
    If iTicker=>iHintDelay Then
      SendMessage("Question "+CStr(iGameQuestion)+"/"+CStr(iQuestionsPerGame)+", category "+sCategory+": "+sQuestion+"?")
      SendMessage("Hint 1: "+UCase(sHint))
      iSC=4
      iMode=3
      iTicker=0
      iHints=iHints+1
    End If
  Case 3
    If iTicker=>iHintDelay Then
      sHint=Left(sAnswer,1)
      For i=2 to Len(sAnswer)
        a = Asc(LCase(Mid(sAnswer,i,1)))
        If a>47 And a<58 Or a>96 And a<123 Then
          sHint=sHint+"@"
        Else
          If a = 32 Then
            sHint=sHint+Mid(sAnswer,i,1)
            i=i+1
          End If
          sHint=sHint+Mid(sAnswer,i,1)
        End If
      Next
      SendMessage("Question "+CStr(iGameQuestion)+"/"+CStr(iQuestionsPerGame)+", category "+sCategory+": "+sQuestion+"?")
      SendMessage("Hint 2: "+UCase(sHint))
      iSC=3
      iMode=4
      iTicker=0
      iHints=iHints+1
    End If
  Case 4
    If iTicker=>iHintDelay Then
      If Len(sAnswer)>3 Then
        For i=2 to Len(sAnswer) Step 4
          a=Mid(sHint,i,1)
          If a = "@" Then sHint=Left(sHint,i-1)+Mid(sAnswer,i,1)+Mid(sHint,i+1)
        Next
      End If
      SendMessage("Question "+CStr(iGameQuestion)+"/"+CStr(iQuestionsPerGame)+", category "+sCategory+": "+sQuestion+"?")
      SendMessage("Hint 3: "+UCase(sHint))
      iSC=2
      iMode=5
      iTicker=0
      iHints=iHints+1
    End If
  Case 5
    If iTicker=>iHintDelay Then
      If Len(sAnswer)>2 Then
        For i=2 to Len(sAnswer) Step 3
          a=LCase(Mid(sHint,i,1))
          If a = "@" Then sHint=Left(sHint,i-1)+Mid(sAnswer,i,1)+Mid(sHint,i+1)
        Next
      End If
      SendMessage("Question "+CStr(iGameQuestion)+"/"+CStr(iQuestionsPerGame)+", category "+sCategory+": "+sQuestion+"?")
      SendMessage("Last hint: "+UCase(sHint))
      iSC=1
      iMode=6
      iTicker=0
      iHints=iHints+1
    End If
  Case 6
    If iTicker=>iHintDelay Then
      SendMessage("Time is up. Answer was "+UCase(sAnswer))
      If iStreak>4 Then
        SendMessage("There goes "+sStreak+"'s winning streak of "+CStr(iStreak)+"!")
      End If
      sStreak=""
      iStreak=0
      iMode=1
      iTicker=0
      iTimeOuts=iTimeOuts+1
      Call CountStats("",0)
      If iGameQuestion=>iQuestionsPerGame Then
        SendMessage("Game over, new game starts after a moment. Winners of the round:"+sTopList("Game",10))
        ResetMatch
        iGameQuestion=0
        iMode=0
      End If
      If iTimeOuts>iMaxTimeOuts Then
        SendMessage("No correct answers in "+CStr(iMaxTimeOuts)+" last questions. Trivia is stopped.")
        iMode=-1
      End If
      iSC=0
    End If
  End Select
End Sub

Sub DataArival(curUser, sCurData)
  If Left(sCurData,1)<>"<" And Left(sCurData,Len(sBotName)+6)<>"$To: "+sBotName+" " Then Exit Sub
  sChat=Mid(sCurData,InStr(sCurData,">")+2)
  If sChat="" Then Exit Sub
  sReply=""
  If LCase(sChat)="trivia start" And iMode<1 Then
    iTicker=0
    iMode=1
    iTimeOuts=0
    sReply="Trivia is started."
  End If
  If LCase(sChat)="trivia stop" And iMode>0 Then
    sReply="Trivia stops after current question."
    bStopRequest=True
  End If
  If LCase(sChat)="trivia help" Then
    If Not curUser.bOperator Then
      curUser.PrivateMessage CStr(sBotName),"Welcome to TeamTrivia!"+vbCrLf+_
      "Available commands:"+vbCrLf+_
      "trivia start"+vbTab+vbTab+"Starts the game"+vbCrLf+_
      "trivia stop"+vbTab+vbTab+"Stops the game"+vbCrLf+_
      "trivia teams"+vbTab+"Shows teams"+vbCrLf+_
      "trivia join "+vbTab+"Select your team"+vbCrLf+_
      "trivia unjoin"+vbTab+"Reset team selection"+vbCrLf+_
      "trivia scores "+vbTab+"Shows scores of month, day of week or current game"+vbCrLf+_
      "trivia topten "+vbTab+"Shows topten lists of month, day of week or current game"+vbCrLf+_
      "trivia help"+vbTab+vbTab+"Shows this help"+vbCrLf+vbCrLf+_
      "Commands work by typing those to this window or main chat."
    Else
      curUser.PrivateMessage CStr(sBotName),"Welcome to TeamTrivia!"+vbCrLf+_
      "Available commands:"+vbCrLf+_
      "trivia start"+vbTab+vbTab+"Starts the game"+vbCrLf+_
      "trivia stop"+vbTab+vbTab+"Stops the game"+vbCrLf+_
      "trivia teams"+vbTab+"Shows teams"+vbCrLf+_
      "trivia create "+vbTab+"Creates a new team (or changes description)"+vbCrLf+_
      "trivia delete "+vbTab+vbTab+"Deletes a team"+vbCrLf+_
      "trivia open "+vbTab+vbTab+"Opens a team so that everybody can join it"+vbCrLf+_
      "trivia close "+vbTab+vbTab+"Closes a team"+vbCrLf+_
      "trivia join "+vbTab+"Select your team"+vbCrLf+_
      "trivia unjoin"+vbTab+"Reset team selection"+vbCrLf+_
      "trivia scores "+vbTab+"Shows scores of month, day of week or current game"+vbCrLf+_
      "trivia topten "+vbTab+"Shows topten lists of month, day of week or current game"+vbCrLf+_
      "trivia help"+vbTab+vbTab+"Shows this help"+vbCrLf+vbCrLf+_
      "Commands work by typing those to this window or main chat."
    End If
    Exit Sub
  End If
  If LCase(Left(sChat,14))="trivia create " And curUser.bOperator Then
    If InStr(15,sChat," ")>0 Then
      sReply=CreateTeam(Mid(sChat,15,InStr(15,sChat," ")-15),Mid(sChat,InStr(15,sChat," ")+1))
    Else
      sReply=CreateTeam(Mid(sChat,15),"")
    End If
  End If
  If LCase(Left(sChat,14))="trivia delete " And curUser.bOperator Then
    sReply=DeleteTeam(Mid(sChat,15))
  End If
  If LCase(Left(sChat,12))="trivia open " And curUser.bOperator Then
    sReply=SetTeamMode(Mid(sChat,13),0)
  End If
  If LCase(Left(sChat,13))="trivia close " And curUser.bOperator Then
    sReply=SetTeamMode(Mid(sChat,14),1)
  End If
  If LCase(Left(sChat,13))="trivia topten" Then
    If Len(sChat)>14 Then
      sReply=GetTopTen(Mid(sChat,15),10)
    Else
      sReply=GetTopTen("",10)
    End If
  End If
  If LCase(Left(sChat,13))="trivia scores" Then
    If Len(sChat)>14 Then
      curUser.PrivateMessage CStr(sBotName),CStr(GetTopTen(Mid(sChat,15),0))
    Else
      curUser.PrivateMessage CStr(sBotName),CStr(GetTopTen("",0))
    End If
    Exit Sub
  End If
  If LCase(Left(sChat,12))="trivia join " Then
    sReply=SetTeam(curUser.sName,Mid(sChat,12))
  End If
  If LCase(sChat)="trivia unjoin" Then
    sReply=SetTeam(curUser.sName,"")
  End If
  If LCase(sChat)="trivia teams" Then sReply="Following teams are in Trivia:"+sTeamList
  If sReply<>"" Then
    If Left(sCurData,1)="<" Then
      SendMessage(sReply)
    Else
      curUser.PrivateMessage CStr(sBotName),CStr(sReply)
    End If
    Exit Sub
  End If
  If Left(sCurData,1)<>"<" Then Exit Sub
  If iMode<2 Then Exit Sub
  If LCase(sChat)<>LCase(sAnswer) Then
    iWrong=iWrong+1
    Exit Sub
  End If
 

iTime=Timer-iStartTime
  If iTime>43200 Then iTime=iTime-43200
  If iTime<0 Then iTime=iTime+43200
  If iTime<0 Then iTime=0
  If iTime>iHintDelay*10 Then iTime=iHintDelay*10
  iMode=1
  iTicker=0
  iTimeOuts=0
  iTotalTime=Int(iTotalTime+iTime)
  iCorrect=iCorrect+1
  sTeam=GetTeam(curUser.sName)
  SendMessage(curUser.sName+"'s answer is correct: "+UCase(sAnswer)+". Time "+CStr(iTime)+" sec.")
  Call CountStats(curUser.sName,iSC)
  If sTeam<>"" Then
    iS1=iScoring(curUser.sName,"Game")
    iP1=iPlacement(iS1,"Game")
    iS2=iTScoring(sTeam,"Game")
    iP2=iTPlacement(iS2,"Game")
    SendMessage(curUser.sName+" got "+CStr(iSC)+" points, total "+CStr(iS1)+", ranking "+CStr(iP1)+". Team "+sTeam+" score "+CStr(iS2)+", ranking "+CStr(iP2)+".")
  Else
    iS1=iScoring(curUser.sName,"Game")
    iP1=iPlacement(iS1,"Game")
    SendMessage(curUser.sName+" got "+CStr(iSC)+" points, total "+CStr(iS1)+", ranking "+CStr(iP1)+".")
  End If
  If curUser.sName=sStreak Then
    iStreak=iStreak+1
    If iStreak>4 Then
      SendMessage("That was "+sStreak+"'s "+CStr(iStreak)+". correct answer in a row.")
    End If
  Else
    If iStreak>4 Then
      SendMessage("There goes "+sStreak+"'s winning streak of "+CStr(iStreak)+".")
    End If
    iStreak=1
    sStreak=curUser.sName
  End If
  iSC=0
  If iGameQuestion=>iQuestionsPerGame Then
    SendMessage("Game over, new game starts after a moment. Winners of the round:"+sTopList("Game",10))
    ResetMatch
    iGameQuestion=0
    iMode=0
  End If
End Sub

Sub CountStats(sWinner,iPoints)
  Query="UPDATE questions SET Asked="+CStr(iAsked)+",Wrong="+CStr(iWrong)+",Correct="+CStr(iCorrect)+",TotalTime="+CStr(iTotalTime)+",Hints="+CStr(iHints)+",LastAsked='"+sDbDate(Now)+"' WHERE QID="+CStr(iQID)
  RS.Open Query,DB
  If sWinner="" Or iPoints=0 Then Exit Sub
  Query="SELECT Team FROM scores WHERE Name='"+sCleanup(sWinner)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    RS.Close
    Query="INSERT INTO scores (Name) VALUES ('"+sCleanup(sWinner)+"')"
    RS.Open Query,DB
  Else
    RS.Close
  End If
  Query="UPDATE scores SET Overall=Overall+"+CStr(iPoints)+",Game=Game+"+CStr(iPoints)+_
    ",W"+CStr(Weekday(Now))+"=W"+CStr(Weekday(Now))+"+"+CStr(iPoints)+_
    ",M"+CStr(Month(Now))+"=M"+CStr(Month(Now))+"+"+CStr(iPoints)+_
    " WHERE Name='"+sCleanup(sWinner)+"'"
  RS.Open Query,DB
  sT=GetTeam(sWinner)
  If sT<>"" Then
    Query="UPDATE teams SET Overall=Overall+"+CStr(iPoints)+",Game=Game+"+CStr(iPoints)+_
      ",W"+CStr(Weekday(Now))+"=W"+CStr(Weekday(Now))+"+"+CStr(iPoints)+_
      ",M"+CStr(Month(Now))+"=M"+CStr(Month(Now))+"+"+CStr(iPoints)+_
      " WHERE Name='"+sCleanup(sT)+"'"
    RS.Open Query,DB
  End If
End Sub

Function iScoring(sUser,s)
  Query="SELECT "+s+" FROM scores Where Name='"+sCleanup(sUser)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    iScoring=0
  Else
    iScoring=RS(s)
  End If
  RS.Close
End Function

Function iTScoring(sTeam,s)
  Query="SELECT "+s+" FROM teams Where Name='"+sCleanup(sTeam)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    iTScoring=0
  Else
    iTScoring=RS(s)
  End If
  RS.Close
End Function

Function iPlacement(i,s)
  Query="SELECT Count(Name) FROM scores WHERE "+s+">"+CStr(i)
  RS.Open Query,DB
  iPlacement=RS("Count(Name)")+1
  RS.Close
End Function

Function iTPlacement(i,s)
  Query="SELECT Count(Name) FROM teams WHERE "+s+">"+CStr(i)
  RS.Open Query,DB
  iTPlacement=RS("Count(Name)")+1
  RS.Close
End Function

Function sFDate(sDate)
  sFDate=WeekDayName(Weekday(sDate), True)+" "+cStr(Day(sDate))+"."+cStr(Month(sDate))+"."+cStr(Year(sDate))+" "+FormatDateTime(sDate,4)+":"
  If Second(sDate)<10 Then sFDate=sFDate+"0"+CStr(Second(sDate)) else sFDate=sFDate+CStr(Second(sDate))
End Function

Function sDbDate(sDate)
  sDbDate=cStr(Year(sDate))+"-"+cStr(Month(sDate))+"-"+cStr(Day(sDate))+" "+FormatDateTime(sDate,4)+":"
  If Second(sDate)<10 Then sDbDate=sDbDate+"0"+CStr(Second(sDate)) else sDbDate=sDbDate+CStr(Second(sDate))
End Function

Sub ImportQuestions(sFileName)
  Set fso=CreateObject("Scripting.FileSystemObject")
  If Not fso.FileExists(sFileName) Then Exit Sub
  Set file=fso.OpenTextFile(sFileName,1,True)
  ReadFile=file.ReadLine
  Do While file.AtEndOfStream <> True
    Q=file.ReadLine
    If InStr(Q,": ")>0 Then
      sCat=Trim(Left(Q,InStr(Q,": ")-1))
      Q=Mid(Q,InStr(Q,": ")+2)
      If InStr(Q,"*")>1 Then
        sQue=Trim(Left(Q,InStr(Q,"*")-1))
        sAns=Trim(Mid(Q,InStr(Q,"*")+1))
        If sCat<>"" And sQue<>"" And sAns<>"" Then
          Call AddQuestion(sCat,sQue,sAns)
        End If
      End If
    End If
  Loop
  file.Close
End Sub

Sub AddQuestion(sAddCategory,sAddQuestion,sAddAnswer)
  Query="SELECT * FROM questions WHERE Question='"+sAddQuestion+"'"
  RS.Open Query,DB
  If RS.EOF Then
    Query="INSERT INTO questions (Category,Question,Answer,LastAsked) VALUES ('"+sAddCategory+"','"+sAddQuestion+"','"+sAddAnswer+"','"+sDBDate(Now)+"')"
  Else
    Query="UPDATE questions SET Category='"+sAddCategory+"',Answer='"+sAddAnswer+"' WHERE Question='"+sAddQuestion+"'"
  End If
  RS.Close
  RS.Open Query,DB
End Sub

Sub GetQuestion
  Query="SELECT Sum(Asked) AS SumAsked FROM questions"
  RS.Open Query,DB
  iQuestion=RS("SumAsked")
  RS.Close
  Query="SELECT * FROM questions ORDER BY RAND() LIMIT 1"
  RS.Open Query,DB
  iQID=RS("QID")
  sCategory=Replace(RS("Category"),"?","'")
  sQuestion=Replace(RS("Question"),"?","'")
  sAnswer=Replace(RS("Answer"),"?","'")
  iAsked=RS("Asked")
  iWrong=RS("Wrong")
  iCorrect=RS("Correct")
  iTotalTime=RS("TotalTime")
  iHints=RS("Hints")
  sLastAsked=RS("LastAsked")
  RS.Close
End Sub

Sub SendMessage(sMsg)
  colUsers.SendChatToAll CStr(sBotName),CStr(sMsg)
End Sub

Function CreateTeam(sName,sDescription)
  Query="SELECT Name FROM teams WHERE Name='"+sCleanup(sName)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    Query="INSERT INTO teams (Name,Description) VALUES ('"+sCleanup(sName)+"','"+sCleanup(sDescription)+"')"
    CreateTeam="Team '"+sCleanup(sName)+"' is added. You can join the team by typing 'trivia join "+sCleanup(sName)+"'"
  Else
    Query="UPDATE teams SET Description='"+sCleanup(sDescription)+"' WHERE Name='"+sCleanup(sName)+"'"
    CreateTeam="Description of team '"+sCleanup(sName)+"' is updated."
  End If
  RS.Close
  RS.Open Query,DB
End Function

Function DeleteTeam(sName)
  Query="SELECT Name FROM scores WHERE Team='"+sCleanup(sName)+"'"
  RS.Open Query,DB
  If Not RS.EOF Then
    DeleteTeam="Cannot delete team '"+sCleanup(sName)+"' because it's got members."
    RS.Close
    Exit Function
  End If
  RS.Close
  Query="DELETE FROM teams WHERE Name='"+sCleanup(sName)+"'"
  RS.Open Query,DB
  DeleteTeam="Team '"+sCleanup(sName)+"' is deleted."
End Function

Function SetTeamMode(sName,i)
  Query="SELECT Closed FROM teams WHERE Name='"+sCleanup(sName)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    SetTeamMode="There is no team named '"+sCleanup(sName)+"'."
    RS.Close
    Exit Function
  End If
  RS.Close
  Query="UPDATE teams SET Closed="+CStr(i)+" WHERE Name='"+sCleanup(sName)+"'"
  RS.Open Query,DB
  If i=0 Then
    SetTeamMode="Team '"+sCleanup(sName)+"' is now open for everyone."
  Else
    SetTeamMode="Team '"+sCleanup(sName)+"' is now closed."
  End If
End Function

Function GetTeam(sPlayer)
  Query="SELECT Team FROM scores WHERE Name='"+sCleanup(sPlayer)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    GetTeam=""
  Else
    GetTeam=CStr(RS("Team"))
  End If
  RS.Close
End Function

Function SetTeam(sPlayer,sTeam)
  If sTeam<>"" Then
    Query="SELECT Closed FROM teams WHERE Name='"+sCleanup(sTeam)+"'"
    RS.Open Query,DB
    If RS.EOF Then
      SetTeam="Cannot join team '"+sCleanup(sTeam)+"' because it wont exist."
      RS.Close
      Exit Function
    End If
    If RS("Closed")<>0 And Not colUsers.ItemByName(CStr(sPlayer)).bOperator Then
      SetTeam="You cannot join team '"+sCleanup(sTeam)+"' because it's closed."
      RS.Close
      Exit Function
    End If
    RS.Close
  End If
  Query="SELECT Team FROM scores WHERE Name='"+sCleanup(sPlayer)+"'"
  RS.Open Query,DB
  If RS.EOF Then
    Query="INSERT INTO scores (Name,Team) VALUES ('"+sCleanup(sPlayer)+"','"+sCleanup(sTeam)+"')"
  Else
    Query="UPDATE scores SET Team='"+sCleanup(sTeam)+"' WHERE Name='"+sCleanup(sPlayer)+"'"
  End If
  If sCleanup(sTeam)="" Then
    SetTeam="Player '"+sCleanup(sPlayer)+"' doesn't belong to any team now."
  Else
    SetTeam="Player '"+sCleanup(sPlayer)+"' has joined team '"+sCleanup(sTeam)+"'."
  End If
  RS.Close
  RS.Open Query,DB
End Function

Sub ResetMatch
  Query="UPDATE scores SET Game=0"
  RS.Open Query,DB
  Query="UPDATE teams SET Game=0"
  RS.Open Query,DB
End Sub

Sub ResetDay
  Query="UPDATE scores SET W"+CStr(Weekday(Now))+"=0"
  RS.Open Query,DB
  Query="UPDATE teams SET W"+CStr(Weekday(Now))+"=0"
  RS.Open Query,DB
  iCurDay=Weekday(Now)
  Set wshShell=CreateObject("WScript.Shell")
  wshShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaDay",CStr(iCurDay),"REG_SZ"
End Sub

Sub ResetMonth
  Query="UPDATE scores SET M"+CStr(Month(Now))+"=0"
  RS.Open Query,DB
  Query="UPDATE teams SET M"+CStr(Month(Now))+"=0"
  RS.Open Query,DB
  iCurMonth=Month(Now)
  Set wshShell=CreateObject("WScript.Shell")
  wshShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaMonth",CStr(iCurMonth),"REG_SZ"
End Sub

Function sCleanup(sString)
  sCleanup=Trim(Left(Replace(Replace(CStr(sString),"'","?"),Chr(34),"?"),60))
End Function

Function sTeamList
  Query="SELECT Name,Description,Overall,Closed FROM teams ORDER BY Name"
  RS.Open Query,DB
  Do While Not RS.EOF
    sTeamList=sTeamList+vbCrLf+RS("Name")+vbTab+RS("Description")+" ("+CStr(RS("Overall"))+" pistett?"
    If RS("Closed")=0 Then
      sTeamList=sTeamList+", open for everyone)"
    Else
      sTeamList=sTeamList+", closed)"
    End If
    RS.MoveNext
  Loop
  RS.Close
End Function

Function sTopList(sOrder,iLimit)
  Query="SELECT Name,"+sOrder+" FROM scores WHERE "+sOrder+">0 ORDER BY "+sOrder+" DESC"
  If iLimit>0 Then Query=Query+" LIMIT "+CStr(iLimit)
  RS.Open Query,DB
  i=0
  Do While Not RS.EOF
    i=i+1
    sTopList=sTopList+vbCrLf+CStr(i)+"."+vbTab+RS("Name")
    If Len(RS("Name"))<10 Then sTopList=sTopList+vbTab
    sTopList=sTopList+vbTab+Space(2*(9-Len(CStr(RS(sOrder)))))+CStr(RS(sOrder))
    RS.MoveNext
  Loop
  RS.Close
  Query="SELECT Name,"+sOrder+" FROM teams WHERE "+sOrder+">0 ORDER BY "+sOrder+" DESC"
  If iLimit>0 Then Query=Query+" LIMIT "+CStr(iLimit)
  RS.Open Query,DB
  i=0
  Do While Not RS.EOF
    i=i+1
    sTopList=sTopList+vbCrLf+CStr(i)+"."+vbTab+RS("Name")
    If Len(RS("Name"))<10 Then sTopList=sTopList+vbTab
    sTopList=sTopList+vbTab+Space(2*(9-Len(CStr(RS(sOrder)))))+CStr(RS(sOrder))
    RS.MoveNext
  Loop
  RS.Close
End Function



Function GetTopTen(sText,iLimit)
  Select Case Left(sText,4)
  Case "sund"
    GetTopTen="Sunday:"+sTopList("W1",iLimit)
  Case "mond"
    GetTopTen="Monday:"+sTopList("W2",iLimit)
  Case "tues"
    GetTopTen="Tuesday:"+sTopList("W3",iLimit)
  Case "wedn"
    GetTopTen="Wednesday:"+sTopList("W4",iLimit)
  Case "thur"
    GetTopTen="Thursday:"+sTopList("W5",iLimit)
  Case "frid"
    GetTopTen="Friday:"+sTopList("W6",iLimit)
  Case "satu"
    GetTopTen="Saturday:"+sTopList("W7",iLimit)
  Case "janu","1"
    GetTopTen="January:"+sTopList("M1",iLimit)
  Case "febr","2"
    GetTopTen="February:"+sTopList("M2",iLimit)
  Case "marc","3"
    GetTopTen="March:"+sTopList("M3",iLimit)
  Case "apri","4"
    GetTopTen="April:"+sTopList("M4",iLimit)
  Case "may","5"
    GetTopTen="May:"+sTopList("M5",iLimit)
  Case "june","6"
    GetTopTen="June:"+sTopList("M6",iLimit)
  Case "july","7"
    GetTopTen="July:"+sTopList("M7",iLimit)
  Case "augu","8"
    GetTopTen="August:"+sTopList("M8",iLimit)
  Case "sept","9"
    GetTopTen="September:"+sTopList("M9",iLimit)
  Case "octo","10"
    GetTopTen="October:"+sTopList("M10",iLimit)
  Case "nove","11"
    GetTopTen="November:"+sTopList("M11",iLimit)
  Case "dece","12"
    GetTopTen="December:"+sTopList("M12",iLimit)
  Case "this","0","now"
    GetTopTen="This month:"+sTopList("M"+CStr(Month(Now)),iLimit)
  Case "game"
    GetTopTen="Current game:"+sTopList("Game",iLimit)
  Case "all"
    GetTopTen="Overall:"+sTopList("Overall",iLimit)
  Case "yest"
    If Weekday(Now)>1 Then
      GetTopTen="Yesterday:"+sTopList("W"+CStr(Weekday(Now)-1),iLimit)
    Else
      GetTopTen="Yesterday:"+sTopList("W7",iLimit)
    End If
  Case Else
    GetTopTen="Today:"+sTopList("W"+CStr(Weekday(Now)),iLimit)
  End Select
End Function
Database Link VB Script:
'------ EDIT HERE ------
sDBServer = "localhost"
sUsername = "root"
sPassword = "password"
sDBName   = "teamtrivia"
sFilename = "trivia.lst"
'-----------------------
If MsgBox("Is this information correct?"+vbCrLf+"Server: "+sDBServer+vbCrLf+"Username: "+sUsername+vbCrLf+"Password: "+sPassword+vbCrLf+"Database: "+sDBName,4,"Check database information")=7 Then
  MsgBox("Please edit this script and set the info")
Else
  If MsgBox("Do you want to create the database?",4,"Create database")=6 Then
    Call CreateDatabase(sDBServer,sUsername,sPassword,sDBName)
    SetMonthDay
  End If
  If MsgBox("Do you want to import questions to the database?",4,"Create database")=6 Then
    Call ImportQuestions(sFilename,sDBServer,sUsername,sPassword,sDBName)
  End If
End If
Sub CreateDatabase(sDBServer,sUsername,sPassword,sDBName)
  Set DB = CreateObject("ADODB.Connection")
  DB.Open("driver={MySQL};server="+sDBServer+";uid="+sUsername+";pwd="+sPassword)
  Set RS = createobject("ADODB.Recordset")
  Query="CREATE DATABASE IF NOT EXISTS "+sDBName
  DB.Close
  DB.Open("driver={MySQL};server="+sDBServer+";uid="+sUsername+";pwd="+sPassword+";database="+sDBName+";")
  Query="CREATE TABLE IF NOT EXISTS questions (QID int(11) NOT NULL auto_increment, Category varchar(255) default '', Question varchar(255) default '', Answer varchar(255) default '', Asked int(11) default '0', Wrong int(11) default '0', TotalTime int(11) default '0', Hints int(11) default '0', LastAsked datetime default '0000-00-00 00:00:00', Correct int(11) default '0', PRIMARY KEY  (QID)) TYPE=InnoDB;"
  RS.Open Query,DB
  Query="CREATE TABLE IF NOT EXISTS scores (SID int(11) NOT NULL auto_increment, Name varchar(64) default '', Team varchar(64) default '', Overall int(11) default '0', M1 int(11) default '0', M2 int(11) default '0', M3 int(11) default '0', M4 int(11) default '0', M5 int(11) default '0', M6 int(11) default '0', M7 int(11) default '0', M8 int(11) default '0', M9 int(11) default '0', M10 int(11) default '0', M11 int(11) default '0', M12 int(11) default '0', W1 int(11) default '0', W2 int(11) default '0', W3 int(11) default '0', W4 int(11) default '0', W5 int(11) default '0', W6 int(11) default '0', W7 int(11) default '0', Game int(11) default '0', PRIMARY KEY  (SID)) TYPE=InnoDB;"
  RS.Open Query,DB
  Query="CREATE TABLE IF NOT EXISTS teams (GID int(11) NOT NULL auto_increment, Name varchar(64) default '', Description varchar(64) default '', Closed int(11) default '0', Overall int(11) default '0', M1 int(11) default '0', M2 int(11) default '0', M3 int(11) default '0', M4 int(11) default '0', M5 int(11) default '0', M6 int(11) default '0', M7 int(11) default '0', M8 int(11) default '0', M9 int(11) default '0', M10 int(11) default '0', M11 int(11) default '0', M12 int(11) default '0', W1 int(11) default '0', W2 int(11) default '0', W3 int(11) default '0', W4 int(11) default '0', W5 int(11) default '0', W6 int(11) default '0', W7 int(11) default '0', Game int(11) default '0', PRIMARY KEY  (GID)) TYPE=InnoDB;"
  RS.Open Query,DB
  Query="SELECT * FROM scores WHERE SID=1"
  RS.Open Query,DB
  If RS.EOF Then
    RS.Close
    Query="INSERT INTO scores (SID,Name) VALUES (1,'Trivia')"
    RS.Open Query,DB
  End If
End Sub
Sub SetMonthDay
  Set wshShell=CreateObject("WScript.Shell")
  wshShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaDay",CStr(Day(Now)),"REG_SZ"
  wshShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\NeoModus\Hub\TriviaMonth",CStr(Month(Now)),"REG_SZ"
End Sub
Sub ImportQuestions(sFilename,sDBServer,sUsername,sPassword,sDBName)
  sFile=InputBox("Type filename to be imported","Import questions",sFilename)
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.FileExists(sFile) Then
    MsgBox("File not found, try using full path.")
    Exit Sub
  End If
  MsgBox("Importing takes couple of minutes to hour depending count of questions and your processor speed after you press OK (nothing visible happening, script will pop up after this is done), just be patient and don't start this script again until it's done.")
  Set DB = CreateObject("ADODB.Connection")
  DB.Open("driver={MySQL};server="+sDBServer+";uid="+sUsername+";pwd="+sPassword+";database="+sDBName+";")
  Set RS = createobject("ADODB.Recordset")
  Set file=fso.OpenTextFile(sFile,1,False,0)
  Do While file.AtEndOfStream<>True
    sTmp=Trim(file.ReadLine)
    If InStr(sTmp,":")>0 Then
      sCategory=sParse(Trim(Left(sTmp,InStr(sTmp,":")-1)))
      sTmp=Mid(sTmp,InStr(sTmp,":")+1)
      If InStr(sTmp,"*")>0 Then
        sQuestion=sParse(Trim(Left(sTmp,InStr(sTmp,"*")-1)))
        sAnswer=sParse(Trim(Mid(sTmp,InStr(sTmp,"*")+1)))
        If sCategory<>"" And sQuestion<>"" And sAnswer<>"" Then
          Query="SELECT QID FROM questions WHERE Category='"+sCategory+"' AND Question='"+sQuestion+"'"
          RS.Open Query,DB
          If RS.EOF Then
            RS.Close
            Query="INSERT INTO questions (Category,Question,Answer) VALUES ('"+sCategory+"','"+sQuestion+"','"+sAnswer+"')"
            RS.Open Query,DB
            iCount=iCount+1
          Else
            RS.Close
          End If
        End If
      End If
    End If
  Loop
  MsgBox("Inserted "+CStr(iCount)+" new questions. Your database is now ready for playing.")
End Sub
Function sParse(sText)
  sParse=Replace(sText,"\","\\")
  sParse=Replace(sParse,Chr(34),"\"+chr(34))
  sParse=Replace(sParse,"'","\'")
End Function
And theres a PHP website to it as well to view Game



Would be gr8 to have this or something like it on a Pto Hub.

HI! Psycho_Chihuahua

Because i'm not a scripter i'll ask a Dumb Question... :D

all the posts u replied are one Trivia script?  ?(

BoJlk, yeah it is meant to be one single script ...
and BTW for those that havent noticed,... this is a VB script ... not a LUA script ... it doesnt work in any version of PtokaX I know of .. :)

QuoteOriginally posted by Herodes
BoJlk, yeah it is meant to be one single script ...
and BTW for those that havent noticed,... this is a VB script ... not a LUA script ... it doesnt work in any version of PtokaX I know of .. :)

Oh, well then that says everything i guess...thnx for the info herodes

We cant have a hub script for trivia that reads from a SQL database,
as unfortunatly lua 4 cannot access SQL.

A client side trivia may be able to access SQL as it used Lua 5, but i dont know client side yet :(