Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Quizbot für Minecraft

Uploader:MitgliedDonStevone
Datum/Zeit:19.07.2011 13:22:59

'###############################################################################
'###    Projektname : MineCraft_QuizBot Version 1.0                          ###
'###    Author      : Steven Mahnke alias DonStevone                         ###
'###    Datum       : 17.07.2011                                             ###
'###                                                                         ###
'###    Beschreibung: Ein QuizBot für Minecraft. Dieser sollte zusammen      ###
'###                  mit Tradecraft und einen Admintool benutzt werden.     ###
'###                  Man vordert den Quizbot auf eine Frage zu stellen,     ###
'###                  beantwortet man diese richtig gibt der Bot einem       ###
'###                  Gold. Dafür benötigt der Bot allerdings entsprechende  ###
'###                  Rechte.                                                ###
'###                                                                         ###
'###    Thanks to   : ThePuppetMaster für seine super TSNE                   ###
'###                  Alle die mit an der Dokumentation des Minecraft        ###
'###                  Protokolls gearbeitet haben                            ###
'###                                                                         ###
'###    Lizenz      : Mir egal was ihr damit tut alles was hier drin steht,  ###
'###                  steht zur freien Verfügung.                            ###
'###############################################################################

'   Wichtig: Der Server muss im offline Modus laufen!
'   Benötigt wird die TSNE_V3 von tpm
'   und eine Quest.txt der Aufbau ist einfach
'
'   Frage1
'   Antwort zu Frage 1
'   Antwort zu Frage 1 (optional), Wenn nicht verwendet Leerzeile lassen
'   Antwort zu Frage 1 (optional), Wenn nicht verwendet Leerzeile lassen
'   Frage2
'   ...
'
'   Einfach Zeilenweise die Fragen hier eintragen
'   und eine Bot.ini
'   Bsp. hierfür
'
'   Hostname=Localhost
'   Port=25565
'   Username=DonBot
'
'   Bitte um Hilfe der Bot erhält nicht jede Nachhricht ich schätze das liegt daran
'   das der Server regelrecht flootet und der Client damit zu viel zu tun hat.
'   Ca 1/4 der Nachrichten kommt nicht an und man muss sie nochmal schreiben.
'   Wem etwas einfällt kann mich anschreiben Baron_Samedi1@gmx.de

#Include Once "TSNE_V3.bi"

Dim Shared G_Client as UInteger
Dim BV as Integer

Declare Sub TSNE_Disconnected   (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_Connected      (ByVal V_TSNEID as UInteger)
Declare Sub TSNE_NewData        (ByVal V_TSNEID as UInteger, ByRef V_Data as String)

Declare Sub Send_ID2            (ByVal Username as String)
Declare Sub Send_ID1            (ByVal Username as String, ByVal ProtocolVersion as Integer)
Declare Sub Send_ID0            ()
Declare Sub Send_ID10           ()
Declare Sub Send_ID255          ()
Declare Sub Send_ID9            ()
Declare Sub Read_Settings       ()
Declare Sub Send_Msg            (ByVal Msg as String)
Declare Sub Load_Quest          ()

Declare Function Check_ID2      (ByVal Packet as String)                            as Byte
Declare Function Check_ID13     (ByVal Packet as String)                            as Byte
Declare Function Check_ID8      (ByVal Packet as String)                            as Short

Dim Shared Port as UShort
Dim Shared Servername as String
Dim Shared User as String
Dim Shared Protocol as Integer
Protocol = 14

Read_Settings()
Randomize Timer

Dim Shared Timer_ID10 as Integer
Dim Shared Quest(1 to 30) as String
Dim Shared Answer(1 to 90) as String
Dim Shared QuestCounter as Short
Dim Shared Quiztimer as Integer
Dim Shared QuizUser as String
Dim Shared AktQuiz as Short

Load_Quest()

BV = TSNE_Create_Client(G_Client, Servername, Port, @TSNE_Disconnected, @TSNE_Connected, @TSNE_NewData, 60)
If BV <> TSNE_Const_NoError Then
    Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    End
End If

Send_ID2(User)
Sleep 1000
Send_Msg("Hi, 4 more information about me say 'info QuizBot'")

While(Multikey(&h01) = 0)
    Timer_ID10 += 1
    If Timer_ID10 > 100 then Timer_ID10 = 0 : Send_ID10()

    If Timer > Quiztimer + 30 and Quiztimer > 0 then Quiztimer = 0 : Send_Msg("Time over!")
    Sleep 10
Wend
Send_ID255()
Sleep
Sleep
End 0

'###############################################################################
Sub TSNE_Disconnected(ByVal V_TSNEID as UInteger)
    Color 4, 0
    ?"Connection lost"
End Sub

'###############################################################################
Sub TSNE_Connected(ByVal V_TSNEID as UInteger)
End Sub

'###############################################################################
Sub TSNE_NewData (ByVal V_TSNEID as UInteger, ByRef V_Data as String)
    Color 7, 0
    Dim a as Integer
    Dim Counter as Integer
    Dim Check as String
    Dim To_Send as String
    Dim as String MsgUser, Message

    '?"New Data"
    For a = 0 to Len(V_Data) - 1
        Check += STR(V_Data[a]) + " "
    Next a
    '?Check

    If Check_ID2 (V_Data) then Send_ID1(User, Protocol)
    'If Check_ID13(V_Data) then Send_ID13()
    If Check_ID8(V_Data) then Send_ID9()
    If V_Data[0] = 3 then
        Counter = V_Data[2]
        For a = 4 to Counter * 2 + 3 Step 2
            Message += CHR(V_Data[a])
        Next a
        Counter = Instr(Message, ">")
        MsgUser = Mid(Message, 2, Counter - 2)
        Message = TRIM(Mid(Message, Counter + 1))
        ?"New Message"
        ?MsgUser
        ?Message

        If LCase(Message) = "info quizbot" then
            Sleep 500
            Send_Msg("Im the QuizBot! Wanna have some money? Say Challange")
            Sleep 500
            Send_Msg("and ill ask a question. If u are right ill give u some gold!")
        ElseIf LCase(Message) = "ping" then
            Send_Msg("Pong")
        ElseIf LCase(Message) = "challange" and QuizTimer = 0 then
            QuizTimer = Timer
            QuizUser = MsgUser
            AktQuiz = INT(RND * QuestCounter) + 1
            Send_Msg(Quest(AktQuiz))
            Sleep 500
            Send_Msg("You have 30 seconds...")
        ElseIf QuizTimer > 0 and MsgUser = QuizUser then
            If TRIM(LCase(Message)) = TRIM(LCase(Answer(AktQuiz * 3 - 2))) or _
               TRIM(LCase(Message)) = TRIM(LCase(Answer(AktQuiz * 3 - 1))) or _
               TRIM(LCase(Message)) = TRIM(LCase(Answer(AktQuiz * 3)))     then
               Send_Msg("You are right !")
               Sleep 250
               Send_Msg("/give " + QuizUser + " 266 1")
               QuizTimer = 0
            Else
                Send_Msg("U lose !")
                Sleep 250
                Send_Msg("Correct answers:")
                Sleep 250
                Send_Msg(Answer(AktQuiz * 3 - 2))
                Sleep 250
                Send_Msg(Answer(AktQuiz * 3 - 1))
                Sleep 250
                Send_Msg(Answer(AktQuiz * 3))
                QuizTimer = 0
            Endif

        ElseIf Instr(LCase(Message), "joined the game.") then
            Send_Msg("Hi, 4 more information about me say 'info QuizBot'")
        Endif
    Endif
End Sub

'###############################################################################
'###############################################################################
'###############################################################################
Sub Send_ID2(ByVal Username as String)  'Erstes Packet Handshake. Seems to Work!
    Dim To_Send as String = String(Len(Username) * 2 + 3, CHR(0))
    Dim a as Integer
    Dim Check as String
    Dim as Integer Counter = 1

    Color 3, 0
    Print "Try to Send PacketID2"

    To_Send[0] = 2
    To_Send[2] = Len(Username)
    For a = 4 to Len(Username) * 2 + 4 Step 2
        To_Send[a] = Mid(Username, Counter, 1)
        Counter += 1
    Next a

    '       For testing
    For a = 0 to Len(To_Send) - 1
        Check += STR(To_Send[a]) + " "
    Next a
    ?Check

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "PacketID2 Send!"
    Endif
End Sub

'###############################################################################
Sub Send_ID1(ByVal Username as String, ByVal ProtocolVersion as Integer)
    Dim as String To_Send = String(1 + 4 + (Len(Username) * 2) + 2 + 8 + 1, CHR(0))
    Dim a as Integer
    Dim Counter as Integer
    Dim Check as String

    Color 3, 0
    Print "Try to Send PacketID1"

    To_Send[0] = 1
    To_Send[4] = ProtocolVersion
    To_Send[6] = Len(Username)
    For a = 8 to 6 + Len(Username) * 2 Step 2
        To_Send[a] = Username[Counter]
        Counter += 1
    Next a

    '       For testing
    For a = 0 to Len(To_Send) - 1
        Check += STR(To_Send[a]) + " "
    Next a
    ?Check

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "PacketID1 Send!"
    Endif
End Sub

'###############################################################################
Sub Send_ID0()
    Dim as String To_Send = String(1, CHR(0))

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "PacketID0 Send!"
    Endif
End Sub

'###############################################################################
Sub Send_ID10()
    Dim as String To_Send = String(2, CHR(0))

    To_Send[0] = 10
    To_Send[1] = 1

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        'Print "PacketID10 Send!"
    Endif
End Sub

'###############################################################################
Sub Send_ID255()
    Dim Reason as String = "Disconnect"
    Dim as String To_Send = String(3 + Len(Reason) * 2, CHR(0))
    Dim a as Integer
    Dim Counter as Integer

    To_Send[0] = 255
    To_Send[2] = Len(Reason)
    For a = 4 to 2 + Len(Reason) * 2 Step 2
        To_Send[a] = Reason[Counter]
    Next a

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "PacketID255 Send!"
    Endif
End Sub

'###############################################################################
Sub Send_ID9()
    Dim as String To_Send = String(2, CHR(9))

    To_Send[1] = 1

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "PacketID9 Send!"
    Endif
End Sub

'###############################################################################
Sub Read_Settings()
    Dim as Integer File = Freefile
    Dim Zeile as String
    Dim Position as Integer

    ?"Loading settings..."

    Open "Bot.ini" for Input as #File
    Line Input #File, Zeile
    Position = Instr(Zeile, "=")
    Position += 1
    Zeile = Mid(Zeile, Position)
    Servername = TRIM(Zeile)

    Line Input #File, Zeile
    Position = Instr(Zeile, "=")
    Position += 1
    Zeile = Mid(Zeile, Position)
    Port = Val(Zeile)

    Line Input #File, Zeile
    Position = Instr(Zeile, "=")
    Position += 1
    Zeile = Mid(Zeile, Position)
    User = TRIM(Zeile)

    Close #File
End Sub

'###############################################################################
Sub Send_Msg(ByVal Msg as String)
    Dim a as Integer
    Dim Counter as Integer
    Dim Check as String
    Dim Position as Integer
    Dim NewStr as String = Msg

    'For a = 0 to Len(Msg)
    '    If Msg[a] = 0 then Position = a : Exit For
    'Next a
    If Position = 0 then Position = Len(NewStr)
    Dim To_Send as String = String(Position * 2 + 6, CHR(0))
    ?NewStr
    ?Position

    To_Send[0] = 3
    To_Send[2] = Position
    For a = 4 to Position * 2 + 2 Step 2
        To_Send[a] = NewStr[Counter]
        Counter += 1
    Next a
    To_Send[Position * 2 + 3] = 10
    To_Send[Position * 2 + 4] = 1
    To_Send[Position * 2 + 5] = 0
    'For a = 0 to Len(To_Send) - 1
    '    Check += STR(To_Send[a]) + " "
    'Next a
    '?Check

    Dim as Integer BV = TSNE_Data_Send(G_Client, To_Send)
    If BV <> TSNE_Const_NoError Then
        Color 4, 0
        Print "[FEHLER] " & TSNE_GetGURUCode(BV)
    Else
        Color 2, 0
        Print "Message Send!"
    Endif
End Sub

'###############################################################################
Sub Load_Quest()
    Dim File as Integer = Freefile
    Dim Zeile as String
    Dim a as Integer
    Dim b as Integer
    Dim ACounter as Integer
    ?"Loading quests..."

    If Open("Quest.txt" for Input as #File) then ?"Can't open Quest.txt"
    For a = 1 to 30
        Line Input #File, Zeile
        If Zeile = "" then QuestCounter = a - 1 : Exit For
        Quest(a) = TRIM(Zeile)
        'If Quest(a) <> "" then ?Quest(a)

        For b = 1 to 3
            ACounter += 1
            Line Input #File, Zeile
            Answer(ACounter) = TRIM(Zeile)
            'If Answer(ACounter) <> "" then ?Answer(ACounter)
        Next b
    Next a
    ?STR(QuestCounter) + " quests load" + CHR(10)
    Close #File
End Sub

'###############################################################################
Function Check_ID2(ByVal Packet as String) as Byte
    If Packet[0] = 2 and Packet[4] = 45 then
        Return -1
    Else
        Return 0
    Endif
End Function

'###############################################################################
Function Check_ID13(ByVal Packet as String) as Byte
    If Packet[0] = 13 then
        Return -1
    Else
        Return 0
    Endif
End Function

'###############################################################################
Function Check_ID8(ByVal Packet as String) as Short
    If Packet[0] = 8 then
        Return -1
    Else
        Return 0
    Endif
End Function

'###############################################################################