04.07.2004, 15:21 Uhr
Code:
Option Explicit
'In welchen Channeln soll das Script aktiv sein?
Const ActiveChannels = "#DoC-Clan"
'Rückgabeformat (%SENDER%, %TIME%, %TITLE%, %DURATION%, %SHOWVIEW%)
'Mit ## kannst du Zeilen unterteilen.
Const Template = "10,0 «» 10,0[1,0 %SENDER% 10,0]1,0 - 10,0[1,0 %TIME% Uhr 10,0]1,0 - 10,0[1,0 %TITLE% 10,0]1,0 - 10,0[1,0 %DURATION% Uhr 10,0] «» "
'Script-eigene Floodprotection benutzen?
Const UseBuiltInFloodProtection = True
'Alle wieviel Sekunden darf eine Abfrage ausgelöst werden?
'(nur in Verbindung mit Script-eigener Floodprotection)
Const QueryInterval = 30
'Wieviele Resultate sollen maximal zurückgegeben werden?
Const MaxResults = 3
Const RemoteHost = "www.tvtoday.de"
Const ini_config = "config.ini"
Const TV_Normal = 0 'Konstante
Const TV_Complete = 1 'Konstante
Const TV_Search = 2 'Konstante
Dim SiteQueries(25, 7) 'Query Array
'0 = Nick
'1 = Chan
'2 = Sender
'3 = Uhrzeit
'4 = Type
'5 = Busy?
'6 = Serversocket
'7 = Empfangene Daten
Dim LastRequest 'Floodprotection
Sub Init()
Script "TV Script"
Hook "Chan_Msg"
LastRequest = CDate("01.01.1970 00:00:00")
End Sub
Sub Chan_Msg(Chan, Nick, RegUser, Line)
If ReadINIString(Chan, "tv", "on", ini_config) = "off" Then Exit Sub
Dim Sender
If InStr(1, " " & LCase(ActiveChannels) & " ", " " & LCase(Chan) & " ") <= 0 Then Exit Sub
If UseBuiltInFloodProtection = True Then
If DateDiff("s", LastRequest, Now) < QueryInterval Then
'Floodprotection aktiv
Exit Sub
End If
End If
Select Case LCase(Param(Line, 1))
Case "!tv"
LastRequest = Now
If Param(Line, 2) = vbNullString Or LCase(Param(Line, 2)) = "help" Then
SendLine "NOTICE " & Nick & " :Usage: !tv <TV-Channel> [<time>] (e.g. !tv RTL 22)", 3
Else
If Param(Line, 3) = vbNullString Then
'keine Zeit angegeben
Sender = GetSender(Param(Line, 2))
If Sender = vbNullString Then
SendLine "NOTICE " & Nick & " :" & Nick & ": Ungültiger Sender", 3
Exit Sub
End If
AddNewQuery Nick, Chan, Sender, Hour(Now), TV_Complete
Else
If IsNumeric(Param(Line, 3)) Then
If CInt(Param(Line, 3)) < 0 Or CInt(Param(Line, 3)) > 23 Then
'Fehleingabe, kein gültiger Bereich!
SendLine "NOTICE " & Nick & " :" & Nick & ": Mögliche Uhrzeiten: 0 bis 23", 3
Exit Sub
End If
End If
Sender = GetSender(Param(Line, 2))
If Sender = vbNullString Then
SendLine "NOTICE " & Nick & " :" & Nick & ": Ungültiger Sender", 3
Exit Sub
End If
AddNewQuery Nick, Chan, Sender, IIf(Len(Param(Line, 3)) = 1, "0" & Param(Line, 3), Param(Line, 3)), TV_Normal
End If
End If
Case "!tvsearch"
LastRequest = Now
End Select
End Sub
Sub SockEvent(vSock, SEvent, SData)
Dim i, arrID
'passenden Eintrag suchen
arrID = -1
For i = 0 To UBound(SiteQueries)
If SiteQueries(i, 6) = vSock And SiteQueries(i, 5) = True Then
arrID = i
Exit For
End If
Next
'unerwartete Daten?!?
If arrID = -1 Then
SpreadFlagMessage 0, "+m", "***"
Exit Sub
End If
Select Case SEvent
Case SE_ConnectFailed
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :" & SiteQueries(arrID, 0) & ": Verbindung fehlgeschlagen.", 3
ResetQuery arrID
Case SE_Connected
SiteQueries(arrID, 7) = vbNullString
Select Case SiteQueries(arrID, 4)
Case TV_Normal
SockWrite vSock, "GET /tv/programm/programm.php?ztag=0&sparte=alle&uhrzeit=Ax" & SiteQueries(arrID, 3) & "&sender=" & SiteQueries(arrID, 2) & " HTTP/1.0" & vbCrLf & _
"Host: " & RemoteHost & vbCrLf & _
"Connection: close" & vbCrLf & _
"Pragma: no-cache" & vbCrLf & _
"Useragent: Mozilla/4.0 (AnGelBot " & LongBotVersion & "; www.AnGelBot-Portal.de)" & vbCrLf & vbCrLf
Case TV_Complete
SockWrite vSock, "GET /tv/programm/programm.php?ztag=0&sparte=alle&uhrzeit=jetzt&sender=" & SiteQueries(arrID, 2) & " HTTP/1.0" & vbCrLf & _
"Host: " & RemoteHost & vbCrLf & _
"Connection: close" & vbCrLf & _
"Pragma: no-cache" & vbCrLf & _
"Useragent: Mozilla/4.0 (AnGelBot " & LongBotVersion & "; www.AnGelBot-Portal.de)" & vbCrLf & vbCrLf
Case TV_Search
SockWrite vSock, "GET /tv/programm/programm.php?ztag=0&uhrzeit=jetzt&sparte=alle&suchbegriff=" & SiteQueries(arrID, 2) & " HTTP/1.0" & vbCrLf & _
"Host: " & RemoteHost & vbCrLf & _
"Connection: close" & vbCrLf & _
"Pragma: no-cache" & vbCrLf & _
"Useragent: Mozilla/4.0 (AnGelBot " & LongBotVersion & "; www.AnGelBot-Portal.de)" & vbCrLf & vbCrLf
End Select
Case SE_Read
SiteQueries(arrID, 7) = SiteQueries(arrID, 7) & SData
Case SE_Closed
Dim Dummy, Result, FNum, Results(50, 5), tResults, iPos, iPos2
'0 = Sender
'1 = Startzeit
'2 = Name
'3 = Laufzeit
'4 = ShowView
'5 = Beschreibung
If InStr(SiteQueries(arrID, 7), "P R O G R A M M") Then
If InStr(1, SiteQueries(arrID, 7), "<!--LISTING ENDE-->") Then
Dummy = "<table border=""0"" cellpadding=""4"" cellspacing=""0"" width=""566"">"
Result = Mid(SiteQueries(arrID, 7), InStr(1, SiteQueries(arrID, 7), Dummy) + Len(Dummy) + 2)
Dummy = "<br><br><table"
If InStr(1, Result, Dummy) Then
Result = Mid(Result, 1, InStr(1, Result, Dummy) - 2)
Else
SpreadFlagMessage 0, "+m", "4*** TVToday: Ungültige Daten empfangen?!"
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :Sorry, keine Sendungen gefunden!", 3
ResetQuery arrID
Exit Sub
End If
tResults = Split(Replace(Replace(Result, vbCr, vbNullString), vbLf, vbNullString), "</table>")
For i = LBound(tResults) To UBound(tResults)
iPos = InStr(1, tResults(i), " alt=""", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len(" alt=""")
iPos2 = InStr(iPos, tResults(i), """")
If iPos2 > 0 Then
Results(i, 0) = Mid(tResults(i), iPos, iPos2 - iPos)
End If
End If
iPos = InStr(1, tResults(i), "<span class=""text-grau"">", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len("<span class=""text-grau"">")
iPos2 = InStr(iPos, tResults(i), "<")
If iPos2 > 0 Then Results(i, 1) = Mid(tResults(i), iPos, iPos2 - iPos)
End If
iPos = InStr(1, tResults(i), "<span class=""link-intern""><u>", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len("<span class=""link-intern""><u>")
iPos2 = InStr(iPos, tResults(i), "<")
If iPos2 > 0 Then
Results(i, 2) = Mid(tResults(i), iPos, iPos2 - iPos)
If InStrRev(Results(i, 2), " (") Then Results(i, 2) = Mid(Results(i, 2), 1, InStrRev(Results(i, 2), " (") - 1)
End If
Else
iPos = InStr(1, tResults(i), "<span class=""headline"">", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len("<span class=""headline"">")
iPos2 = InStr(iPos, tResults(i), "</", vbTextCompare)
If iPos2 > 0 Then
Results(i, 2) = Mid(tResults(i), iPos, iPos2 - iPos)
If InStrRev(Results(i, 2), " (") Then Results(i, 2) = Mid(Results(i, 2), 1, InStrRev(Results(i, 2), " (") - 1)
End If
End If
End If
iPos = InStr(1, tResults(i), "<i>", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len("<i>")
iPos2 = InStr(iPos, tResults(i), "<")
If iPos2 > 0 Then
Results(i, 3) = Mid(tResults(i), iPos, iPos2 - iPos)
End If
End If
iPos = InStr(1, tResults(i), "Showview", vbTextCompare)
If iPos > 0 Then
iPos = iPos + Len("ShowView")
iPos2 = InStr(iPos, tResults(i), "<")
If iPos2 > 0 Then
Results(i, 4) = Trim(Mid(tResults(i), iPos, iPos2 - iPos))
End If
End If
Next
Dim bFound
bFound = False
For i = 0 To MaxResults - 1
If Results(i, 0) <> vbNullString Then
If SiteQueries(arrID, 4) = TV_Normal Then
If Left(Results(i, 1), 2) = SiteQueries(arrID, 3) Then
bFound = True
Dummy = Replace(Replace(Replace(Replace(Replace(Template, "%SENDER%", Results(i, 0)), "%TIME%", Results(i, 1)), "%TITLE%", Results(i, 2)), "%DURATION%", Results(i, 3)), "%SHOWVIEW%", Results(i, 4))
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :" & Dummy, 3
End If
Else
bFound = True
Dummy = Replace(Replace(Replace(Replace(Replace(Template, "%SENDER%", Results(i, 0)), "%TIME%", Results(i, 1)), "%TITLE%", Results(i, 2)), "%DURATION%", Results(i, 3)), "%SHOWVIEW%", Results(i, 4))
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :" & Dummy, 3
End If
End If
Next
If Not bFound Then SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :Sorry, keine Sendungen gefunden.", 3
Else
SpreadFlagMessage 0, "+m", "4*** TVToday: Ungültige Daten empfangen?!"
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :Sorry, keine Sendungen gefunden!", 3
End If
Else
SpreadFlagMessage 0, "+m", "4*** TVToday: Ungültige Daten empfangen?!"
SendLine "PRIVMSG " & SiteQueries(arrID, 1) & " :Sorry, keine Sendungen gefunden!", 3
End If
ResetQuery arrID
End Select
End Sub
Sub AddNewQuery(Nick, Chan, vSender, vTime, vType)
Dim i, vSock
For i = 0 To UBound(SiteQueries)
If SiteQueries(i, 5) = False Then
SiteQueries(i, 0) = Nick
SiteQueries(i, 1) = Chan
SiteQueries(i, 2) = Replace(vSender, " ", "+")
SiteQueries(i, 3) = vTime
SiteQueries(i, 4) = vType
SiteQueries(i, 5) = True
SiteQueries(i, 7) = vbNullString
SiteQueries(i, 6) = SockConnect(RemoteHost, 80, "SockEvent")
If SiteQueries(i, 6) <= 0 Then
SendLine "PRIVMSG " & Chan & " :" & Nick & ": Daten können z.Z. nicht abgerufen werden!", 3
SpreadFlagMessage 0, "+m", "4*** TVToday: Konnte kein Socket erstellen für Abfrage!"
ResetQuery i
End If
Exit Sub
End If
Next
'Script überlastet: keine freien Abfrageslots
End Sub
Sub ResetQuery(ID)
SiteQueries(ID, 0) = vbNullString
SiteQueries(ID, 1) = vbNullString
SiteQueries(ID, 2) = vbNullString
SiteQueries(ID, 3) = vbNullString
SiteQueries(ID, 4) = vbNullString
SiteQueries(ID, 5) = False
SiteQueries(ID, 6) = -1
SiteQueries(ID, 7) = vbNullString
End Sub
Function GetSender(vSender)
Select Case UCase(vSender)
Case "ALLE", "ALL", "*"
GetSender = "alle"
Case "HAUPT", "HS"
GetSender = "HS"
Case "ARD"
GetSender = "ARD"
Case "ZDF"
GetSender = "ZDF"
Case "RTL"
GetSender = "RTL"
Case "SAT.1", "SAT1"
GetSender = "SAT.1"
Case "PRO7"
GetSender = "PRO 7"
Case "KABEL1", "K1"
GetSender = "KABEL 1"
Case "RTL2"
GetSender = "RTL 2"
Case "SUPERRTL", "SRTL"
GetSender = "SUPER RTL"
Case "VOX"
GetSender = "VOX"
Case "3SAT"
GetSender = "3SAT"
Case "ARTE"
GetSender = "ARTE"
Case "REGIONAL"
GetSender = "RS"
Case "NDR"
GetSender = "NDR"
Case "WDR"
GetSender = "WEST"
Case "BAYERN"
GetSender = "BAYERN"
Case "MDR"
GetSender = "MDR"
Case "HESSEN"
GetSender = "HESSEN"
Case "SWIII", "SW3"
GetSender = "SW III"
Case "TVBERLIN", "TVB"
GetSender = "TV BERLIN"
Case "TVNRW"
GetSender = "TVNRW"
Case "TVM_NCHEN", "TVMUENCHEN", "TVM"
GetSender = "TV MÜNCHEN"
Case "HAMBURG1", "H1"
GetSender = "HAMBURG 1"
Case "RBB"
GetSender = "RBB"
Case "FAB"
GetSender = "FAB"
Case "HAUPTREG", "HAUPTREGIONAL"
GetSender = "HR"
Case "SPARTEN"
GetSender = "SS"
Case "9LIVE", "NEUNLIVE"
GetSender = "NEUNLIVE"
Case "MTV"
GetSender = "MTV"
Case "MTV2"
GetSender = "MTV2"
Case "VIVA"
GetSender = "VIVA"
Case "VIVAPLUS", "VIVA+"
GetSender = "VIVAPLUS"
Case "DSF"
GetSender = "DSF"
Case "EUROSPORT"
GetSender = "EUROSPORT"
Case "N-TV", "NTV"
GetSender = "N-TV"
Case "N24"
GetSender = "N24"
Case "EURONEWS"
GetSender = "EURONEWS"
Case "KIKA", "KINDERKANAL"
GetSender = "KINDER KANAL"
Case "PHOENIX"
GetSender = "PHOENIX"
Case "TELE5"
GetSender = "TELE5"
Case "XXP"
GetSender = "XXP"
Case "AUSLAND"
GetSender = "AS"
Case "CNN"
GetSender = "CNN"
Case "NBC"
GetSender = "NBC-SUPER"
Case "BBCWORLD"
GetSender = "BBCWORLD"
Case "FRANCE2"
GetSender = "ANTENNE 2"
Case "FR3"
GetSender = "FR 3"
Case "TV5"
GetSender = "TV 5"
Case "TF1"
GetSender = "TF 1"
Case "ORF1"
GetSender = "ORF 1"
Case "ORF2"
GetSender = "ORF 2"
Case "DK1"
GetSender = "D-NEMARK 1"
Case "DK2"
GetSender = "D-NEMARK 2"
Case "SF1"
GetSender = "SF1"
Case "SF2"
GetSender = "SF2"
Case "NL1"
GetSender = "HOLLAND 1"
Case "NL2"
GetSender = "HOLLAND 2"
Case "NL3"
GetSender = "HOLLAND 3"
Case "TRT"
GetSender = "TRT"
Case "PREMIERE/"
GetSender = "PY"
Case "DIGITAL-TV", "DIGITAL", "DIGITALTV"
GetSender = "PY"
Case "PRSTART", "PREMIERESTART", "PREMIERE-START"
GetSender = "PREMIERE"
Case "PREMIERE1"
GetSender = "prem1"
Case "PREMIERE2"
GetSender = "prem2"
Case "PREMIERE3"
GetSender = "prem3"
Case "PREMIERE4"
GetSender = "prem4"
Case "PREMIERE5"
GetSender = "prem5"
Case "PREMIERE6"
GetSender = "prem6"
Case "PREMIERE7"
GetSender = "prem7"
Case "PRSPORT1", "PREMIERESPORT1", "PREMIERE-SPORT1"
GetSender = "premspo1"
Case "PRSPORT2", "PREMIERESPORT2", "PREMIERE-SPORT2"
GetSender = "premspo2"
Case "PREMIEREDIREKT1", "PREMIERE-DIREKT1"
GetSender = "premdirekt1"
Case "PREMIEREDIREKT2", "PREMIERE-DIREKT2"
GetSender = "premdirekt2"
Case "PREMIEREDIREKT3", "PREMIERE-DIREKT3"
GetSender = "premdirekt3"
Case "PREMIEREDIREKT4", "PREMIERE-DIREKT4"
GetSender = "premdirekt4"
Case "PRKRIMI", "PREMIEREKRIMI", "PREMIERE-KRIMI"
GetSender = "krimi"
Case "PRSERIE", "PREMIERESERIE", "PREMIERE-SERIE"
GetSender = "premserie"
Case "PRNOSTALGIE", "PREMIERENOSTALGIE", "PREMIERE-NOSTALGIE"
GetSender = "premnostalgie"
Case "PREROTIK1", "PREMIEREEROTIK1", "PREMIERE-EROTIK1"
GetSender = "premerotik1"
Case "PREROTIK2", "PREMIEREEROTIK2", "PREMIERE-EROTIK2"
GetSender = "premerotik2"
Case "PREROTIK3", "PREMIEREEROTIK3", "PREMIERE-EROTIK3"
GetSender = "premerotik3"
Case "BEATEUHSE", "UHSETV", "BUHSE"
GetSender = "uhsetv"
Case "DISCOVERY"
GetSender = "discov"
Case "13THSTREET", "STREET"
GetSender = "street"
Case "DISNEY"
GetSender = "disney"
Case "FOXKIDS", "FOX-KIDS"
GetSender = "foxkids"
Case "JUNIOR"
GetSender = "junior"
Case "ANIMAL PL."
GetSender = "animal"
Case "PRSCIFI", "PREMIERESCIFI", "PREMIERE-SCIFI"
GetSender = "premscifi"
Case "MGM"
GetSender = "mgm"
Case "CLASSICA"
GetSender = "classic"
Case "HIT24"
GetSender = "hit24"
Case "GOLDSTAR"
GetSender = "goldstar"
Case "HEIMATKANAL", "HEIMAT"
GetSender = "heimat"
Case "PRAUSTRIA", "PREMIEREAUSTRIA", "PREMIERE-AUSTRIA"
GetSender = "premaustria"
Case "EINSEXTRA", "1EXTRA"
GetSender = "extra"
Case "EINSFESTIVAL", "1FESTIVAL"
GetSender = "festival"
Case "EINSMUXX", "1MUXX"
GetSender = "muxx"
Case "ZDFDOKU", "ZDF-DOKU"
GetSender = "doku"
Case "ZDFINFO", "ZDF-INFO"
GetSender = "info"
Case "ZDFTHEATER", "ZDF-THEATER"
GetSender = "theater"
Case Else
GetSender = vbNullString
End Select
End Function