 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
 Verfasst am: 15.07.2007, 07:13 Titel: Wiki und Stupi |
 |
|
Hatte heut Nacht lust meinen Chatbot mit einer neuen Funktion zu begluecken 
Eine einfache Wikipedia und Stupidedia Function die in den beiden nach einer Maske sucht und das ergebnis (nicht das komplette) in einen String zurueck gibt...
Die Stupidedia Function hab ich spaeter zusaetzlich intrigiert da die beiden sich relativ aehnlich sind, bedarf aber sicher noch einer korrektur, funktioniert ansonsten aber schon recht gut 
| Code: |
Dim Shared Referer as String
Randomize Timer
Const InterfaceName="Interface!"
Const StandardRaum="BlackHeart"
Const Agent="Mozilla/5.0%20(Windows;%20U;%20Windows%20NT%205.1;%20de;%20rv:1.8.1.4)%20Gecko/20070515%20Firefox/2.0.0.4"
Const RefererX="http://www.willst-du-mein-freund-sein.com/"
Const RECVBUFFLEN = 8192
Const NEWLINE = !"\r\n"
'<HEAD> Bot-V4-httpX ---------------------------------------------------------'
#inclib "SDL_net"
Type Uint16 as ushort
type Uint32 as uinteger
type IPaddress
host as Uint32
port as Uint16
end type
Type TCPsocket as _TCPsocket ptr
Extern "c"
declare function SDLNet_Init () as integer
declare function SDLNet_ResolveHost (byval address as IPaddress ptr, byval host as zstring ptr, byval port as Uint16) as integer
declare function SDLNet_TCP_Open (byval ip as IPaddress ptr) as TCPsocket
declare function SDLNet_TCP_Recv (byval sock as TCPsocket, byval data as any ptr, byval maxlen as integer) as integer
declare function SDLNet_TCP_Send (byval sock as TCPsocket, byval data as any ptr, byval len as integer) as integer
declare sub SDLNet_TCP_Close (byval sock as TCPsocket)
declare sub SDLNet_Quit ()
End Extern
Const recv_timeout = 10 '100 seconds
Declare Function TCP_open (Byval hostname As String) As TCPSocket
Declare Function TCP_http (Byval method As String="get", Byval Socket As TCPSocket, Byval hostname As String, Byval path As String="", Byval SendWork as Integer=0) As Integer
Declare Function TCP_recv (Byval socket As TCPSocket) As String
Declare Function TCP_close (Byval socket As TCPSocket) As Integer
'************************************
Function TCP_open (Byval hostname As String) As TCPSocket
'************************************
'' init
If( SDLNet_Init <> 0 ) Then
'print "Error: SDLNet_Init failed"
Return 0
End If
'' resolve
Dim ip As IPAddress
Dim socket As TCPSocket
If( SDLNet_ResolveHost( @ip, hostname, 80 ) <> 0 ) Then
'print "Error: SDLNet_ResolveHost failed"
Return 0
End If
'' open
socket = SDLNet_TCP_Open( @ip )
If( socket = 0 ) Then
'print "Error: SDLNet_TCP_Open failed"
Return 0
End If
Return socket
'************************************
End Function 'TCP_open
'************************************
'************************************
Function TCP_http (Byval method As String="get", _
Byval Socket As TCPSocket, _
Byval hostname As String, _
Byval path As String="", _
Byval SendWork as Integer=0) As Integer
'************************************
'' send HTTP request
Dim sendbuffer As String
Dim MString As String
Select Case Lcase (method)
Case "get"
MString="GET /"
Case "post"
MString="POST /"
Case Else
MString="GET /"
End Select
SendBuffer= _
MString+path+" HTTP/1.1"+NEWLINE+ _
"Host: "+hostname+NEWLINE+ _
"Connection: close"+NEWLINE
If MString="POST /" Then SendBuffer+= _
"Accept-Encoding: gzip"+NEWLINE
SendBuffer+= _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"+NEWLINE+ _
"Accept-Language: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3"+NEWLINE+ _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7"+NEWLINE+ _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4"+NEWLINE+ _
"Referer: "+Referer+NEWLINE
If MString="POST /" Then SendBuffer+= _
"Content-type: application/x-www-form-urlencoded"+NEWLINE
SendBuffer+=NEWLINE
If( SDLNet_TCP_Send( socket, Strptr( sendbuffer ), Len( sendbuffer ) ) < Len( sendbuffer ) ) Then
'print "Error: SDLNet_TCP_Send failed"
Return -1
End If
Return 0
'************************************
End Function 'TCP_http
'************************************
'************************************
Function TCP_recv (Byval socket As TCPSocket) As String
'************************************
Dim TimeOut As Single
Dim TimeOutX As Single
TimeOut=Timer
'' receive til connection is closed
Dim recvbuffer As Zstring * RECVBUFFLEN+1
Dim recv_Buffer as String
Dim bytes As Integer
Do
If TimeOutX>recv_TimeOut Then Exit Do
bytes = SDLNet_TCP_Recv( socket, Strptr( recvbuffer ), RECVBUFFLEN )
If( bytes <= 0 ) Then
Sleep (100),1
Else
timeout=Timer
End If
'' add the null-terminator
recvbuffer[bytes] = 0
'' print it as string
'Print recvbuffer;
recv_Buffer+=mid(recvbuffer,1,Len(recvbuffer)-1)
TimeOutX=Timer-TimeOut
Loop While Instr(Lcase(recvbuffer),"</html>")=0
Return recv_Buffer
'************************************
End Function 'TCP_recv
'************************************
'************************************
Function TCP_close (Byval socket As TCPSocket) As Integer
'************************************
'' close socket
SDLNet_TCP_Close( socket )
'' quit
SDLNet_Quit
Return 0
'************************************
End Function 'TCP_close
'************************************
' KBot-V4-httpX </HEAD>------------------------------------------------'
Declare Sub Del_Tag (Byref Buffer as String)
Declare Function WikiSearch (byval Search as string, byval WoS as Integer) as String
'########################################################################'
'*
'* '' NEW '' Wiki Search Function '' !!!!!!!!!!
'*
'########################################################################'
Function WikiSearch (byval Search as string, byval WoS as Integer) as String
'########################################################################'
'Dim Send2Interface as Interface_Stream_
'Send2Interface.Color=&hFFFF00
'Send2Interface.Name=InterfaceName
'Send2Interface.Flag=1
Dim WHost as String
Dim WSearch as String
If WoS=0 Then
WHost="de.wikipedia.org"
WSearch="wiki/"
ElseIf WoS=1 Then
WHost="www.stupidedia.org"
WSearch="stupi/"
End If
Dim HTMLBuffer as String
Dim SearchString as String
SearchString=Mid(UCase(Trim(Search)),1,1)+Mid(LCase(Trim(Search)),2,Len(Trim(Search))-1)
Dim SearchStringBuffer as String
Dim SSBChar as String
Dim SO as Integer
for l as integer=1 to Len(SearchString)
SSBChar=(mid(SearchString,l,1))
If SO=1 Then SSBChar=UCase(SSBChar):SO=0
If asc(SSBChar)=32 Then
SSBChar=("_")
SO=1
End If
SearchStringBuffer+=SSBCHar
Next l
SearchString=SearchStringBuffer
WSearch+=trim(SearchString)
Dim Socket as TCPSocket
Socket=TCP_open (WHost)
TCP_http ("get",Socket,WHost,WSearch,0)
HTMLBuffer=TCP_recv(Socket)
Dim WikiStart as UInteger
Dim WikiEnd as UInteger
Dim WikiInf as String
Dim First as UInteger
First=1
If WoS=1 Then First=INSTR(HTMLBuffer,"<!-- start content -->")
WikiStart=INSTR(First,lcase(HTMLBuffer),"<p>")
'Send2Interface.Message=str(WikiStart)
'Send_TO_Interface (Send2Interface)
If WikiStart=0 Then Return "Not Found!"
WikiEnd=INSTR(WikiStart+3,lcase(HTMLBuffer),"</p>")
WikiInf=mid(HTMLBuffer,WikiStart,WikiEnd-WikiStart)
Del_Tag(WikiInf)
WikiInf=Trim(WikiInf)
If Len(WikiInf)=0 Then Return "0!"
If INSTR(lcase(WikiInf),"artikel verschwunden?") Then Return "Not found!"
If Len(WikiInf)<40 or mid(WikiInf,Len(WikiInf),1)=":" Then
Dim Last as Integer
Last=WikiEnd
for l as integer=0 to 2
WikiStart=INSTR(Last,lcase(HTMLBuffer),"<li>")
WikiEnd=INSTR(WikiStart+3,lcase(HTMLBuffer),"</li>")
If WikiStart>0 and WikiEnd>0 Then
WikiInf += (chr(32)+Str(l+1)+". "+mid(HTMLBuffer,WikiStart,WikiEnd-WikiStart))
Last=WikiEnd
End If
Next l
End If
Del_Tag(WikiInf)
WikiInf=Trim(WikiInf)
If Len(WikiInf)>699 Then
WikiInf=mid(WikiInf,1,700)
WikiStart=Len(WikiInf)
do
If mid(WikiInf,WikiStart,1)="." Then
WikiInf=mid(WikiInf,1,WikiStart)+"..."
Exit Do
End If
WikiStart-=1
loop
End If
Return WikiInf
End Function
'************************************
Sub Del_Tag (Byref Buffer as String)
'************************************
Dim LBuffer as String
Dim TC as UByte
Dim TCC as UByte
Dim BChar as String
Dim uml as UByte
For l as Integer=1 to Len(Buffer)
TCC=IIF(TC=0,1,0)
BChar=mid(Buffer,l,1)
If BChar="<" Then TC=1:TCC=0
If BChar=">" Then TC=0
If BChar="Ä" Then BChar="Ž"
If BChar="Ö" Then BChar="™"
If BChar="Ü" Then BChar="š"
If BChar="ä" Then BChar="„"
If BChar="ö" Then BChar="”"
If BChar="ü" Then BChar=""
If BChar="ß" Then BChar="á"
If BChar="§" Then BChar="õ"
If BChar="©" Then BChar="¸"
''For New WikiSearch Function''
If BChar=chr(10) Then BChar=Chr(32)
If TCC=1 Then LBuffer+=BChar
Sleep(1),1
next l
do
uml=0
If INSTR(LBuffer,"ü")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ü")-1)+"ue"+mid(LBuffer,INSTR(LBuffer,"ü")+6,Len(LBuffer)-(INSTR(LBuffer,"ü")+5))
End If
If INSTR(LBuffer,"ä")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ä")-1)+"ae"+mid(LBuffer,INSTR(LBuffer,"ä")+6,Len(LBuffer)-(INSTR(LBuffer,"ä")+5))
End If
If INSTR(LBuffer,"ö")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ö")-1)+"oe"+mid(LBuffer,INSTR(LBuffer,"ö")+6,Len(LBuffer)-(INSTR(LBuffer,"ö")+5))
End If
If INSTR(LBuffer,"ü")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ü")-1)+"ue"+mid(LBuffer,INSTR(LBuffer,"ü")+2,Len(LBuffer)-(INSTR(LBuffer,"ü")+1))
End If
If INSTR(LBuffer,"ä")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ä")-1)+"ae"+mid(LBuffer,INSTR(LBuffer,"ä")+2,Len(LBuffer)-(INSTR(LBuffer,"ä")+1))
End If
If INSTR(LBuffer,"ö")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ö")-1)+"oe"+mid(LBuffer,INSTR(LBuffer,"ö")+2,Len(LBuffer)-(INSTR(LBuffer,"ö")+1))
End If
If INSTR(LBuffer,"Ä")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"Ä")-1)+"Ae"+mid(LBuffer,INSTR(LBuffer,"Ä")+2,Len(LBuffer)-(INSTR(LBuffer,"Ä")+1))
End If
If INSTR(LBuffer,"ß")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ß")-1)+"ss"+mid(LBuffer,INSTR(LBuffer,"ß")+2,Len(LBuffer)-(INSTR(LBuffer,"ß")+1))
End If
If INSTR(LBuffer,"„")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"„")-1)+chr(34)+mid(LBuffer,INSTR(LBuffer,"„")+3,Len(LBuffer)-(INSTR(LBuffer,"„")+2))
End If
If INSTR(LBuffer,"“")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"“")-1)+chr(34)+mid(LBuffer,INSTR(LBuffer,"“")+3,Len(LBuffer)-(INSTR(LBuffer,"“")+2))
End If
If INSTR(LBuffer,"–")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"–")-1)+"-"+mid(LBuffer,INSTR(LBuffer,"–")+3,Len(LBuffer)-(INSTR(LBuffer,"–")+2))
End If
If INSTR(LBuffer,"−")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"−")-1)+"-"+mid(LBuffer,INSTR(LBuffer,"−")+3,Len(LBuffer)-(INSTR(LBuffer,"−")+2))
End If
If INSTR(LBuffer,"′")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"′")-1)+"'"+mid(LBuffer,INSTR(LBuffer,"′")+3,Len(LBuffer)-(INSTR(LBuffer,"′")+2))
End If
If INSTR(LBuffer,"″")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"″")-1)+chr(34)+mid(LBuffer,INSTR(LBuffer,"″")+3,Len(LBuffer)-(INSTR(LBuffer,"″")+2))
End If
If INSTR(LBuffer,"«")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"«")-1)+"«"+mid(LBuffer,INSTR(LBuffer,"«")+2,Len(LBuffer)-(INSTR(LBuffer,"«")+1))
End If
If INSTR(LBuffer,"»")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"»")-1)+"»"+mid(LBuffer,INSTR(LBuffer,"»")+2,Len(LBuffer)-(INSTR(LBuffer,"»")+1))
End If
If INSTR(LBuffer,"ø")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"ø")-1)+"é"+mid(LBuffer,INSTR(LBuffer,"ø")+2,Len(LBuffer)-(INSTR(LBuffer,"ø")+1))
End If
If INSTR(LBuffer,"º")>0 Then
uml=1
LBuffer=mid(LBuffer,1,INSTR(LBuffer,"º")-1)+"º"+mid(LBuffer,INSTR(LBuffer,"º")+2,Len(LBuffer)-(INSTR(LBuffer,"º")+1))
End If
Sleep (1),1
loop until uml=0
Buffer=LBuffer
'************************************
End Sub
'************************************
Dim test as string
Dim search as string
search=" Test "
Test=(WikiSearch(search,0))
?Test
sleep
|
Benoetigt SDL.DLL und SDL_NET.DLL
_________________
 |
|
| Nach oben |
|
 |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 15.07.2007, 08:36 Titel: |
|
|
damit kann man Menschen richtig auf die nerven fallen
| Zitat: |
EternalPain: !stupid kaffee
KBot: Kaffee ist eine kleine zierliche Gestalt aus der Familie der Waldfeen und wird von unbarmherzigen Fruehaufstehern in heissem Wasser aufgeloest, wodurch eine uebelriechende tiefschwarze Fluessigkeit entsteht.
Paranoia: !ruhe
EternalPain:
EternalPain: !wiki ruhe
KBot: Ruhe kann verschiedenes bedeuten, und bezieht sich meist auf die Abwesenheit von Aktivitaet.
08:28 beso betritt den Chat im Raum cafe.
beso schreit: RAUS AUS DEN FEDERN!!!
beso: 
beso: *fg*
EternalPain: !wiki feder
KBot: Federn (lat. Pennae, Singular Penna) sind auf der Aussenhaut der Voegel wachsende Gebilde aus Keratin, die die wesentliche aeussere Huelle, das Gefieder oder Federkleid, bilden. Federn schuetzen die Voegel einerseits vor Wasser und Kaelte und statten sie andererseits mit Farben aus, die sowohl zur Tarnung gegen Feinde, als auch als Mittel der visuellen Kommunikation dienen. Hinzu kommt die feste Kontur, die sie dem Vogel verleihen, und natuerlich auch die Moeglichkeit des Fluges. Obgleich eine einzelne Feder von aeusserst geringem Gewicht ist, wiegt das Gefieder eines Vogels zwei oder dreimal mehr als sein Skelett. Der Wissenschaftszweig, der sich mit Federn befasst, wird Plumologie genannt.
|
_________________
|
|
| Nach oben |
|
|
Michael Frey
Anmeldungsdatum: 18.12.2004
Beiträge: 2577
Wohnort: Schweiz
|
| Verfasst am: 15.07.2007, 09:54 Titel: |
|
|
Seh ich das Richtig, das du vom Wikiserver die HTML Datei hollst?
Eventuell wäre es einfacher diese Ansicht zu verwenden.
Bei Redirects hat das aber Nachteile.
Du kannst/solltest auch noch Begriffserkärungsseiten filtern.
_________________
http://de.wikibooks.org/wiki/FreeBasic Jede Hilfe für dieses Buch ist Willkommen!
http://de.wikibooks.org/wiki/FreeBasic:_FAQ FAQ zu Freebasic (im Aufbau, hilfe Willkommen)
Neu mit Syntax Highlight |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 15.07.2007, 09:58 Titel: |
|
|
Die Ansicht ist deutlich besser, damit koennte man sicher besser und schneller zum ergebnis kommen... wusste heut nacht nicht wie ich es sonst haette anfangen soll, werd es spaeter direkt mal ausprobieren und evtl. eine neue Function schreiben.
thx fuer den hinweis 
_________________
|
|
| Nach oben |
|
|
csde_rats
Anmeldungsdatum: 07.01.2007
Beiträge: 2292
Wohnort: Zwischen Sessel und Tastatur
|
| Verfasst am: 15.07.2007, 11:54 Titel: |
|
|
| Eternal_pain hat Folgendes geschrieben: |
immernoch engl. Tastatur Zunge rausstrecken ? Ja. gibt es damit ein Problem? |
Ich finde (für mich) das dein Text so sehr viel schlechter lesbar ist  | Eternal_pain hat Folgendes geschrieben: | | Und solche Codes gehören zu FBP wie waere es wenn Du den Leuten nicht staendig sagen wuerdest was sie muessen und ihnen selbst die wahl lassen wo sie was Posten unabhaengig deiner Meinung daruerber. |
Meiner Meinung nach ist es sehr nervig 7 Sekunden lang nach unten zu Scrollen, um den Rest des Threads zu sehen
Und ich denke (für mich) dass FBP:Porticula genau für solche Codes geeignet ist.
Außerdem habe ich nicht gesagt: "Du musst dass jetzt da und da hin packen", und wenn es so rübergekommen ist, möchte ich mich dafür entschuldigen.
Zuletzt bearbeitet von csde_rats am 15.07.2007, 18:58, insgesamt 4-mal bearbeitet |
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 15.07.2007, 18:45 Titel: |
|
|
Ich habe versucht die Funktionen fuer Wiki und Stupi zu verbessern, was mir schon recht gut gelungen ist, wenn auch noch nicht perfekt. Aber vielmehr probleme bereitet mir GBO (German-Bash.Org)
Seit einigen Stunden habe ich schon alle moeglichen und unmoeglichen varianten probiert ohne nennenswerten erfolg 
Zunaechst gibt es probleme mit auftauchenden Code der gar nicht da sein duerfte... (Werbung vermutlich) konnte dafuer aber glaube eine loesung finden, aber dann gibt es probleme damit das er mir die sachen teilweise doppelt oder gar nicht anzeigt, oder verkuerzt... ich weiss nicht was ich noch versuchen koennte... vielleicht kann mal jemand einen blick ueber die GBO Funktionen werfen?
die GBO Funktionen sind GBOget und GBO in Body.Bas
SDL.DLL und SDL_NET.DLL wird benoetigt...
_________________
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 20.07.2007, 11:19 Titel: |
|
|
Hab inzwischen die dritte Wiki und Stupi Funktion gebastelt und in mein ersten IRC-Bot (Test) eingebaut
_________________
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 29.07.2007, 09:07 Titel: |
|
|
da ich mich derzeit noch an andere Sachen versuche wollt ich erstmal die
beiden Routinen anbieten
Sind bestimmt noch nicht 100% perfekt aber funktionieren ziemlich gut und
vielleicht kan sie jemand fuer irgendein Projekt gebrauchen,
oder verbessert sie noch ?
Download Hier:
Wiki.zip
Stupi.zip
Edit:
Sollte ich vielleicht noch erwaehnen... die Hauptfunctionen sind jeweils,
Wiki.bas und Stupi.bas
entweder direkt den source benutzen oder besser noch
die bas includen
_________________
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 07.08.2007, 17:21 Titel: |
|
|
Die Wikiroutine hab ich inwischen etwas ueberarbeitet und versucht etwas
struktur und dokumenation in die ganze sache zu bekommen, ist mir bisher
noch nicht ganz so gut gelungen....
aber trotz noch etwas fehlender uebersichtlichkeit...
http://www.freebasic-portal.de/index.php?s=fbporticula&mode=show&id=86
_________________
|
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
