AnGelBot-Portal²

Also der Heppi hat mal ein script gemacht das die news für das cute news system aus einer txt liest nach einem server wechsel funktioniert es nicht merh hoffe das kann jemand beheben ?

Fehler : *** Hektik4Ever.De: Incorrect file content!

Zitat:'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'
' Hektik4you.net NewsReader '
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'
' '
' Version 1.0 © by Heppi '
' '
' Erstellt mit SciTE Version 1.57 '
' '
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'

Option Explicit

' Soll der Link zu den News angezeigt werden? (Standard: True [ja])
Const ShowLink = false

' Sollen Farben in der Message verwendet werden ? Sollte der Channelmode +c (no colors) gesetzt sein,
' werden die Farben automatisch entfernt!
Const UseColors = True

' Nach wie vielen Sekunden soll der Bot automatisch auf neue News prüfen?
' Eine zu kleine Einstellung verursacht hohen Traffic !! Traffic ist auf den meisten Servern begrenzt!
Const iUpdateTime = 600

' Trigger um die News anzeigen zu lassen.
Const sNewsTrigger = "!news"
Const sLastNewsTrigger = "!lastnews"

' Template für die News.
' Variablen:
' $title - Wird durch den Title der News ersetzt
' $link - Wird durch den Link zu der News ersetzt
Const sTemplate = "«« News: http://www.Hektik4ever.de «•» : $title »» $link"
Const sLinkTemplate = "- hektik4ever.de/page.php?subaction=showfull&id=$id&archive=&start_from=&ucat=$cat"

' Channels in denen die Trigger aktiv sind ("*" für alle
' Channels in denen der Bot ist).
Const sChannels = "*"

' Channels in die der Bot automatisch neue News schreibt (Mit Komma(,) trennen !!!!
Const AutoMessageChans = "#hektik4you"

' Serverdaten
Const sHost = "hektik4ever.de"
Const lPort = 80
Const ini_h = "ini_h2y.ini"

' Flood protection. Zeit für die der Triger nach einer
' Abfrage gesperrt ist.
Const iFloodProt = 10

Dim Connections(), dLastRequest

Sub Init()
Dim ScriptName, Version

ScriptName = "Hektik4ever.de NewsReader"
Version = "1.0"
Script ScriptName & " v" & Version & " by Heppi"

ReDim Connections(0)
Set Connections(0) = New clsH4Y

dLastRequest = CDate("01.01.1970 00:00:00")

GetData "", 1

Hook "Chan_msg"

SpreadFlagMessage 0, "+m", "*** " & ScriptName & " v" & Version & " by Heppi loaded..."
' http://www.hektik4ever.de/news/data/news.txt
End Sub

Class clsH4Y
Public iIndex, bBusy, sQuery, sChan, iMode
Private sHTML, lId, sName, sTitle, sShortText, sLongText, iUCat, sNewsData, sNews

Private Sub Class_Initialize()
Call ResetClass
End Sub

Public Sub Connect()
Dim vSock
bBusy = True

vSock = SockConnect(sHost, lPort, "Connections(" & iIndex & ").SockEvent")
If vSock <= 0 Then
SpreadFlagMessage 0, "+m", "4*** Hektik4ever.de NewsReader: Couldn't create socket!"
End If
End Sub

Public Sub SockEvent(vSock, iEvent, sData)
Select Case iEvent
Case SE_ConnectFailed
SpreadFlagMessage 0, "+m", "4*** Hektik4ever.de NewsReader: Connection to '" & sHost & ":" & lPort & "' failed!"
Case SE_Connected
SockWrite vSock, "GET /news/data/news.txt HTTP/1.0" & vbCrLf & _
"Accept: text/html" & vbCrLf & _
"User-Agent: Mozilla/4.0 (AnGeL-Bot " & LongBotVersion & "; Hektik4ever.de; [www.AnGelBot-Portal.de])" & vbCrLf & _
"Host: " & sHost & ":" & lPort & vbCrLf & _
"Pragma: no-cache" & vbCrLf & _
"Connection: close" & vbCrLf & vbCrLf
Case SE_Read
sHTML = sHTML & sData
Case SE_Closed
Dim i
If InStr(1, sHTML, "progid:DXImageTransform.Microsoft.Shadow", vbTextCompare) > 0 Then

sNews = Split(sHTML, vbLf)

If iMode = 1 Then
sNewsData = Split(StripTags(sNews(10)), "|")

lId = Right(sNewsData(0), 10)
sName = Trim(sNewsData(1))
sTitle = Trim(sNewsData(2))
sShortText = Trim(sNewsData(3))
sLongText = Trim(sNewsData(4))
iUCat = Trim(sNewsData(6))

If ReadINIString("NewsData", "last_id", 0, ini_h) <> lId Then
WriteINIString "NewsData", "last_id", lId, ini_h
CreateMessage AutoMessageChans, lId, sName, sTitle, iUCat, ""
End If

WriteINIString "NewsData", "last_id", lId, ini_h

If sChan <> "" Then
CreateMessage sChan, lId, sName, sTitle, iUCat, ""
End If
ElseIf iMode = 2 Then
For i = 10 To (5 + 9) Step 1
sNewsData = Split(StripTags(sNews(i)), "|")

lId = Right(sNewsData(0), 10)
sName = Trim(sNewsData(1))
sTitle = Trim(sNewsData(2))
sShortText = Trim(sNewsData(3))
sLongText = Trim(sNewsData(4))
iUCat = Trim(sNewsData(6))
CreateMessage sChan, lId, sName, sTitle, iUCat, False
Next
End If
SpreadFlagMessage 0, "+m", "14*** Hektik4Ever.De: Update done."
Else
SpreadFlagMessage 0, "+m", "4*** Hektik4Ever.De: Incorrect file content!"
End If
TimedCommand "GetData vbNullString, 1", iUpdateTime
Call ResetClass
End Select
End Sub


Private Sub ResetClass()
sHTML = vbNullString
sChan = vbNullString
iIndex = -1
bBusy = False
End Sub
End Class


Sub SendMessage(Destination, Text)
If UseColors = False Then
SendLine "PRIVMSG " & Destination & " :" & Strip(Text), 3
Else
SendLine "PRIVMSG " & Destination & " :" & Text, 3
End If
End Sub


Sub Chan_Msg(Chan, Nick, RegUser, Line)
Dim iNewz
If sChannels <> "*" Then
If InStr(1, " " & LCase(sChannels) & " ", " " & LCase(Chan) & " ") = 0 Then Exit Sub
End If

Select Case LCase(Param(Line, 1))
Case LCase(sNewsTrigger)
If iFloodProt > 0 Then
If DateDiff("s", dLastRequest, Now) > iFloodProt Then
dLastRequest = Now
Else
SpreadFlagMessage 0, "+m", "4*** Hektik4ever.De NewsReader: (" & Chan & ") " & Nick & "'s query was blocked due to flood (" & DateDiff("s", dLastRequest, Now) & "; " & dLastRequest & ")"
Exit Sub
End If
End If
GetData Chan, 1
Case LCase(sLastNewsTrigger)
If iFloodProt > 0 Then
If DateDiff("s", dLastRequest, Now) > iFloodProt Then
dLastRequest = Now
Else
SpreadFlagMessage 0, "+m", "4*** Hektik4ever.De NewsReader: (" & Chan & ") " & Nick & "'s query was blocked due to flood (" & DateDiff("s", dLastRequest, Now) & "; " & dLastRequest & ")"
Exit Sub
End If
End If
GetData Chan, 2
End Select

End Sub

Sub CreateMessage(Chan, lId, sName, sTitle, iUCat, bShowURL)
Dim sMessage, sLink

If ShowLink Then
sLink = Trim(Replace(Replace(sLinkTemplate, "$id", lId), "$cat", iUCat))
Else
sLink = ""
End If

If bShowURL = False Then sLink = ""

sMessage = Replace(Replace(Replace(Replace(sTemplate, "$id", lId), "$name", sName), "$title", sTitle), "$link", sLink)
SendMessage Chan, sMessage
End Sub

Sub GetData(Chan, Mode)
Dim i
For i = LBound(Connections) To UBound(Connections)
If Connections(i).bBusy = False Then
Set Connections(i) = New clsH4Y
Connections(i).iIndex = i
Connections(i).sChan = Chan
Connections(i).iMode = Mode
Connections(i).Connect
Exit Sub
End If
Next

ReDim Preserve Connections(UBound(Connections) + 1)
i = UBound(Connections)

Set Connections(i) = New clsH4Y
Connections(i).iIndex = i
Connections(i).sChan = Chan
Connections(i).iMode = Mode
Connections(i).Connect
End Sub

Function StripColors(Line)
Dim i, Colors, StripC, StripOut
Colors = "0123456789"
StripC = 0
StripOut = ""
For i = 1 To Len(Line)
Select Case Mid(Line,i,1)
Case Chr(3)
StripC = 1
Case ","
If (StripC > 0) Then StripC = 1
Case Else
If (StripC > 0) Then
If Not (InStr(Colors,Mid(Line,i,1)) > 0) Then
StripOut = StripOut & Mid(Line,i,1)
StripC = 0
Else
StripC = StripC + 1
If (StripC > 3) Then
StripC = 0
StripOut = StripOut & Mid(Line,i,1)
End If
End If
Else
StripOut = StripOut & Mid(Line,i,1)
End If
End Select
Next
StripColors = StripOut
End Function

Function StripTags(HTML)
Dim mStartPos, mEndPos, mString

mStartPos = InStr(HTML, "<")
mEndPos = InStr(HTML, ">")

Do While mStartPos > 0
If mStartPos < mEndPos Then
'gültigen Tag gefunden
HTML = Mid(HTML, 1, mStartPos - 1) & Mid(HTML, mEndPos + 1)
Else
If mEndPos > 0 Then
'Start und Endtag, aber nicht richtige Reihenfolge
HTML = Mid(HTML, mEndPos + 1)
Else
'Start aber kein Endtag
HTML = Mid(HTML, 1, mStartPos - 1)
End If
End If
mStartPos = InStr(HTML, "<")
mEndPos = InStr(HTML, ">")
Loop

If mStartPos = 0 And mEndPos > 0 Then
'kein Start- aber ein Endtag
HTML = Mid(HTML, mEndPos + 1)
End If

StripTags = Trim(HTML)
End Function

hmm keine da der den fehler beheben kann ? ? : :(

wäre gut wenn de den neuen server und den neuen link zu der txt-datei dabei schreiben würdest.

die neuen daten stehen doch schon drin das ist es ja ... zudem geht das script bei einem anderen server noch nur bei unserem kommt immer die fehlermeldung :(

währe schon wenn das jemand reparieren kann... wir möchten aber kein neues weil das das wir haben is einfach nur geil mit der TXT nur halt fehler drin

Was soll man bitte behaben wenn das auf manchen Servern funktioniert und auf manchen nicht? Also funktionsfähig ist es ja nur wie ja oben geschrieben wurde auf eurem neuen Server nicht. Also würd ich ma sagen das dass am Server statt am Script liegt.

MfG sts

Wenn ich das richtig sehe liegt es am Aufbau eurer txt-Datei. Besorgt euch mal eine txt-Datei von einem Server wo es läuft und guckt euch den Inhalt an. Löscht daraus nichts was euch unwichtig erscheint, sondern nur das so wie sicher seit das es nicht gebraucht wird. Die Meldung die du bekommst wird von einem If Vergleich ausgelöst, der Überprüft ob in der Datei folgender Text vorkommt: "progid:DXImageTransform.Microsoft.Shadow". Ist dies nicht der Fall beendet das Script mit der entsprechenden Meldung. Es gibt nun 2 Möglichkeiten: entweder löscht man die Überprüfung raus oder man holt sich eine Datei von jemandem bei dem es läuft. In dieser Datei wird der eben angegebene Text wohl in einem HTML-Tag zu finden sein.

MfG sts

woooow

erst mal ein fettes dangge die sich daran gesetzt haben :D

nu geht alles wieder wie gewohnt ... *verbeug*
dangge dangge dangge