AnGelBot-Portal² / PasteIt / Eintrag #211

[-]
PasteIt Eintrag #211
Autor: eXploder
Titel: KinoChart-Ticker 2.0 © sts & paradoxon
Beschreibung: http://www.angelbot-portal.de/kinochart-ticker-1-6-sts-t-2517-3.html#pid17234
 

[-]
Auf diesen Beitrag gibt es folgende 2 Antworten:

Code
  1. '+-------------------------------------+
  2. '| KinoChart-Ticker 2.0 © sts & paradoxon                   
  3. '|
  4. '| Don`t change the author!
  5. '|
  6. '| Website : www.AnGelBot-Portal.de
  7. '|-------------------------------------+
  8. '| PartyLine Setup ------------[ ]
  9. '| Anlegung einer INI-Datei ---[ ]
  10. '| Channeleinstellungen ------ [x]
  11. '|-------------------------------------+
  12. '#################Einstellungen###############
  13. 'Channels indem das Script aktiv sein soll
  14. Const AktivChans = "*"       'Mit "Leerzeichen trennen (* für alle Channels)
  15.  
  16. 'Soll die URL zu den Filminformationen angezeigt werden?
  17. Const ShowUrls = False      'True or False
  18.  
  19. '##########Don`t edit!!#######################
  20.  
  21. Const Host = "www.kinonews.de"
  22. Const Version = "2.0"
  23. Const Author = "sts and paradoxon"
  24. Const ScriptName = "KinoChart-Ticker 2.0 © sts & paradoxon"
  25. Const DebugIt = False          'Erweiterte Meldungen
  26.  
  27. Dim Channels, LastNews, Recieved, aChan
  28.  
  29. Sub Init()
  30.   Script "1,0 «4•1» 4[ Kinochart-Ticker ]1 Script 4[ " & Version & " ]1 by 4[ " & Author & " ] 1«4•1» "
  31.   Hook "Chan_Msg"
  32.   SpreadFlagMessage 0, "+m", "1,0 «4•1» 4[ Kinochart-Ticker ]1 Script 4[ " & Version & " ]1 by 4[ " & Author & " ]1 loaded 1«4•1» "
  33. End Sub
  34.  
  35. Sub Chan_Msg(Chan, Nick, RegUser, Line)
  36.  
  37.   If LCase(Param(Line,1)) = CommandPrefix & "kinocharts" Then
  38.     If InStr(LCase(AktivChans), LCase(Chan)) > 0 Or AktivChans = "*" Then
  39.       Sendline "PRIVMSG " & Chan & " :Get informormations. Please wait a moment...",1
  40.       aChan = Chan
  41.       GetNews
  42.     End If
  43.   End If
  44.  
  45. End Sub
  46.  
  47. Sub GetNews()
  48.   vSock = SockConnect(Host, 80, "SockEvent")
  49.   If vSock = 0 Then
  50.     SpreadFlagMessage 0, "+m", "5*** ShoutCast: Couldn't create socket"
  51.   End If
  52. End Sub
  53.  
  54. Sub SockEvent(vSock, SEvent, SData)
  55.   Dim Header2
  56.  
  57.   Select Case SEvent
  58.     Case SE_ConnectFailed
  59.       SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Connection to " & Host & " failed. Please contact the Author."
  60.       Sendline "PrivMsg " & aChan & " : Connection to " & Host & " failed. Please contact your botowner",3
  61.     Case SE_Connected
  62.       If Proxy = vbNullString Then
  63.         Header = "GET /index.php/column_Kino-Charts"
  64.       Else
  65.         Header = "GET http://" & Host & "/index.php/column_Kino-Charts"
  66.       End If
  67.  
  68.  
  69.       SockWrite vSock, Header & " HTTP/1.0" & vbCrLf & Header2 & _
  70.                       "Accept: text/html"  & vbCrLf & _
  71.                       "User-Agent: AnGeL-Bot " & LongBotVersion & " (www.AnGeLBot-Portal.de)" & vbCrLf & _
  72.                       "Host: " & Host & vbCrLf & _
  73.                       "Pragma: no-cache" & vbCrLf & _
  74.                       "Connection: close" & vbCrLf & vbCrLf
  75.     Case SE_Read
  76.       Recieved = Recieved & SData
  77.     Case SE_Closed
  78.       If InStr(1, Recieved, "<!-- Anfang Content -->") > 0 Then
  79.         Recieved = Replace(Recieved, vbCrLf, vbNullString)
  80.  
  81.         Dummy = "<span class=""title-column-k"">"
  82.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  83.         tmp_Titel = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "<") - 1 ))
  84.        
  85.         Dummy = "<span class=""headline"">"
  86.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  87.         tmp_lastweek = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "<") - 1 ))       
  88.  
  89.         Dummy = "<a  href="""
  90.         Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  91.         tmp_Url = Left(Recieved, InStr(1, Recieved, """") - 1 )
  92.         If ShowUrls = True Then
  93.           Sendline "PrivMsg " & aChan & " :1,0 «4•1» " & tmp_Titel & " - " & tmp_lastweek & " (InfoLink: " & tmp_Url & " ) 1«4•1» ",1
  94.         ElseIf ShowUrls = False Then
  95.           Sendline "PRIVMSG " & aChan & " :1,0 «4•1» " & tmp_Titel & " - " & tmp_lastweek & " 1«4•1» ",1
  96.         End If     
  97.      
  98.         For i = 1 to 9
  99.           Dummy = "<span class=""title-column-k"">"
  100.           Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  101.           tmp_Titel = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "<") - 1 ))
  102.          
  103.           Dummy = "<span class=""headline"">"
  104.           Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  105.           tmp_lastweek = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "<") - 1 ))           
  106.          
  107.           Dummy = "<a  href="""
  108.           Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
  109.           tmp_Url = Left(Recieved, InStr(1, Recieved, """") - 1 )
  110.           If ShowUrls = True Then
  111.             Sendline "PrivMsg " & aChan & " :1,0 «4•1» " & tmp_Titel & " - " & tmp_lastweek & " (InfoLink: " & tmp_Url & " ) 1«4•1» ",1
  112.           ElseIf ShowUrls = False Then
  113.             Sendline "PRIVMSG " & aChan & " :1,0 «4•1» " & tmp_Titel & " - " & tmp_lastweek & " 1«4•1» ",1
  114.           End If
  115.  
  116.         Next
  117.       Else
  118.         If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Couldn't recieve HTML page... Please contact the Author"
  119.         Sendline "PRIVMSG " & aChan & " : The HTML Layout from www.kinonews.de was changend. Please contact your botowner",3
  120.       End If
  121.       Recieved = vbNullString
  122.  
  123.   End Select
  124. End Sub
  125.  
  126. Function ReplaceHTMLCode(Text)
  127.   Text = Replace(Text, "&#228;", "ä")
  128.   Text = Replace(Text, "&#252;", "ü") 
  129.   Text = Replace(Text, "&#246;", "ö")
  130.   Text = Replace(Text, "&#223;", "ß")   
  131.   ReplaceHTMLCode = Text
  132. End Function


Kontakt | AnGelBot-Portal | Nach oben | Zum Inhalt | Archiv-Modus | RSS-Synchronisation