Nice Trivia

This is a discussion on Nice Trivia within the Warcraft 3 Hacks, bots and tools board part of the Warcraft 3 forum category; Code: 'trivia '1.0 '*********************************************************** Public trivia, fso, trivFile, D2s, score Public q, a, numberQs, qnum, numQsAsked, askedQs Public hints, hintstr, ...

Results 1 to 7 of 7
  1. #1
    lolercakess's Avatar
    lolercakess is offline Member
    Array
    Join Date
    Jul 2007
    Posts
    49
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    11
    Reputation
    41

    Nice Trivia

    Code:
    'trivia
    '1.0
    '***********************************************************
    Public trivia, fso, trivFile, D2s, score
    Public q, a, numberQs, qnum, numQsAsked, askedQs
    Public hints, hintstr, hUsers(4), hScores(4)
    Public onlySafelisted, hint_char, emote_questions
    Public emote_hints, emote_messages
    Public trivFolder
    '***********************************************************
    ' SETTINGS:
    ' if trivFolder is empty it will default to BotPath()
    trivFolder = ""
    ' if trivFile is empty it will default to questions.txt
    ' it will create a file with 2 questions if none is found
    trivFile = ""
    ' name of the file that holds the scores
    Private Const scoreFile = "scores.txt"
    ' number of hints till bot will ask next question
    Private Const nHints = 4
    ' miliseconds between hints/questions 10000 = 10sec
    TimerInterval "trivia","triviaTimer",10
    ' set onlySafelisted to True if only safelisted users
    ' should be allowed to score
    onlySafelisted = False
    ' the char used in hints (i.e. T _ i v _ a)
    hint_char = "_"
    ' do you want the bot to write questions/hints with /me
    emote_questions = True
    emote_hints = True
    emote_messages = True
    ' change to False if you dont want the scores in profile
    write_scores_to_profile = True
    '***********************************************************
    '-=[ DO NOT EDIT BELOW HERE ]=-
    '***********************************************************
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set score = CreateObject("Scripting.Dictionary")
    Private Const trivVersion = "1.2c"
    ' J3m: little Helper
    Function iif(b, v1, v2)
        If b Then
            iif = v1
        Else
            iif = v2
        End If
    End Function
    Sub triviaAddQ(Msg, Prio)
     c = vbWhite
     If Not isOnline Then
      If Len(Msg) > 3 Then
       If Left(Msg, 3) = "/me" Then
        Msg = Mid(Msg, 5)
        c = &H999999
       ElseIf Left(Msg, 2) = "/w" Then
        c = vbGreen
       End If
      End If
      AddChat c, Msg
     Else
      AddQ Msg, Prio
     End If
    End Sub
    Sub trivia_event_Load()
     Dim cLine, sLine
     score.CompareMode = 1
     AddChat vbCyan, "-=[ TRIVIA ]=- " & trivVersion & _
      " by raylu"
     AddChat &H999999, "   (with some minor changes by J3m)"
       ' J3m: check path
       If trivFolder = "" Then
        trivFolder = BotPath()
       End If
       If Mid(trivFolder,Len(trivFolder)) <> "\" Then
        trivFolder = trivFolder & "\"
       End If
       If Not fso.FolderExists(trivFolder) Then
      AddChat vbRed, "Folder '" & trivFolder & _
       "' does not exist. Check settings."
      Exit Sub
     End If
     AddChat vbYellow, "Loading scores..."
     Set tf = fso.OpenTextFile(trivFolder & scoreFile, 1, _
      True)
     Do While Not tf.AtEndOfStream
      sLine = Trim(tf.ReadLine)       
      cLine = Split(sLine, "|")
      ' J3m: check empty lines
      If UBound(cLine) = 1 Then
       If Not score.Exists(cLine(0)) Then
        score.Add cLine(0), cLine(1)
       End If
      Else
       cLine = Split(sLine, Space(1))
       If UBound(cLine) = 1 Then
        If Not score.Exists(cLine(0)) Then
         score.Add cLine(0), cLine(1)
        End If
       End If
      End If
     Loop
     tf.Close
     AddChat vbGreen, "Scores loaded! (" & score.Count & _
      " users)"
     Call loadQuestions
     If write_scores_to_profile Then
      AddChat vbYellow, "Updating rankings..."
      Call updateRanks
      AddChat vbGreen, "Rankings written to profile!"
     Else
      AddChat vbGreen, "Updating rankings is disabled."
     End If
    End Sub
    Sub trivia_event_ServerInfo(Message)
    End Sub
    Sub trivia_event_ServerError(Message)
    End Sub
    Sub trivia_event_UserTalk(Username, Flags, Message, Ping)
        If Left(Message, 7) = BotVars.Trigger & "trivia" Then
            GetDBEntry Username, myAccess, myFlags
            If myAccess >= trivAccess Then
                If trivia Then
                    trivia = False
    TimerEnabled "trivia","triviaTimer", False
                    triviaAddQ "Trivia stopped. Type " & _
                        BotVars.Trigger & _
                        "score to see your score.", 1
                Else
                    trivia = True
                    ' J3m: if its a restarted trivia, reset
                    '      numQsAsked
                    numQsAsked = 0
                    For i = 0 To numberQs
                        askedQs(i) = False
                    Next
                    Randomize
                    triviaAddQ "Trivia started. Type " & _
                        BotVars.Trigger & "trivia to stop.", 1
                    Call askQuestion
    TimerEnabled "trivia","triviaTimer", True
                End If
            End If
        ElseIf Left(Message, 6) = BotVars.Trigger & "score" Then
            If score.Exists(Username) Then
                triviaAddQ "/w " & D2s & Username & _
                    " Your score is: " & _
                    score.Item(Username) & ".", 1
            Else
                GetDBEntry Username, myAccess, myFlags
                If myAccess >= trivAccess Then
                    triviaAddQ "/w " & D2s & Username & _
                        " Your score is 0.", 1
                End If
            End If
        ElseIf Left(Message, 12) = BotVars.Trigger & "writescores" Then
            GetDBEntry Username, myAccess, myFlags
            If myAccess >= trivAccess Then
                Call writeScores
                If Not trivia Then
                    triviaAddQ "Scores written!", 1
                End If
            End If
        ElseIf Left(Message, 5) = BotVars.Trigger & "file" Then
            GetDBEntry Username, myAccess, myFlags
            If myAccess >= trivAccess Then
                trivFile = Trim(Mid(Message, 7))
                triviaAddQ "Trivia file now set to: " & trivFile, 1
                Call loadQuestions
            End If
        ElseIf Left(Message, 7) = BotVars.Trigger & _
            "uranks" Then
            GetDBEntry Username, myAccess, myFlags
            If myAccess >= trivAccess Then
                Call updateRanks
                If Not trivia Then
                    triviaAddQ "Ranks updated in my profile!", 1
                End If
            End If
        End If
        If hints <= nHints Then
            If trivia And LCase(Message) = LCase(a(qnum)) Then
                ' J3m: new option, only safelisted users allowed
                If onlySafelisted And _
                    Not isSafelisted(Username) Then
                    Exit Sub
                End If
                If score.Exists(Username) Then
                    score.Item(Username) = _
                        score.Item(Username) + 1
                Else
                    score.Add Username, 1
                End If
                triviaAddQ iif(emote_messages, "/me ", "") & _
                    Username & " is correct! The answer was: " _
                    & a(qnum) & ". Score: " & _
                    score.Item(Username), 1
                hints = nHints + 1
                resetTimer
            End If
        End If
    End Sub
    
    Sub trivia_event_UserEmote(Username, Flags, Message)
    End Sub
    Sub trivia_event_WhisperFromUser(Username, Flags, Message)
        Call trivia_event_UserTalk(Username, Flags, Message, 0)
    End Sub
    Sub trivia_event_UserJoins(Username, Flags, Message, Ping, _
        Product, Level, OriginalStatstring)
    End Sub
    Sub trivia_event_UserLeaves(Username, Flags)
    End Sub
    Sub trivia_event_FlagUpdate(Username, NewFlags, Ping)
    End Sub
    Sub trivia_event_LoggedOn(Username, Product)
        If Product = "VD2D" Or Product = "PX2D" Then D2s = "*"
    End Sub
    Sub trivia_event_UserInChannel(Username, Flags, Message, Ping, _
        Product)
    End Sub
    Sub trivia_event_ChannelJoin(ChannelName, Flags)
    End Sub
    sub trivia_triviaTimer_Timer()
        Dim worst_case_counter
        If hints < nHints Then
            hints = hints + 1
            sHint = Split(hintstr)
            ' J3m: 2nd condition to end the next loop
            worst_case_counter = 0
            Do
                newHint = vbNullString
                For i = 1 To UBound(sHint)
                    If sHint(i) = hint_char Then
                        If Rnd() < 0.1 Then
                            newHint = newHint & " " & _
                                Mid(a(qnum), i, 1)
                        Else
                            newHint = newHint & " " & _
                                hint_char
                        End If
                    Else
                        newHint = newHint & " " & sHint(i)
                    End If
                Next
                worst_case_counter = worst_case_counter + 1
            Loop Until (newHint <> hintstr) Or _
                (worst_case_counter > 100)
            hintstr = newHint
            triviaAddQ iif(emote_hints, "/me ", "") & _
                "Hint:" & hintstr, 1
        ElseIf hints = nHints Then
            triviaAddQ iif(emote_messages, "/me ", "") & _
                "Time's up! The answer was: " & a(qnum) & ".", 1
            ' J3m: delay next question for another interval
            hints = hints + 1
        ElseIf hints > nHints Then
            Call askQuestion
        End If
    End Sub
    Sub trivia_event_PressedEnter(Text)
     If myUsername = "" Then
      Call trivia_event_UserTalk(GetBotVersion(), 0, Text, 0)
     Else
         Call trivia_event_UserTalk(myUsername, 0, Text, 0)
       End If
    End Sub
    Sub trivia_event_KeyReturn(KeyName, KeyValue)
    End Sub
    Sub trivia_event_Close()
        Call writeScores
    End Sub
    
    Sub loadQuestions()
     ' J3m: dynamically increasing arrays
     Dim max_size, line, linenr
     max_size = 250
     ReDim q(max_size)
     ReDim a(max_size)
     ReDim askedQs(max_size)
     AddChat vbYellow, "Loading questions..."
     If trivFile = "" Then
      trivFile = "questions.txt"
     End If
     If Not fso.FileExists(trivFolder & trivFile) Then
      AddChat vbRed, "Trivia file '" & trivFolder & _
       trivFile & "' not found! Check settings."
      AddChat vbRed, "Creating a file ..."
      Set tf = fso.OpenTextFile(trivFolder & trivFile, 2, _
       True)  
      tf.WriteLine "Trivia: What variable do I have to " & _
       "check so trivia asks my questions?*trivFile"
      tf.WriteLine "Trivia: What variable do I have to " & _
       "check so trivia can't be used by anyone?*" & _
       "trivAccess"
      tf.Close
     End If
     Set tf = fso.OpenTextFile(trivFolder & trivFile, 1)
     lnum = 0
     linenr = 0
     Do While Not tf.AtEndOfStream
      ' J3m: make sure there is something in the line
      line = Trim(tf.ReadLine)
      linenr = linenr + 1
      ' J3m: split at first *
      cLine = Split(line, "*", 2)
      If UBound(cLine) = 1 Then
       If lnum > max_size Then
        max_size = max_size + 250
        ReDim Preserve q(max_size)
        ReDim Preserve a(max_size)
        ReDim Preserve askedQs(max_size)
       End If
       q(lnum) = cLine(0)
       a(lnum) = cLine(1)
       lnum = lnum + 1
      Else
       ' J3m: modified error-message
       'AddChat &H999999, "Line after " & Chr(34) & _
       '    q(lnum - 1) & Chr(34) & _
       '    " contains no *, skipping..."
       AddChat &H999999, "Line " & linenr & " '" & _
        line & "' contains no *, skipping ..."
      End If
     Loop
     numberQs = lnum
     tf.Close
     AddChat vbGreen, "Questions loaded! (" & lnum & _
      " lines)"
    End Sub
    '***********************************************************
    
    Sub askQuestion()
        If numQsAsked < numberQs Then
            If numQsAsked / numberQs < 0.9 Then
                Do
                    qnum = Int(Rnd() * numberQs)
                Loop Until Not askedQs(qnum)
            Else
                For i = 0 To numberQs
                    If Not askedQs(i) Then
                        qnum = i
                        Exit For
                    End If
                Next
            End If
            triviaAddQ iif(emote_questions, "/me ", "") & q(qnum), 2
            hints = 0
            hintstr = vbNullString
            For i = 1 To Len(a(qnum))
                hintstr = hintstr & " " & hint_char
            Next
            numQsAsked = numQsAsked + 1
            askedQs(qnum) = True
            Call resetTimer
        Else
            trivia = False
    TimerEnabled "trivia","triviaTimer", False
            numQsAsked = 0
            For i = 0 To numberQs
                askedQs(i) = False
            Next
            Call updateRanks
            triviaAddQ "All questions asked! Trivia stopped. Type " & _
                BotVars.Trigger & _
                "score to see your score and " & _
                BotVars.Trigger & "trivia to restart. " & _
                "Rankings updated in profile!", 1
        End If
    End Sub
    Sub resetTimer()
    TimerEnabled "trivia","triviaTimer", False
    TimerEnabled "trivia","triviaTimer", True
    End Sub
    Sub writeScores()
     If fso.FolderExists(trivFolder) Then
      Set tf = fso.OpenTextFile(trivFolder & scoreFile, 2)
      For Each cUser in score.Keys
       tf.WriteLine cUser & "|" & score.Item(cUser)
      Next
      tf.Close
     End If
    End Sub
    Sub QuickSort_Lng(ByRef ArrayToSort, _
       ByRef SecondaryArray, Low, High)
       
       Dim vPartition, vTemp, vTemp2
       Dim i, j
       If Low > High Then Exit Sub
       vPartition = CLng(ArrayToSort((Low + High) \ 2))
       i = Low: j = High
       Do
           Do While CLng(ArrayToSort(i)) < vPartition
               i = i + 1
           Loop
           Do While CLng(ArrayToSort(j)) > vPartition
               j = j - 1
           Loop
           If i <= j Then
               vTemp = ArrayToSort(j)
               vTemp2 = SecondaryArray(j)
               ArrayToSort(j) = ArrayToSort(i)
               SecondaryArray(j) = SecondaryArray(i)
               ArrayToSort(i) = vTemp
               SecondaryArray(i) = vTemp2
               i = i + 1
               j = j - 1
           End If
       Loop Until i > j
       If (j - Low) < (High - i) Then
           QuickSort_Lng ArrayToSort, SecondaryArray, Low, j
           QuickSort_Lng ArrayToSort, SecondaryArray, i, High
       Else
           QuickSort_Lng ArrayToSort, SecondaryArray, i, High
           QuickSort_Lng ArrayToSort, SecondaryArray, Low, j
       End If
    End Sub
    Sub updateRanks()
        If Not write_score_to_profile Then
            Exit Sub
        End If
        Dim u, s, j, i, top5str
        u = score.Keys
        s = score.Items
        For i = 0 To UBound(hScores)
            hScores(i) = 0
            hUsers(i) = ""
        Next
        If UBound(s) > 0 Then
            QuickSort_Lng s, u, 0, UBound(s)
            j = 0
            For i = UBound(s) To 0 Step -1
                hScores(j) = s(i)
                hUsers(j) = u(i)
                j = j + 1
                If j > UBound(hScores) Then
                    Exit For
                End If
            Next
        End If
        top5str = "High scores: " & vbCrLf
        For i = 0 To UBound(hScores)
            If hUsers(i) = "" Then
                Exit For
            End If
            top5str = top5str & (i + 1) & ": " & hUsers(i) & _
                " (" & hScores(i) & ")" & vbCrLf
        Next
        top5str = top5str & "Last update: " & Time
        SetBotProfile "Trivia " & trivVersion, myChannel, top5str
    End Sub
    Make a Questions.txt in your Stealthbot folder and into make the questions



    finish the questions with ?* + answer

    example : How old are you ?*15

  2. #2
    lolercakess's Avatar
    lolercakess is offline Member
    Array
    Join Date
    Jul 2007
    Posts
    49
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    11
    Reputation
    41
    To start the quizz type .Trivia in the channel

  3. #3
    mare.serbia is offline Wannabe Member
    Array
    Join Date
    Jan 2008
    Posts
    18
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    10
    Reputation
    1
    can i get questions here like on other trivia,just to type .category wc3,or etc...?

  4. #4
    lolercakess's Avatar
    lolercakess is offline Member
    Array
    Join Date
    Jul 2007
    Posts
    49
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    11
    Reputation
    41
    no u cant --> just make a questins.txt in stealthbot folder --> and make ur own questions or take them in google

  5. #5
    mare.serbia is offline Wannabe Member
    Array
    Join Date
    Jan 2008
    Posts
    18
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    10
    Reputation
    1
    as i think,Snapjacks is better than this one ,but thx anyway

  6. #6
    bonusa is offline Newbie
    Array
    Join Date
    Jun 2009
    Posts
    5
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    0
    Reputation
    0

    Doesnt work

    [10:24:49 PM] Scripting runtime error '13' in New Text Document.txt: (line 22; column 0)
    [10:24:49 PM] Type mismatch: 'TimerInterval'
    [10:24:49 PM] Offending line: >>

  7. #7
    razathru's Avatar
    razathru is offline The not so evul DOC!

    Array
    Join Date
    Dec 2009
    Location
    Chennai
    Posts
    3,299
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Rep Power
    17
    Reputation
    1635
    Omg, last post on 2008 bumped now.

Similar Threads

  1. Trivia Questions Here!
    By Just-Poison in forum Warcraft 3 Hacks, bots and tools
    Replies: 7
    Last Post: 07-05-2010, 10:13 PM
  2. Nice hack for Counter-Strike 1.6
    By MysteriousSouL in forum Counter-Strike Forum
    Replies: 1
    Last Post: 01-10-2008, 12:06 PM
  3. ** QuiZ Trivia PLuG **
    By T[X]AS in forum Warcraft 3 Hacks, bots and tools
    Replies: 35
    Last Post: 07-16-2007, 07:33 PM
  4. Trivia Bot
    By Thunderdome14 in forum Warcraft 3 forum
    Replies: 2
    Last Post: 04-10-2007, 02:57 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •