AnGelBot-Portal²

Seiten: 1 2 3 4 5 6 7 8 9 10 11

Anscheinend kann oder will niemand ein quizscript schreiben aber viele wollen eins haben, also habe ich mir vor einer woche oder so gedacht das müsste man ändern und habe angefangen eins zu schreiben, sieht auch schon recht gut aus :D , allerdings befürchte ich das direkt wenn ichs veröffentliche direkt 10threads eröffnet werden wo drinne steht was falsch ist was fehlt was besser sein muss etc.

also hier einmalige möglichkeit mir zu sagen was für funktionen es haben muss und evenntuell ein wenig erläutern...

aktuell kann es: frage wiederholen, nach einer gewissen rundenzahl beenden, revolt, vok(tip/frage sind per random), er kann alle trigger ausgeben, fragen hinzufügen/entfernen, highscore, nach einer gewissne zeit wenn keiner ratet wirds abgebrochen und man kann seine eigenen punkte abfragen

zum quizzen bitte in #quiz-time, da kommt das script zum einsatz und es können schneller fehler gefunden werden...

erstmal ein !score spamschutz damit sich der bot nicht in die hölle messaged wenn mehrere das in kurzem abstand/gleichzeit sagen

erstmal nen danke an spike das er sich so grosszügig um den channel und den bot gekümmert hat Cool

und der spamschutz ist nun auch dabei :D

ihr killa

highscore ist nice und ne ewigenliste wär schön. per ini file, die immer aktualisiert wird und die man per !ewig im query bekommt.

!ask

kann jeder ausführen und dadurch nen Quiz mit 50 Runden starten.

cyberclaw schrieb:ihr killa

highscore ist nice und ne ewigenliste wär schön. per ini file, die immer aktualisiert wird und die man per !ewig im query bekommt.

Ich würd nich als trigger machen sondern immer wenn das Quiz zu ende is Wink

das würd ja nerven, wenn dann einmal die top10 des aktuellen + die weigenliste kommen

cyber zustimm :D
das mit der ewigen liste mach ich vielleicht morgen, aber da mein windoof jetzt mal stabil läuft habschs heute mal geschafft alle kleinen fehlerchen zu beseitigen(soweit bekannt) Rolling Eyes

Hier erstmal der link zur DB, kopieren und in den scriptordner als quiz.txt abspeichern
http://www.picitup.de/gallery/23/quiz.txt

Und hier das prachtstück :D
hab versucht möglichst viele Const zeilen anzulegen um das konfigurieren zu vereinfachen

Code:

'********************************************************* 

'*      ______ ______ _        _______________________   * 

'*     / __/ // / _ /// ____  / __/ __/ __/ / _ /_  _/   * 

'*    / __/ // / ///// /___/ _\ \/ /_/ / / / __/ / /     * 

'*   /_/ /____/_//__/       /___/___/_/ /_/_/   /_/      * 

'*                                                       * 

'*=======================================================* 

'* Copyright and Idea: CT-Daimond                        * 

'* Script: Quiz v0.22a by CT-Daimond & Design by Spike   * 

'* Help: www.angelbot-portal.de                          * 

'********************************************************* 

Dim Channel, que, ans, red, check, timer, tips, count, rounds, frage, timeoutcheck

Dim questions(), highscore(), revcount(), flood(2)

ReDim highscore(2, 1), revcount(1)

On Error Resume Next

Sub Init()

    Script "Quiz v0.22a by CT-Daimond & Design by Spike" 

    Hook "Chan_Msg"

    Hook "Nick"

    Randomize

    fnum = FileOpen(DB, FA_Read) 

    addline = FileReadln(fnum)

    ReDim questions(addline)

    questions(0) = addline

    a = 0

    Do While Not FileEOF(fnum) 

    addline = FileReadln(fnum) 

    a = a + 1

    questions(a) = addline

    Loop 

    FileClose(fnum)

End Sub 

'kann geändert werden

Const start = "!start" 'startbefehl(wenn man danach eine zahl angibt, ist das die neue rundenanzahl die gespielt wird)

Const ende = "!ende" 'quitbefehl

Const punkte = "!points" 'punkte?

Const score = "!score" 'highscore-auflistungsbefehl

Const tipver = 5 'Anzahl der falschen lösung bis ein tipp kommt

Const vok = "!vok" 'next-tip befehl

Const revolt = "!revolt" 'votefunktion für nächste frage

Const stdrounds = 50 'standardanzahl der runden pro quiz

Const muserrev = 2 'mindestanzahl user die benötigt wird für ein revolt(zusätzlich werden min 50% der mitspieler gebraucht)

Const wfrage = "!frage" 'lässt die frage wiederholen

Const timeout = 10 'zeit(in Minuten(0-59)) bis das script sich automatisch beendet, wenn keiner mitmacht

Const floodvok = 5 'Zeit die es dauert bis vok wieder nutzbar ist

Const floodscore = 30 'Zeit die es dauert bis score wieder nutzbar ist

Const DB = "\FileArea\Scripts\quiz.txt" 'question-Datenbank

Const addf = "!addf" 'fügt der quiz-DB eine frage hinzu

Const adda = "!adda" 'fügt der quiz-DB die antwort hinzu

Const del = "!del" 'löscht eine frage aus der Datenbank

Sub Chan_Msg (Chan, Nick, RegUser, Line)

    Select Case LCase(Param(Line, 1))

        Case start

            If IsOp(Nick, Chan) OR MatchFlags(GetUserChanFlags(RegUser, Chan), "+f") Then

                If Channel = "" Then

                    If isNumeric(Param(Line, 2)) Then

                        rounds = CLng(Param(Line, 2))

                    Else

                        rounds = stdrounds

                    End If

                    SendLine "PRIVMSG " & Chan & " :1,0«41» 1Quiz wird gestartet 1«41»", 2

                    Channel = Chan

                    timer = "0"

                    count = 0

                    question

                    Exit Sub

                Else

                    SendLine "PRIVMSG " & Chan & " :1,0«41» 1Quiz wird grade schon benutzt 1«41»", 2

                End If

            End If

        Case addf

            If Not MatchFlags(GetUserChanFlags(RegUser, Chan), "+s") Then Exit Sub

            frage = GetRest(Line, 2)

            SendLine "PRIVMSG " & Chan & " :2 1,0 «41» 1Ist die Frage so richtig? 12[1 " & frage & " 12]1 1«41» ", 2

        Case adda

            If Not MatchFlags(GetUserChanFlags(RegUser, Chan), "+s") Then Exit Sub

            If Not frage = "" Then

                fnum = FileOpen(DB, FA_Write) 

                anzahl = questions(0)

                FileWriteln fnum, Trim((anzahl + 1))

                FileWriteln fnum, Trim(frage) & " ||| " & Trim(GetRest(Line, 2))

                a = anzahl + 2

                ReDim Preserve questions(a)

                For i = 1 To anzahl

                    If Trim(questions(i)) <> "" Then

                        FileWriteln fnum, questions(i)

                    End If

                Next

                FileClose(fnum)

                frage = ""

                SendLine "PRIVMSG " & Chan & " :2 1,0 «41» 12[1 Hinzugefügt 12]1 1«41» ", 2

                If Channel = "" Then

                    fnum = FileOpen(DB, FA_Read) 

                    addline = FileReadln(fnum)

                    ReDim questions(addline)

                    questions(0) = addline

                    a = 0

                    Do While Not FileEOF(fnum) 

                        addline = FileReadln(fnum) 

                        a = a + 1

                        questions(a) = addline

                    Loop 

                    FileClose(fnum)

                End If

            Else

                SendLine "PRIVMSG " & Chan & " :und frage?", 2

            End If

        Case del

            If Not MatchFlags(GetUserChanFlags(RegUser, Chan), "+s") Then Exit Sub

            For i = 1 To questions(0)

                If GetRest(Line, 2) = LCase(Left(questions(i), Len(GetRest(Line, 2)))) Then

                    SendLine "PRIVMSG " & Chan & " :frage wurde gefunden´und wird gelöscht", 2

                    a = i

                    Exit For

                End If

            Next

            fnum = FileOpen(DB, FA_Write) 

            anzahl = questions(0)

            FileWriteln fnum, Trim((anzahl - 1))

            For j = 1 To anzahl

                If Not j = a Then

                    FileWriteln fnum, questions(j)

                End If

            Next

            FileClose(fnum)

    End Select

    If Not Chan = Channel Then Exit Sub

    Select Case LCase(Param(Line, 1))

        case ende

            If IsOp(Nick, Chan) OR MatchFlags(GetUserChanFlags(RegUser, Chan), "+f") Then

                If Channel <> "" Then

                    highscore1

                    quit

                Else

                    SendLine "PRIVMSG " & Chan & " :1,0«41» 1Quiz ist nicht gestartet 1«41»", 2

                End If

            End If

        Exit Sub

        Case punkte

            For i = 0 To (UBound(highscore, 2) - 1)

                If Nick = highscore(0, i) Then

                    b = highscore(1, i)

                ElseIf i = (UBound(highscore, 2) - 1) Then

                    b = 0

                End If

            Next

            SendLine "PRIVMSG " & Chan & " :1,0«41» 12[1 " & Nick & " 12] 1Du hast 12[1 " & b & " 12] 1Punkte 1«41»", 2

        Case score

            If flood(1) = 1 Then Exit Sub

            flood(1) = 1

            TimedCommand "flood(1) = 0", floodscore

            If IsOp(Nick, Chan) Then

                highscore1

            End If

            Exit Sub

        Case "!quizhelp", "!qh"

            SendLine "NOTICE " & Nick & " :1,0«41» 12[1 " & start & " 12(1only OP's12) 12] 1- 12[1 " & ende & " 12(1only OP's12) 12] 1- 12[1 " & punkte & " 12] 1- 12[1 " & score & " 12] 1- 12[1 " & vok & " 12] 1- 12[1 " & revolt & " 12] 1«41»", 2

        Case vok

            If timer = "0" Then Exit Sub

            If flood(0) = 1 Then Exit Sub

            flood(0) = 1

            TimedCommand "flood(0) = 0", floodvok

            tip

            timeoutcheck = Now + CDate("00:" & timeout & ":00")

            Exit Sub

        Case revolt

            If timer = "0" Then Exit Sub

            If revcount(0) = vbNullString Then

                revcount(0) = Nick

            Else

                For i = 0 To (UBound(revcount) - 1)

                    If Nick = revcount(i) Then Exit For

                    If i = (UBound(revcount) - 1) Then

                        j = i + 2

                        ReDim Preserve revcount(j)

                        j = i + 1

                        revcount(j) = Nick

                    End If

                Next

            End If

            If UBound(revcount) > (UBound(highscore, 2) / 2) And UBound(revcount) => muserrev Then

                ReDim revcount(1)

                timer = "0"

                SendLine "PRIVMSG " & Channel & " :1,0«41» 1Die Lösung war 12[1 " & ans & " 12] 1«41»", 2

                tips = ""

                If ParamCount(red) = rounds Then

                    highscore1

                    rounds = 0

                    quit

                    Exit Sub

                End If

                question

            End If

            Exit Sub

        Case wfrage

            SendLine "PRIVMSG " & Chan & " :1,0 «41» 12[1 Frage: " & ParamCount(red) & " 12] 1" & que & " 1«41» ", 2

        Case ans

    End Select

    If Not Check = 1 Then Exit Sub

    If LCase(Line) = LCase(ans)  Then

        right Chan, Nick

        Exit Sub

    End If

    Count = Count + 1

    If Count = tipver Then

        Count = 0

        tip

    End If

End Sub

Sub right(Chan, Nick)

    timer = "0"

    tips = ""

    Count = 0

    SendLine "PRIVMSG " & Chan & " :1,0«41» 1Die richtige antwort war 12[1 " & ans & " 12] 1Herzlichen Glückwunsch 12[1 " & Nick & " 12] 1«41»", 2

    ans = ""

    If highscore(0, 0) = vbNullString Then

        highscore(0, 0) = Nick

        highscore(1, 0) = 1

    Else

        For i = 0 To (UBound(highscore, 2) - 1)

            If Nick = highscore(0, i) Then

                highscore(1, i) = highscore(1, i) + 1

                Exit For

            ElseIf i = (UBound(highscore, 2) - 1) Then

                j = i + 2

                ReDim Preserve highscore(2, j)

                j = i + 1

                highscore(0, j) = Nick

                highscore(1, j) = 1

            End If

        Next

    End If

    If ParamCount(red) = rounds Then

        highscore1

        rounds = 0

        quit

        Exit Sub

    End If

    TimedCommand "question", 5

End Sub

Sub question()

ReDim revcount(1)

zahl = Int((questions(0) * Rnd) + 1)

    If InStr(red, " " & zahl & " ") > 0 Then

        Do Until InStr(red, " " & zahl & " ") > 0

            zahl = Int((questions(0) * Rnd) + 1)

        Loop

    End If

    red = red & " " & zahl & " "

    addline = questions(zahl)

    que = Trim(ParamX(addline, "|||", 1))

    ans = Trim(ParamX(addline, "|||", 2))

    SendLine "PRIVMSG " & Channel & " :1,0 «41» 12[1 Frage: " & ParamCount(red) & " 12] 1" & que & " 1«41» ", 2

    check = 1

    timer = "1"

    timeoutcheck = Now + CDate("00:" & timeout & ":00")

    TimedCommand "timeout1", timeout * 60

End Sub

Sub timeout1()

    If timeoutcheck < Now + CDate("00:00:05") Then

        SendLine "PRIVMSG " & Channel & " :1,0 «41» 1Quiz wird beendet. Grund: 12[ Es spielt keiner mehr ] 1«41» ", 2

        highscore1

        quit

    End If

End Sub

Sub tip()

If timer = "0" Then Exit Sub

    If ParamCount(timer) = 1 Then

        For i = 1 To Len(ans)

            tips = tips & "."

        Next

        timer = timer & " " & Len(ans)

    End If

    zahl = Int((Param(timer, 2) * Rnd) + 1)

    a = 1

    b = 0

    For i = 1 To Len(ans)

        If InStr(a, tips, ".", 1) > 0 Then

            a = InStr(a, tips, ".") + 1

            b = b + 1

            If zahl = b Then

                zahl = a - 1

                Exit For

            End If

        End If

    Next

    timer = Param(timer, 1) & " " & (Param(timer, 2) - 1)

    If zahl = 1 Then 

        tips = Left(ans, 1) & Mid(tips, 2, (Len(tips) - 1))

    ElseIf zahl = Len(tips) Then 

        tips = Left(tips, (Len(ans) - 1)) & Mid(ans, Len(ans), 1)

    Else

        tips = Mid(tips, 1, (zahl - 1)) & Mid(ans, zahl, 1) & Mid(tips, (zahl + 1), (Len(tips) - zahl + 1)) 

    End If

    SendLine "PRIVMSG " & Channel & " :1,0«41» 1Tip: 12[1 " & tips & "12] 1«41»", 2

    If tips = ans Then

        timer = "0"

        SendLine "PRIVMSG " & Channel & " :1,0«41» 1Die Lösung war 12[1 " & tips & " 12] 1«41»", 2

        tips = ""

        question

    End If

End Sub

Sub highscore1()

    If UBound(highscore, 2) > 1 Then

        For a = 0 To (UBound(highscore, 2) - 2)

            aa = highscore(1, a)

            bbb = a

            bb = a

            z = a

            raus = vbNullString

            For b = 1 To (UBound(highscore, 2) - a)

                bb = bb + 1

                If aa < highscore(1, bb) Then

                    aa = highscore(1, bb)

                    bbb = bb

                End If

                If highscore(1, z) => highscore(1, bb) AND Not raus = False Then

                    raus = True

                Else

                    raus = False

                End If

                z = z + 1

            Next

            If raus = True Then Exit For

            c = highscore(0, a)

            c1 = highscore(1, a)

            highscore(0, a) = highscore(0, bbb)

            highscore(1, a) = highscore(1, bbb)

            highscore(0, bbb) = c

            highscore(1, bbb) = c1

        Next

    End If

    SendLine "PRIVMSG " & Channel & " :1,0«41» 12[1 HighScore Liste 12]  1«41»", 2

    For k = 1 To UBound(highscore, 2)

        a = k - 1

        SendLine "PRIVMSG " & Channel & " :1,0«41» 12[1 " & k & " 12] 1- 12[1 " & highscore(0, a) & " 12] 1mit 12[1 " & highscore(1, a) & " 12] 1Punkte 1«41»", 2

    Next

    SendLine "PRIVMSG " & Channel & " :1,0«41» 12[1 Ende 12]  1«41»", 2

End Sub

Sub quit()

SendLine "PRIVMSG " & Channel & " :1,0«41» 1Quiz wurde beendet und der Sieger ist 12[1 " & highscore(0, 0) & " 12] 1mit 12[1 " & highscore(1, 0) & " 12] 1Punkten 1«41»", 2

Channel = ""

que = ""

ans = ""

red = ""

check = ""

timer = ""

tips = ""

count = ""

rounds = ""

ReDim highscore(2, 1), revcount(1)

End Sub

Sub Nick(Chan, OldNick, NewNick, RegUser, Flags, Count)

If Not Chan = Channel Then Exit Sub

    For i = 0 To (UBound(highscore, 2) - 1)

        If OldNick = highscore(0, i) Then

            highscore(0, i) = NewNick

            Exit For

        End If

    Next

    For k = 0 To (UBound(revcount) - 1)

        If OldNick = revcount(k) Then

            revcount(k) = NewNick

            Exit For

        End If

    Next

End Sub

verbesserungsvorschläge nehme ich gerne an solang keiner am rumnörgeln ist Wink

p.s. vielen dank für spike's testdienste und cybersclaw's webspace Wink

3*** Scripting error in 'Quiz.asc':
10 Error : 13 (Typen unverträglich: '[string: ""]')
10 Position: Line 26, Column 4
10 Excerpt : ReDim questions(addline)
10 Command : Init
3*** End of error message
3*** Loaded script: Quiz.asc

was is der fehler?

ich nehme mal an du hast nicht alles mitkopiert, so die zahl steht bei dir in Der DB sicher nicht mit drinne, die gibt nur die anzahl der fragen an fürs array, damit das script nicht erst zeilen zählen muss und dann reinschreiben, erspart so halt rechenarbeit und stört ja eigentlich keinen :D

Seiten: 1 2 3 4 5 6 7 8 9 10 11

stargate

sajuko

stargate

cyberclaw

cyberclaw

Strucky

cyberclaw

stargate

Winters

stargate