[-]
PasteIt Eintrag #224
Autor: eXploder
Titel: Heise-NewsTicker v1.2b
Beschreibung: ChannelSetup © Sp33d
Bugfixes and Layout © by paradoxon
Rest © by sts
 

Code
  1. Const Host = "www.heise.de"
  2. Const INIFile = "FileArea\INI\heise.ini"
  3. Const ScriptVersion = "v1.2b"
  4. Const ScriptName = "Heise-NewsTicker"
  5. Const ScriptAuthor = "sts, Sp33d & paradoxon"
  6. Const DebugIt = False 
  7.  
  8. Dim Channels, LastNews, Recieved
  9.  
  10. Sub Init()
  11.   Script "1,0 «4•1» 4[ " & ScriptName & " ]1 Script 4[ " & ScriptVersion & " ]1 by 4[ " & ScriptAuthor & " ] 1«4•1» "
  12.   SpreadFlagMessage 0, "+m", "1,0 «4•1» 4[ " & ScriptName & " ]1 Script 4[ " & ScriptVersion & " ]1 by 4[ " & ScriptAuthor & " ]1 loaded 1«4•1» "
  13.   Hook "Commands"
  14.   AddCommand "heise", Cl_Mas, "+m", "2*** .heise##14Zeigt das " & ScriptName & " Setup in dem die Channel,##14in denen der Ticker angezeigt werden soll verändert##14werden können."
  15.   ReloadChannels
  16.   GetNews
  17.   SpreadFlagMessage 0, "+m", "3Um das Script zu konfigurieren gib nun .heise ein."
  18. End Sub
  19.  
  20.  
  21. Sub ReloadChannels()
  22.   Channels = ReadINIString("Settings", "Channels", "", INIFile)
  23. End Sub
  24.  
  25. Sub Commands(vSock, RegUser, Flags, Line)
  26.   If LCase(Param(Line, 1)) = ".heise" Then
  27.     GrabUser vSock, "" & ScriptName & " Setup", "StatusSetup"
  28.     SetSockTag vSock, "MainMenu"
  29.     StatusSetup vSock, RegUser, Flags, ""
  30.   End If
  31. End Sub
  32.  
  33. Sub StatusSetup(vSock, RegUser, Flags, Line)
  34.  
  35.   If Param(Line, 1) = "0" Then
  36.     TU vsock, "10*** Saving settings..."
  37.     ReleaseUser vSock
  38.     Exit Sub
  39.   End If
  40.  
  41.   Select Case LCase(Param(GetSockTag(vSock), 1))
  42.     Case "mainmenu"
  43.       TU vSock, " 11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1____________________ ?___2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
  44.       TU vSock, "11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1_0,1 " & ScriptName & " Setup 1,1_2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
  45.       TU vSock, " 11,0,%0,11%'12,11,%11,12%'2,12,%12,2%'1,2,%2,1%'1,1____________________ ?___2,1'%1,2%,12,2'%2,12%,11,12'%12,11%,0,11'%11,0%,"
  46.       TU vSock, " "
  47.       TU vSock, "Willkommen im Setup vom " & Version & "!"
  48.       TU vSock, "Du befindest dich im Hauptmenü."
  49.       TU vSock, " "
  50.       TU vSock, "0,1Ticker Channels:"
  51.  
  52.       Dummy = Split(Channels, " ")
  53.       For i = LBound(Dummy) To UBound(Dummy)
  54.         TU vSock, "14 - " & Dummy(i)
  55.       Next
  56.  
  57.       TU vSock, " "
  58.       TU vSock, "0,1Farben: 14 " & ReadINIString("Settings", "Farben", "Off", INIFile)
  59.       TU vSock, " "
  60.       TU vSock, " - chan add #channel um einen Channel der Liste hinzuzufügen"
  61.       TU vSock, " - chan del #channel um einen Channel aus Liste zu löschen"
  62.       TU vSock, " - color on um Farben zu aktivieren"
  63.       TU vSock, " - color off um Farben zu deaktiveren"
  64.       TU vSock, " - 0 um zurück auf die Partyline zu kommen."
  65.       SetSockTag vSock, "MainMenuOption"
  66.     Case "mainmenuoption"
  67.       Select Case LCase(Param(Line, 1))
  68.         Case "chan"
  69.           If LCase(Param(Line, 2)) = "add" Then
  70.             Channels = Trim3(Channels & " " & Param(Line, 3))
  71.             WriteINIString "Settings", "Channels", Channels, INIFile
  72.             TU vSock, "3*** Channel " & LCase(Param(Line, 3)) & " wurde hinzugefügt"
  73.             SetSockTag vSock, "MainMenu"
  74.             StatusSetup vSock, RegUser, Flags, ""
  75.           ElseIf LCase(Param(Line, 2)) = "del" Then
  76.             Channels = Trim3(Replace(LCase(Channels), LCase(Param(Line, 3)), ""))
  77.             WriteINIString "Settings", "Channels", Channels, INIFile
  78.             TU vSock, "3*** Channel " & LCase(Param(Line, 3)) & " wurde entfernt"
  79.             SetSockTag vSock, "MainMenu"
  80.             StatusSetup vSock, RegUser, Flags, ""
  81.           Else
  82.             TU vSock, "5*** Syntax: chan <add | del> <#channel>"
  83.           End If
  84.         Case "color"
  85.           If LCase(Param(Line, 2)) = "on" Then
  86.             WriteINIString "Settings", "Farben", "on", INIFile
  87.             TU vSock, "3*** Farben wurden aktiviert"
  88.             SetSockTag vSock, "MainMenu"
  89.             StatusSetup vSock, RegUser, Flags, ""
  90.           ElseIf LCase(Param(Line, 2)) = "off" Then
  91.             WriteINIString "Settings", "Farben", "off", INIFile
  92.             TU vSock, "3*** Farben wurden deaktiviert"
  93.             SetSockTag vSock, "MainMenu"
  94.             StatusSetup vSock, RegUser, Flags, ""
  95.           Else
  96.             TU vSock, "5*** Syntax: color <on | off>"
  97.           End If
  98.         Case Else
  99.           TU vSock, "5*** Ungültiger Befehl"
  100.       End Select
  101.   End Select
  102. End Sub
  103.  
  104.  
  105.  
  106. Sub GetNews()
  107.   vSock = SockConnect(Host, 80, "SockEvent")
  108.   If vSock = 0 Then
  109.     If DebugIt Then SpreadFlagMessage 0, "+m", "5*** Seite existiert nicht mehr. Bitte melde dich im Forum ( www.AnGelBot-Portal.de ) "
  110.     TimedCommand "GetNews", 120
  111.   End If
  112. End Sub
  113.  
  114. Sub SockEvent(vSock, SEvent, SData)
  115.   Dim Header2
  116.  
  117.   Select Case SEvent
  118.     Case SE_ConnectFailed
  119.       If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Connection to " & Host & " failed"
  120.       TimedCommand "GetNews", 120
  121.     Case SE_Connected
  122.       If Proxy = vbNullString Then
  123.         Header = "GET /newsticker/"
  124.       Else
  125.         Header = "GET http://" & Host & "/newsticker/"
  126.       End If
  127.  
  128.  
  129.       SockWrite vSock, Header & " HTTP/1.0" & vbCrLf & Header2 & _
  130.                       "Accept: text/html"  & vbCrLf & _
  131.                       "User-Agent: AnGeL-Bot " & LongBotVersion & " (www.Saug-Hilfe-Fuer-Alle.de)" & vbCrLf & _
  132.                       "Host: " & Host & vbCrLf & _
  133.                       "Pragma: no-cache" & vbCrLf & _
  134.                       "Connection: close" & vbCrLf & vbCrLf
  135.     Case SE_Read
  136.       Recieved = Recieved & SData
  137.     Case SE_Closed
  138.       If InStr(1, Recieved, "<div id=""mitte_news"">") > 0 Then
  139.         Recieved = Replace(Recieved, vbCrLf, vbNullString)
  140.  
  141.  
  142.         Dummy = "<div class=""tage"">"
  143.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  144.  
  145.         Dummy = "<a href="""
  146.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  147.  
  148.         tmp_Url = Left(Recieved, InStr(1, Recieved, """ title=") - 2 )
  149.         If DebugIt Then SpreadFlagMessage 0, "+m", "Adresse : http://" & host & "/newsticker/" & tmp_Url
  150.  
  151.         Dummy = ">"
  152.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  153.         tmp_Titel = Left(Recieved, InStr(1, Recieved, "<") - 1 )
  154.     tmp_Titel = Replace(tmp_Titel, "ü", "ü")
  155.     tmp_Titel = Replace(tmp_Titel, "ä", "ä")
  156.     tmp_Titel = Replace(tmp_Titel, "ö", "ö")
  157.     tmp_Titel = Replace(tmp_Titel, "Ü", "Ü")
  158.     tmp_Titel = Replace(tmp_Titel, "Ä", "Ä")
  159.     tmp_Titel = Replace(tmp_Titel, "Ö", "Ö")
  160.     tmp_Titel = Replace(tmp_Titel, "ß", "ß")
  161.     tmp_Titel = Replace(tmp_Titel, "&quot;", """")
  162.     tmp_Titel = Replace(tmp_Titel, "&amp;", "&")
  163.     tmp_Titel = Replace(tmp_Titel, "&lt;", "<")
  164.     tmp_Titel = Replace(tmp_Titel, "&gt;", ">")
  165.         If DebugIt Then SpreadFlagMessage 0, "+m", "Titel: " & tmp_Titel
  166.  
  167.  
  168.         Dummy = "1,0«4•1» 4[ New Heise.de News ]1 - 4[ Titel ]1 " & tmp_Titel & " 4[ URL ]1 http://" & host & tmp_URL & "l 1«4•1» "
  169.         If Dummy <> LastNews Then
  170.           If DebugIt Then SpreadFlagMessage 0, "+m", "New news!"
  171.           LastNews = Dummy
  172.           Dummy = Split(Channels, " ")
  173.           For i = LBound(Dummy) To UBound(Dummy)
  174.             If DebugIt Then SpreadFlagMessage 0, "+m", "Sending to " & Dummy(i) & " :" & "PRIVMSG " & Dummy(i) & " :" & LastNews
  175.             color = ReadINIString("Settings", "Farben", "Off", INIFile)
  176.             If color = "on" Then
  177.               SendLine "PRIVMSG " & Dummy(i) & " :" & LastNews, 2
  178.             ElseIf color = "off" Then
  179.               SendLine "PRIVMSG " & Dummy(i) & " :" & Strip(LastNews), 2
  180.             End If
  181.           Next
  182.         End If
  183.  
  184.  
  185.       Else
  186.         SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": HTML-Layout wurde geändert. Bitte melde dich im Forum ( www.AnGelBot-Portal.de )"
  187.       End If
  188.       Recieved = vbNullString
  189.  
  190.       TimedCommand "GetNews", 120
  191.   End Select
  192. End Sub
  193.  
  194. Function Trim3(Text)
  195.   Trim3 = Replace(Replace(Trim(Text), "   ", " "), "  ", " ")
  196. End Function