AnGelBot-Portal²

AnGelBot-Portal² > Scripting > Scriptreleases > FIFA WM 2006
Normale Version: FIFA WM 2006
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

Nukleos

03.03.2006, 20:35 Uhr
Hi,
hab mal aus nem Script von sts ein Wm-Script gebastelt. Es geht darum sich die Gruppenergebnisse von http://fifaworldcup.yahoo.com/06/de/w/group/index.html
anzeigen zu lassen. Kurze Erklärung:
Im Script selber einstellen ob mit oder ohne Farben. Dazu halt die Zeile
Code:
Const Color = True                   ' Farbe ( True/False )
entsprechend ändern.
Den Rest, also in welchen Channels, im Setup in der PL eingeben.
Im chan mit !gruppe bzw gleich mit !gruppe >A - H<, je nach dem welche man halt sehen will.
Habs in allen Variationen getestet und es funzt bei mir einwandfrei.
Achja, nicht wundern, die Ländernamen werden automatisch gekürzt um die Spalten einigermassen untereinander zu kriegen. Es werden im moment die ersten 7 Buchstaben angezeigt, wenn ihr da mehr wollt dann folgende Zeilen ändern:
Code:
If Len(tmp_land) <> 7 Then
        Line = Left(tmp_land & ". . . . . . ", 7)
Einfach die *7* durch die entsprechende Anzahl ersetzen.
So, bei Bugs oder Änderungswünschen einfach hier rein damit.
Das Script:

Code:
'+-------------------------------------+
'| WM 2006 © by sts & Nukleos
'| THX @ Sp33d 4 Capitalize Function!!
'| Don`t change the author!
'|
'| Website : www.angelbot.dyndns.org
'|-------------------------------------+
'| PartyLine Setup ------------[x]
'| Anlegung einer INI-Datei ---[x]
'| Channeleinstellungen ------ [x]
'|-------------------------------------+
'##############Einstellungen##################
Const DebugIt = False      'Erweiterte Meldungen ( True/False )
Const Trigger = "wm2006"      'Konfigurationtrigger auf der Partyline
Const Color = True                   ' Farbe ( True/False )
'###############Don't Change!!################
Const Host = "fifaworldcup.yahoo.com"
Const INIFile = "wm2006.ini"
Const Gruppen = "a b c d e f g h"
Const ScriptVersion = "WM 2006 © by sts & Nukleos"
Const ScriptName = "WM 2006"


Dim Channels, LastNews, Recieved, Zeichen, Channel


Sub Init()
  SpreadFlagMessage 0, "+m", "3 " & ScriptVersion
  Hook "Commands"
  Hook "Chan_Msg"
  AddCommand ". " & Trigger, Cl_Mas, "+m", "2*** ." & Trigger & "##14Zeigt das " & ScriptName & " Setup in dem die Channels,##14in denen das WM-Script aktiv sein soll verändert##14werden können."
  ReloadChannels
  SpreadFlagMessage 0, "+m", "3Um das Script zu konfigurieren gib nun ." & Trigger & " ein."
End Sub


Sub ReloadChannels()
  Channels = ReadINIString("Settings", "Channels", "", INIFile)
End Sub

Sub Commands(vSock, RegUser, Flags, Line)
  If LCase(Param(Line, 1)) = "." & Trigger Then
    GrabUser vSock, "" & ScriptName & " Setup", "StatusSetup"
    SetSockTag vSock, "MainMenu"
    StatusSetup vSock, RegUser, Flags, ""
  End If
End Sub

Sub Chan_Msg(Chan, Nick, RegUser, Line)
  If InStr(1, Channels, Chan) > 0 Then
   If LCase(Param(Line,1)) = "!gruppe" Then
    If LCase(Param(Line, 2)) = "" Then
     Sendline "PrivMsg " & Chan & " :Es stehen folgende Gruppen zur Verfügung:",3
     Sendline "PrivMsg " & Chan & " :A, B, C, D, E, F, G, H ( zb >!Gruppe F< )",3
    Exit Sub
   Else
    If InStr(1, Gruppen, LCase(Param(Line,2))) > 0 Then
      Zeichen = Param(Line,2)
      Channel = Chan
      GetNews
    End If
   End If
  End If
End If
End Sub  

Sub StatusSetup(vSock, RegUser, Flags, Line)

  If Param(Line, 1) = "0" Then
    TU vsock, "10*** Saving settings..."
    ReleaseUser vSock
    Exit Sub
  End If

  Select Case LCase(Param(GetSockTag(vSock), 1))
    Case "mainmenu"
      TU vSock, " 4,1©4,14©4,15©4,0 sts 4,15©4,14©4,1© 1,1___||________________________|__4,1©4,14©4,15©4,0sts4,15©4,14©4,1©"
      TU vSock, " 4,1©4,14©4,15©4,0 sts 4,15©4,14©4,1© 0,1 " & ScriptVersion & " 4,1©4,14©4,15©4,0sts4,15©4,14©4,1©"
      TU vSock, " 4,1©4,14©4,15©4,0 sts 4,15©4,14©4,1© 1,1___||________________________|__4,1©4,14©4,15©4,0sts4,15©4,14©4,1©"
      TU vSock, " "  
      TU vSock, "Willkommen im Setup vom " & ScriptName & "-Script!"
      TU vSock, "Du befindest dich im Hauptmenü."
      TU vSock, " "
      TU vSock, "0,1Ticker Channels:"

      Dummy = Split(Channels, " ")
      For i = LBound(Dummy) To UBound(Dummy)
        TU vSock, "14 - " & Dummy(i)
      Next

      TU vSock, " "
      TU vSock, " - chan add #channel um einen Channel der Liste hinzuzufügen"
      TU vSock, " - chan del #channel um einen Channel aus Liste zu löschen"
      TU vSock, ""
      TU vSock, " - 0 um zurück auf die Partyline zu kommen."
      SetSockTag vSock, "MainMenuOption"
    Case "mainmenuoption"
      Select Case LCase(Param(Line, 1))
        Case "chan"
          If LCase(Param(Line, 2)) = "add" Then
            Channels = Trim3(Channels & " " & Param(Line, 3))
            WriteINIString "Settings", "Channels", Channels, INIFile
            TU vSock, "3*** Channel " & LCase(Param(Line, 3)) & " wurde hinzugefügt"
            SetSockTag vSock, "MainMenu"
            StatusSetup vSock, RegUser, Flags, ""
          ElseIf LCase(Param(Line, 2)) = "del" Then
            Channels = Trim3(Replace(LCase(Channels), LCase(Param(Line, 3)), ""))
            WriteINIString "Settings", "Channels", Channels, INIFile
            TU vSock, "3*** Channel " & LCase(Param(Line, 3)) & " wurde entfernt"
            SetSockTag vSock, "MainMenu"
            StatusSetup vSock, RegUser, Flags, ""
          Else
            TU vSock, "5*** Syntax: chan <add | del> <#channel>"
          End If
      End Select
  End Select
End Sub


Sub GetNews()
  vSock = SockConnect(Host, 80, "SockEvent")
  If vSock = 0 Then
    If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & Host & ": Couldn't create socket"
    TimedCommand "GetNews", 60
  End If
End Sub

Sub SockEvent(vSock, SEvent, SData)
  Dim Header2

  Select Case SEvent
    Case SE_ConnectFailed
      If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Connection to " & Host & " failed"
      TimedCommand "GetNews", CheckTime
    Case SE_Connected
      If Proxy = vbNullString Then
        Header = "GET /06/de/w/group/index.html"
      Else
        Header = "GET http://" & Host & "/06/de/w/group/index.html"
      End If


      SockWrite vSock, Header & " HTTP/1.0" & vbCrLf & Header2 & _
                      "Accept: text/html"  & vbCrLf & _
                      "User-Agent: AnGeL-Bot " & LongBotVersion & " (www.AnGelBot.dyndns.org)" & vbCrLf & _
                      "Host: " & Host & vbCrLf & _
                      "Pragma: no-cache" & vbCrLf & _
                      "Connection: close" & vbCrLf & vbCrLf
    Case SE_Read
      Recieved = Recieved & SData
    Case SE_Closed
      If InStr(1, Recieved, "Gruppe A") > 0 Then
        Recieved = ReplaceHTMLCode(Recieved)
        If Color = True Then
        Sendline "PrivMsg " & Channel & " :11,14Gruppe " & Capitalize(Zeichen) & ":",2
        Sendline "PrivMsg " & Channel & " :0,1Land . . .| » S « | » g « | » u « | » v « | » + « | » - « | » P « | ",2
        Else
        Sendline "PrivMsg " & Channel & " :Gruppe " & Capitalize(Zeichen) & ":",2
        Sendline "PrivMsg " & Channel & " :Land . . .| » S « | » g « | » u « | » v « | » + « | » - « | » P « | ",2
        End If
        Dummy = "Gruppe " & Capitalize(Zeichen)
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        For i = 1 to 4
        Dummy = "border=0>&nbsp;"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_land = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_spiel = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_gew = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_unen = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_verl = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_plus = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "<td>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_minus = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        Dummy = "class=b>"
        Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
        tmp_punkt = Left(Recieved, InStr(1, Recieved, "<") - 1 )
        If Len(tmp_land) <> 7 Then
        Line = Left(tmp_land & ". . . . . . ", 7)
        Else
        Line = tmp_land
        End If
        If Color = True Then
        Sendline "PrivMsg " & Channel & " :11,1" & Line & " | » " & tmp_spiel & " « | » " & tmp_gew & " « | » " & tmp_unen & " « | » " & tmp_verl & " « | » " & tmp_plus & " « | » " & tmp_minus & " « | » " & tmp_punkt & " « | ",2
       Else
        Sendline "PrivMsg " & Channel & " :" & Line & " | » " & tmp_spiel & " « | » " & tmp_gew & " « | » " & tmp_unen & " « | » " & tmp_verl & " « | » " & tmp_plus & " « | » " & tmp_minus & " « | » " & tmp_punkt & " « | ",2
       End If
       Next
       Else
       SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Couldn't recieve HTML page..."
       End If
       Recieved = vbNullString

  End Select
End Sub

Function Trim3(Text)
  Trim3 = Replace(Replace(Trim(Text), "   ", " "), "  ", " ")
End Function

Function ReplaceHTMLCode(Text)
  Text = Replace(Text, vbCr,"")
  Text = Replace(Text, VbCrLf,"")
  Text = Replace(Text, vbFormFeed,"")
  Text = Replace(Text, vbLf,"")
  Text = Replace(Text, vbNewLine,"")
  Text = Replace(Text, vbNullChar,"")
  Text = Replace(Text, vbTab,"")
  Text = Replace(Text, vbVerticalTab,"")
  
  ReplaceHTMLCode = Text
End Function

Function Capitalize(Line)
  Capitalize = UCase(Left(Line, 1)) & LCase(Mid(Line, 2))
End Function

ps: mein erstes *großes* umgebasteltes Script, vieles vielleicht umständlich und noch einige unnötige Überreste, aber es funzt(bei mir). Also nehmt Rücksicht Wink

Nukleos

03.03.2006, 20:49 Uhr
Und so sieht das farbig aus:

[Bild: wmpic6ab.jpg]

Bei Gruppe H kommt manchmal ne Fehlermeldung, einfach ignorieren und nochmal abfragen Wink

firstjoe

05.03.2006, 04:28 Uhr
ohaaaa sehr nice Smile gefällt mir Smile vielen dank

jetzt fehlt ja nur noch ein script wo man sich die spiele+ergebnisse der gruppen anzeigen lassen kann^^

Nukleos

05.03.2006, 05:34 Uhr
Wenn du DAS HIER meinst, ist schon in Arbeit Wink

Christian

05.03.2006, 10:39 Uhr
Nukleos schrieb:Bei Gruppe H kommt manchmal ne Fehlermeldung, einfach ignorieren und nochmal abfragen

Das sollte man doch fixen denn so kann man kein Script Releasen wenn es voller Fehler bleibt . . .

Nukleos

05.03.2006, 14:58 Uhr
Naja, eigentlich geb ich dir recht, aber das Problem liegt wohl eher an der Seite. Tritt vielleicht bei 10 Abfragen einmal auf, dann zeigt er von Gruppe H die ersten 2-3 Spalten und die letzte wird verschluckt. Dann meldet er auf der PL irgendwas mit *ungültiger Prozeduraufruf*. Die nächsten 9 mal gehts dann wieder einwandfrei. Wenn jemand ne Ahnung hat was das sein könnte wäre super.

firstjoe

05.03.2006, 15:35 Uhr
Nukleos schrieb:Wenn du DAS HIER meinst, ist schon in Arbeit Wink

hehe genau das meine ich Smile wäre echt super Smile danke für die arbeit

Gassi2106

25.05.2006, 18:52 Uhr
Bei gruppe a bekomme ich bei den Ländern nur "..." angezeigt. Hat das einen bestimmten grund? Oder kann es auch an der Seite liegen? Hab es gleich 2 mal versucht jedoch das selbe spiel.

Nukleos

25.05.2006, 21:34 Uhr
Jo, scheint so als wenn die grad die Seite umbauen. HIER werden im Moment nirgens die Namen angezeigt. Mal abwarten was die vorhaben, werd dann das script entsprechend abändern.

firstjoe

26.05.2006, 13:49 Uhr
bei mir gehts immer noch 1a
Seiten: 1 2
AnGelBot-Portal² > Scripting > Scriptreleases > FIFA WM 2006
Referenz-URLs