1. Die HP darf sich NIEMALS ändern, NIX GARNIX!! Auch nicht die Farbe der Online/offline anzeige, nix null nothing....
Code:
'################################
'Status News-Ticker
'Funktionen + Setup sind von einem Script von Sp33d
'Der Rest by sts
'Habt Anstand und macht aus diesem Script nicht euer eigenes, lernt selbst wie man scriptet!!!
'################################
Const Host = "www.netw0rkz.de"
Const INIFile = "ini_status.ini"
Const Version = "Status-News-Ticker 1.0 by sts"
Const ScriptName = "Server-Status"
Const DebugIt = False 'Erweiterte Meldungen
Const TF_CreateNot = 0
Const TF_CreateIfExists = 1
Const TF_CreateIfNotExists = 2
Const TF_Create = 4
Dim Channels, LastNews, Recieved
Sub Init()
Script Version
Hook "Commands"
Hook "Chan_Msg"
AddCommand "serverstatus", Cl_Mas, "+m", "2*** .status##14Zeigt das " & ScriptName & " Setup in dem die Channel,##14in denen der Ticker angezeigt werden soll verändert##14werden können."
ReloadChannels
GetNews
SpreadFlagMessage 0, "+m", "3Um das Script zu konfigurieren gib nun .serverstatus ein."
End Sub
Sub ReloadChannels()
Channels = ReadINIString("Settings", "Channels", "", INIFile)
End Sub
Sub Commands(vSock, RegUser, Flags, Line)
If LCase(Param(Line, 1)) = ".serverstatus" Then
GrabUser vSock, "" & ScriptName & " Setup", "StatusSetup"
SetSockTag vSock, "MainMenu"
StatusSetup vSock, RegUser, Flags, ""
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, " 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%,"
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%,"
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%,"
TU vSock, " "
TU vSock, "Willkommen im Setup vom " & Version & "!"
TU vSock, "Du befindest dich im Hauptmenü."
TU vSock, " "
TU vSock, "0,1 Ticker 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, " - 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, ChipFile
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
Case Else
TU vSock, "5*** Ungültiger Befehl"
End Select
End Select
End Sub
Sub GetNews()
If Trim(Channels) <> "" Then
If Proxy = vbNullString Then
vSock = SockConnect(Host, "80", "SockEvent")
Else
vSock = SockConnect(Proxy, ProxyPort, "SockEvent")
End If
If vSock = 0 Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Couldn't create socket"
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", 30
Case SE_Connected
If Proxy = vbNullString Then
Header = "GET /ragnarok/status.php"
Else
Header = "GET http://" & Host & "/ragnarok/status.php"
End If
SockWrite vSock, Header & " HTTP/1.0" & vbCrLf & Header2 & _
"Accept: text/html" & vbCrLf & _
"User-Agent: AnGeL-Bot " & LongBotVersion & " (www.Saug-Hilfe-Fuer-Alle.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, "<LI TYPE=SQUARE>") > 0 Then
Recieved = Replace(Recieved, vbCrLf, vbNullString)
Dummy = "Login Server</DIV></TD><TD><DIV style=""color:'#58FF7F';font-face:Arial;font-size:12px"">"
Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
tmp_Dummy = Left(Recieved, InStr(1, Recieved, "<") - 1 )
tmp_Login = tmp_Dummy
If DebugIt Then SpreadFlagMessage 0, "+m", "Server No. 1: " & tmp_Login
Dummy = "Char Server</DIV></TD><TD><DIV style=""color:'#58FF7F';font-face:Arial;font-size:12px"">"
Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
tmp_Dummy = Left(Recieved, InStr(1, Recieved, "<") - 1 )
tmp_Char = tmp_Dummy
If DebugIt Then SpreadFlagMessage 0, "+m", "Server No. 2: " & tmp_Char
Dummy = "Zone Server</DIV></TD><TD><DIV style=""color:'#58FF7F';font-face:Arial;font-size:12px"">"
Recieved = Right(Recieved, Len(Recieved) - InStr(1, Recieved, Dummy) - Len(Dummy) + 1)
tmp_Dummy = Left(Recieved, InStr(1, Recieved, "<") - 1 )
tmp_Zone = tmp_Dummy
If DebugIt Then SpreadFlagMessage 0, "+m", "Server No. 3: " & tmp_Zone
Dummy = "1,15» Server-Status - »» Login Server: " & tmp_Login & " Char Server: " & tmp_Char & " Zone Server: " & tmp_Zone & ""
If Dummy <> LastNews Then
If DebugIt Then SpreadFlagMessage 0, "+m", "New news!"
LastNews = Dummy
Dummy = Split(Channels, " ")
For i = LBound(Dummy) To UBound(Dummy)
If DebugIt Then SpreadFlagMessage 0, "+m", "Sending to " & Dummy(i) & " :" & "PRIVMSG " & Dummy(i) & " :" & LastNews
SendLine "PRIVMSG " & Dummy(i) & " : " & LastNews, 2
Next
End If
Else
If DebugIt Then SpreadFlagMessage 0, "+m", "5*** " & ScriptName & ": Couldn't recieve HTML page..."
End If
Recieved = vbNullString
TimedCommand "GetNews", 120
End Select
End Sub
Function Trim3(Text)
Trim3 = Replace(Replace(Trim(Text), " ", " "), " ", " ")
End Function
Function TestFile(Path, CreateNew)
Silent True
FNum = FileOpen(Path, FA_Read)
If FNum <> 0 Then vExists = True
FileClose FNum
Select Case CreateNew
Case TF_CreateNot
If vExists = True Then TestFile = TF_CreateNot
Case TF_CreateIfExists
If vExists = True Then
FNum = FileOpen(Path, FA_Write)
FileWrite FNum, ""
FileClose FNum
TestFile = TF_CreateIfExists
Else
TestFile = TF_Error
End If
Case TF_CreateIfNotExists
If vExists = True Then
TestFile = TF_Error
Else
FNum = FileOpen(Path, FA_Write)
FileWrite FNum, ""
FileClose FNum
TestFile = TF_CreateIfNotExists
End If
Case TF_Create
FNum = FileOpen(Path, FA_Write)
FileWrite FNum, ""
FileClose FNum
TestFile = TF_Create
End Select
Silent False
End Function
'rfc1521
'2001 Antonin Foller, PSTRUH Software, http://pstruh.cz
Function Base64Encode(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Function RemoveSIDs(URL)
Dim i, strArguments, strBefore
If InStr(1, URL, "?") > 0 Then
i = 1
strArguments = Mid(URL, InStr(1, URL, "&"))
strBefore = Mid(URL, 1, InStr(1, URL, "&") - 1)
Do While i <= GetArgumentCount(strArguments)
If UCase(GetArgumentName(strArguments, i)) = "PHPSESSID" Or LCase(GetArgumentName(strArguments, i)) = "amp" Then
strArguments = DelParamX(strArguments, "&", i)
If strArguments <> vbNullString Then
If Left(strArguments, 1) = "&" Then
strArguments = "?" & Mid(strArguments, 2)
ElseIf Left(strArguments, 1) <> "?" Then
strArguments = "?" & strArguments
End If
End If
i = 1
Else
i = i + 1
End If
Loop
RemoveSIDs = strBefore & strArguments
Else
RemoveSIDs = URL
End If
End Function
Function GetArgumentCount(URL)
If InStr(1, URL, "?") > 0 Then
Dim strArguments
strArguments = Mid(URL, InStr(1, URL, "?") + 1)
GetArgumentCount = ParamXCount(strArguments, "&") + 1
Else
GetArgumentCount = 0
End If
End Function
Function GetArgumentName(URL, Num)
If Num > 0 And Num <= GetArgumentCount(URL) Then
Dim strArguments
strArguments = Mid(URL, InStr(1, URL, "?") + 1)
If InStr(1, strArguments, "&") = 0 Then strArguments = strArguments & "&"
GetArgumentName = ParamX(ParamX(strArguments, "&", Num), "=", 1)
Else
GetArgumentName = vbNullString
End If
End Function
Function GetArgumentValue(URL, Num)
If Num > 0 And Num <= GetArgumentCount(URL) Then
Dim strArguments
strArguments = Mid(URL, InStr(1, URL, "?") + 1)
If InStr(1, strArguments, "&") = 0 Then strArguments = strArguments & "&"
GetArgumentValue = ParamX(ParamX(strArguments, "&", Num), "=", 2)
Else
GetArgumentValue = vbNullString
End If
End Function
Function DelParam(Text, Num)
If Num > 0 And Num <= ParamCount(Text) Then
Dim i, newString
For i = 1 To Num - 1
If newString = vbNullString Then
newString = Param(Text, CInt(i))
Else
newString = newString & " " & Param(Text, CInt(i))
End If
Next
newString = newString & " " & GetRest(Text, Num + 1)
DelParam = newString
Else
DelParam = vbNullString
End If
End Function
Function DelParamX(Text, Delimiter, Num)
If Num > 0 And Num <= ParamXCount(Text, Delimiter) Then
Dim i, newString
For i = 1 To Num - 1
If newString = vbNullString Then
newString = ParamX(Text, Delimiter, i)
Else
newString = newString & Delimiter & ParamX(Text, Delimiter, CInt(i))
End If
Next
newString = newString & Delimiter & GetRestX(Text, Delimiter, Num + 1)
If Right(newString, 1) = Delimiter Then newString = Left(newString, Len(newString) - 1)
If Left(newString, 1) = Delimiter Then newString = Mid(newString, 2)
DelParamX = newString
Else
DelParamX = vbNullString
End If
End Function
