'+-------------------------------------+
'| Get Siteinfo 1.0 © sts
'|
'| Don`t change the author!
'|
'| Website : www.AnGelBot-Portal.de
'|-------------------------------------+
'| PartyLine Setup ------------[ ]
'| Anlegung einer INI-Datei ---[ ]
'| Channeleinstellungen ------ [x]
'|-------------------------------------+
'#################Einstellungen###############
'Channels indem das Script aktiv sein soll
Const AktivChans = "*" 'Mit "Leerzeichen trennen (* für alle Channels)
'##########Don`t edit!!#######################
Const Host = "magazine.web.de"
Const ScriptName = "Get Siteinfo 1.0 by sts, Horoskop by muffe"
Const DebugIt = False 'Erweiterte Meldungen
Dim Channels, LastNews, Recieved, aNick, aChan, Horoskop
Sub Init()
GetNews
SpreadFlagMessage 0, "+m", "7 " & ScriptName & " loaded"
Hook "Chan_Msg"
End Sub
Sub Chan_Msg(Chan, Nick, RegUser, Line)
If LCase(Param(Line, 1)) = "!horoskop" Then
If InStr(LCase(AktivChans), LCase(Chan)) > 0 Or AktivChans = "*" Then
aNick = Nick
aChan = chan
GetNews
Horoskop = Param(Line, 2)
Horoskop = Replace(Horoskop, "Widder", "1")
Horoskop = Replace(Horoskop, "Stier", "2")
Horoskop = Replace(Horoskop, "Zwillinge", "3")
Horoskop = Replace(Horoskop, "Krebs", "4")
Horoskop = Replace(Horoskop, "Löwe", "5")
Horoskop = Replace(Horoskop, "Jungfrau", "6")
Horoskop = Replace(Horoskop, "Waage", "7")
Horoskop = Replace(Horoskop, "Skorpion", "8")
Horoskop = Replace(Horoskop, "Schütze", "9")
Horoskop = Replace(Horoskop, "Steinbock", "10")
Horoskop = Replace(Horoskop, "Wassermann", "11")
Horoskop = Replace(Horoskop, "Fische", "12")
Horoskop = Replace(Horoskop, "widder", "1")
Horoskop = Replace(Horoskop, "stier", "2")
Horoskop = Replace(Horoskop, "zwillinge", "3")
Horoskop = Replace(Horoskop, "krebs", "4")
Horoskop = Replace(Horoskop, "löwe", "5")
Horoskop = Replace(Horoskop, "jungfrau", "6")
Horoskop = Replace(Horoskop, "waage", "7")
Horoskop = Replace(Horoskop, "skorpion", "8")
Horoskop = Replace(Horoskop, "schütze", "9")
Horoskop = Replace(Horoskop, "steinbock", "10")
Horoskop = Replace(Horoskop, "wassermann", "11")
Horoskop = Replace(Horoskop, "fische", "12")
If Horoskop = vbNullString Then
SendLine "Notice " & Nick & " :Bitte ein Sternzeichen angeben!", 3
End If
End If
End If
End Sub
Sub GetNews()
vSock = SockConnect(Host, 80, "SockEvent")
If vSock = 0 Then
SpreadFlagMessage 0, "+m", "5*** GetInfo: Couldn't create socket"
End If
End Sub
Sub SockEvent(vSock, SEvent, SData)
Dim Header2, Info, Info2
Select Case SEvent
Case SE_ConnectFailed
SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Connection to " & Host & " failed. Please contact the Author."
Sendline "PrivMsg " & aNick & " : Connection to " & Host & " failed. Please contact your botowner",3
Case SE_Connected
If Proxy = vbNullString Then
Header = "GET /de/themen/lifestyle/horoskop/tag/1527018,d=1,g=2,r=2,rz=7,t=0,z=" & Horoskop & ".html"
Else
Header = "GET http://" & Host & "/de/themen/lifestyle/horoskop/tag/1527018,d=1,g=2,r=2,rz=7,t=0,z=" & Horoskop & ".html"
End If
SockWrite vSock, Header & " HTTP/1.0" & vbCrLf & Header2 & _
"Accept: text/html" & vbCrLf & _
"User-Agent: AnGeL-Bot " & LongBotVersion & " (www.AnGeLBot-Portal.de)" & 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, "<h1 class=""hor"">") > 0 Then
Recieved = Replace(Recieved, vbCrLf, vbNullString)
Dummy = "<h1 class=""hor"">"
Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
Info = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "<span>") - 1 ))
Sendline "PrivMsg " & aChan & " : " & Info,1
If InStr(1, Recieved, "</p><p>") > 0 Then
Recieved = Replace(Recieved, vbCrLf, vbNullString)
Dummy = "</p><p>"
Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
Info2 = ReplaceHTMLCode(Left(Recieved, InStr(1, Recieved, "</p>") - 1 ))
Sendline "PrivMsg " & aChan & " : " & Info2,1
Else
If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Couldn't recieve HTML page..."
Sendline "Notice " & aNick & " : No Infos available. Please contact the botowner -_-",3
End If
End If
Recieved = vbNullString
End Select
End Sub
Function ReplaceHTMLCode(Text)
'Für "Carriage return–linefeed combination."
Text = Replace(Text, VbCrLf, "")
'Für "Line feed."
Text = Replace(Text, vbLf, "")
'Für "Form feed; not useful in Microsoft Windows."
Text = Replace(Text, vbFormFeed, "")
'Für "Platform-specific newline character; whatever is appropriate for the platform.
Text = Replace(Text, vbNewLine, "")
'Für "Character having the value 0.
Text = Replace(Text, vbNullChar, "")
'Für "Not the same as a zero-length string (""); used for calling external procedures.
Text = Replace(Text, vbNullString, "")
'Für "Horizontal tab.
Text = Replace(Text, vbTab, "")
'Für "Vertical tab; not useful in Microsoft Windows.
Text = Replace(Text, vbVerticalTab, "")
Text = Replace(Text, vbCr, "")
Text = Replace(Text, "ü", "ü")
Text = Replace(Text, "ß", "ß")
Text = Replace(Text, "ä", "ä")
Text = Replace(Text, "ö", "ö")
Text = Replace(Text, "ü", "ü")
Text = Replace(Text, "ß", "ß")
Text = Replace(Text, "ä", "ä")
Text = Replace(Text, "ü", "ü")
Text = Replace(Text, "ö", "ö")
ReplaceHTMLCode = Text
End Function
.