Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Wikipedia.bi
| Uploader: |  Eternal_Pain |
| Datum/Zeit: | 07.08.2007 17:14:01 |
/'
Wikipedia.bi benoetigt SDL.DLL und SDL_Net.DLL
'/
#IfNDef WikipediaSearch
#Define WikipediaSearch
'-----------------------------------------------------------------------------'
#IfNDef StrReplace
Declare Function StrReplace (Byval StrEx as String, _
Byval StrMask as String, _
Byval StrRplce as String) as String
/'
"StrReplace"
Syntax : Neu[$]=StrReplace (Alt[$],Ersetze[$],Durch[$])
Typ : Funktion
Kategorie : Stringmanipulation
StrReplace,
ist gedacht um bestimmte Zeichen(ketten) durch eine andere(s) zu ersetzen.
'/
Function StrReplace (Byval StrEx as String, _
Byval StrMask as String, _
Byval StrRplce as String) as String
If Len(StrEx)=0 or Len(StrMask)>Len(StrEx) Then Return StrEx
Dim Buffer as String=StrEx
Dim MaskSearch as UInteger
Dim MFound as byte
Dim lp as UInteger=1
Do
MaskSearch=InStr(lp,Buffer,StrMask)
MFound=0
If MaskSearch Then
MFound=1:lp=MaskSearch+Len(StrRplce)
''
Buffer=Left(Buffer,MaskSearch-1)+ _
StrRplce+ _
Right(Buffer,Len(Buffer)-(MaskSearch+(Len(StrMask)-1)))
''
End If
Loop while MFound=1
Return Buffer
End Function
'-----------------------------------------------------------------------------'
#EndIf
/'
Maximale Zeichenlaenge fuer Stringausgabe in OutStringLen
Definiert die auszugebene Maximal-Laenge des Wikipedia Strings
'/
#IfnDef OutStringLen
#Define OutStringLen 400
#EndIf
/'
HTMLReplace ist arbeitet zusammen mit StrReplace und enthaelt
einige der haeufig gebrauchten HTML Sonderzeichen und aendert
diese zu normalen ASCII zeichen
'/
#IfnDef HTMLReplace
Declare Function HTMLReplace (byval InString as String) as String
Function HTMLReplace (byval InString as String) as String
Dim OutString as String=InString
OutString=StrReplace (OutString, """, chr(34))
OutString=StrReplace (OutString, """, chr(34))
OutString=StrReplace (OutString, "&", "&")
OutString=StrReplace (OutString, "&", "&")
OutString=StrReplace (OutString, "<", "<")
OutString=StrReplace (OutString, "<", "<")
OutString=StrReplace (OutString, ">", ">")
OutString=StrReplace (OutString, ">", ">")
OutString=StrReplace (OutString, " ", chr(160)) 'Erzwungenes Leerzeichen
OutString=StrReplace (OutString, " ", chr(160))
OutString=StrReplace (OutString, "¡", "¡") 'umgekehrtes Ausrufezeichen
OutString=StrReplace (OutString, "¡", "¡")
OutString=StrReplace (OutString, "¢", "¢") 'Cent-Zeichen
OutString=StrReplace (OutString, "¢", "¢")
OutString=StrReplace (OutString, "£", "£") 'Pfund-Zeichen
OutString=StrReplace (OutString, "£", "£")
OutString=StrReplace (OutString, "¤", "¤") 'Währungszeichen
OutString=StrReplace (OutString, "¤", "¤")
OutString=StrReplace (OutString, "¥", "¥") 'Yen-Zeichen
OutString=StrReplace (OutString, "¥", "¥")
OutString=StrReplace (OutString, "¦", "¦") 'durchbrochener Strich
OutString=StrReplace (OutString, "¦", "¦")
OutString=StrReplace (OutString, "§", "§") 'Paragraph-Zeichen
OutString=StrReplace (OutString, "§", "§")
OutString=StrReplace (OutString, "¨", "¨") 'Pünktchen oben
OutString=StrReplace (OutString, "¨", "¨")
OutString=StrReplace (OutString, "©", "©") 'Copyright-Zeichen
OutString=StrReplace (OutString, "©", "©")
OutString=StrReplace (OutString, "ª", "ª") 'Ordinal-Zeichen weiblich
OutString=StrReplace (OutString, "ª", "ª")
OutString=StrReplace (OutString, "«", "«") 'angewinkelte Anführungszeichen links
OutString=StrReplace (OutString, "«", "«")
OutString=StrReplace (OutString, "¬", "¬") 'Verneinungs-Zeichen
OutString=StrReplace (OutString, "¬", "¬")
OutString=StrReplace (OutString, "", "") 'bedingter Trennstrich
OutString=StrReplace (OutString, "", "")
OutString=StrReplace (OutString, "®", "®") 'Registriermarke-Zeichen
OutString=StrReplace (OutString, "®", "®")
OutString=StrReplace (OutString, "¯", "¯") 'Überstrich
OutString=StrReplace (OutString, "¯", "¯")
OutString=StrReplace (OutString, "°", "°") 'Grad-Zeichen
OutString=StrReplace (OutString, "°", "°")
OutString=StrReplace (OutString, "±", "±") 'Plusminus-Zeichen
OutString=StrReplace (OutString, "±", "±")
OutString=StrReplace (OutString, "²", "²") 'Hoch-2-Zeichen
OutString=StrReplace (OutString, "²", "²")
OutString=StrReplace (OutString, "³", "³") 'Hoch-3-Zeichen
OutString=StrReplace (OutString, "³", "³")
OutString=StrReplace (OutString, "´", "´") 'Akut-Zeichen
OutString=StrReplace (OutString, "´", "´")
OutString=StrReplace (OutString, "µ", "µ") 'Mikro-Zeichen
OutString=StrReplace (OutString, "µ", "µ")
OutString=StrReplace (OutString, "¶", "¶") 'Absatz-Zeichen
OutString=StrReplace (OutString, "¶", "¶")
OutString=StrReplace (OutString, "·", "·") 'Mittelpunkt
OutString=StrReplace (OutString, "·", "·")
OutString=StrReplace (OutString, "¸", "¸") 'Häkchen unten
OutString=StrReplace (OutString, "¸", "¸")
OutString=StrReplace (OutString, "¹", "¹") 'Hoch-1-Zeichen
OutString=StrReplace (OutString, "¹", "¹")
OutString=StrReplace (OutString, "º", "º") 'Ordinal-Zeichen männlich
OutString=StrReplace (OutString, "º", "º")
OutString=StrReplace (OutString, "»", "»") 'angewinkelte Anführungszeichen rechts
OutString=StrReplace (OutString, "»", "»")
OutString=StrReplace (OutString, "¼", "¼") 'ein Viertel
OutString=StrReplace (OutString, "¼", "¼")
OutString=StrReplace (OutString, "½", "½") 'ein Halb
OutString=StrReplace (OutString, "½", "½")
OutString=StrReplace (OutString, "¾", "¾") 'drei Viertel
OutString=StrReplace (OutString, "¾", "¾")
OutString=StrReplace (OutString, "¿", "¿") 'umgekehrtes Fragezeichen
OutString=StrReplace (OutString, "¿", "¿")
OutString=StrReplace (OutString, "À", "À") 'A mit accent grave (Gravis)
OutString=StrReplace (OutString, "À", "À")
OutString=StrReplace (OutString, "Á", "Á") 'A mit accent aigu (Akut)
OutString=StrReplace (OutString, "Á", "Á")
OutString=StrReplace (OutString, "Â", "Â") 'A mit Zirkumflex
OutString=StrReplace (OutString, "Â", "Â")
OutString=StrReplace (OutString, "Ã", "Ã") 'A mit Tilde
OutString=StrReplace (OutString, "Ã", "Ã")
OutString=StrReplace (OutString, "Ä", "Ä") 'A Umlaut
OutString=StrReplace (OutString, "Ä", "Ä")
OutString=StrReplace (OutString, "Å", "Å") 'A mit Ring
OutString=StrReplace (OutString, "Å", "Å")
OutString=StrReplace (OutString, "Æ", "Æ") 'A mit legiertem E
OutString=StrReplace (OutString, "Æ", "Æ")
OutString=StrReplace (OutString, "Ç", "Ç") 'C mit Häkchen
OutString=StrReplace (OutString, "Ç", "Ç")
OutString=StrReplace (OutString, "È", "È") 'E mit accent grave (Gravis)
OutString=StrReplace (OutString, "È", "È")
OutString=StrReplace (OutString, "É", "É") 'E mit accent aigu (Akut)
OutString=StrReplace (OutString, "É", "É")
OutString=StrReplace (OutString, "Ê", "Ê") 'E mit Zirkumflex
OutString=StrReplace (OutString, "Ê", "Ê")
OutString=StrReplace (OutString, "Ë", "Ë") 'E Umlaut
OutString=StrReplace (OutString, "Ë", "Ë")
OutString=StrReplace (OutString, "Ì", "Ì") 'I mit accent grave (Gravis)
OutString=StrReplace (OutString, "Ì", "Ì")
OutString=StrReplace (OutString, "Í", "Í") 'I mit accent aigu (Akut)
OutString=StrReplace (OutString, "Í", "Í")
OutString=StrReplace (OutString, "Î", "Î") 'I mit Zirkumflex
OutString=StrReplace (OutString, "Î", "Î")
OutString=StrReplace (OutString, "Ï", "Ï") 'I Umlaut
OutString=StrReplace (OutString, "Ï", "Ï")
OutString=StrReplace (OutString, "Ð", "Ð") 'großes Eth (isländisch)
OutString=StrReplace (OutString, "Ð", "Ð")
OutString=StrReplace (OutString, "Ñ", "Ñ") 'N mit Tilde
OutString=StrReplace (OutString, "Ñ", "Ñ")
OutString=StrReplace (OutString, "Ò", "Ò") 'O mit accent grave (Gravis)
OutString=StrReplace (OutString, "Ò", "Ò")
OutString=StrReplace (OutString, "Ó", "Ó") 'O mit accent aigu (Akut)
OutString=StrReplace (OutString, "Ó", "Ó")
OutString=StrReplace (OutString, "Ô", "Ô") 'O mit Zirkumflex
OutString=StrReplace (OutString, "Ô", "Ô")
OutString=StrReplace (OutString, "Õ", "Õ") 'O mit Tilde
OutString=StrReplace (OutString, "Õ", "Õ")
OutString=StrReplace (OutString, "Ö", "Ö") 'O Umlaut
OutString=StrReplace (OutString, "Ö", "Ö")
OutString=StrReplace (OutString, "×", "×") 'Mal-Zeichen
OutString=StrReplace (OutString, "×", "×")
OutString=StrReplace (OutString, "Ø", "Ø") 'O mit Schrägstrich
OutString=StrReplace (OutString, "Ø", "Ø")
OutString=StrReplace (OutString, "Ù", "Ù") 'U mit accent grave (Gravis)
OutString=StrReplace (OutString, "Ù", "Ù")
OutString=StrReplace (OutString, "Ú", "Ú") 'U mit accent aigu (Akut)
OutString=StrReplace (OutString, "Ú", "Ú")
OutString=StrReplace (OutString, "Û", "Û") 'U mit Zirkumflex
OutString=StrReplace (OutString, "Û", "Û")
OutString=StrReplace (OutString, "Ü", "Ü") 'U Umlaut
OutString=StrReplace (OutString, "Ü", "Ü")
OutString=StrReplace (OutString, "Ý", "Ý") 'Y mit accent aigu (Akut)
OutString=StrReplace (OutString, "Ý", "Ý")
OutString=StrReplace (OutString, "Þ", "Þ") 'großes Thorn (isländisch)
OutString=StrReplace (OutString, "Þ", "Þ")
OutString=StrReplace (OutString, "ß", "ß") 'scharfes S
OutString=StrReplace (OutString, "ß", "ß")
OutString=StrReplace (OutString, "à", "à") 'a mit accent grave (Gravis)
OutString=StrReplace (OutString, "à", "à")
OutString=StrReplace (OutString, "á", "á") 'a mit accent aigu (Akut)
OutString=StrReplace (OutString, "á", "á")
OutString=StrReplace (OutString, "â", "â") 'a mit Zirkumflex
OutString=StrReplace (OutString, "â", "â")
OutString=StrReplace (OutString, "ã", "ã") 'a mit Tilde
OutString=StrReplace (OutString, "ã", "ã")
OutString=StrReplace (OutString, "ä", "ä") 'a Umlaut
OutString=StrReplace (OutString, "ä", "ä")
OutString=StrReplace (OutString, "å", "å") 'a mit Ring
OutString=StrReplace (OutString, "å", "å")
OutString=StrReplace (OutString, "æ", "æ") 'a mit legiertem e
OutString=StrReplace (OutString, "æ", "æ")
OutString=StrReplace (OutString, "ç", "ç") 'c mit Häkchen
OutString=StrReplace (OutString, "ç", "ç")
OutString=StrReplace (OutString, "è", "è") 'e mit accent grave (Gravis)
OutString=StrReplace (OutString, "è", "è")
OutString=StrReplace (OutString, "é", "é") 'e mit accent aigu (Akut)
OutString=StrReplace (OutString, "é", "é")
OutString=StrReplace (OutString, "ê", "ê") 'e mit Zirkumflex
OutString=StrReplace (OutString, "ê", "ê")
OutString=StrReplace (OutString, "ë", "ë") 'e Umlaut
OutString=StrReplace (OutString, "ë", "ë")
OutString=StrReplace (OutString, "ì", "ì") 'i mit accent grave (Gravis)
OutString=StrReplace (OutString, "ì", "ì")
OutString=StrReplace (OutString, "í", "í") 'i mit accent aigu (Akut)
OutString=StrReplace (OutString, "í", "í")
OutString=StrReplace (OutString, "î", "î") 'i mit Zirkumflex
OutString=StrReplace (OutString, "î", "î")
OutString=StrReplace (OutString, "ï", "ï") 'i Umlaut
OutString=StrReplace (OutString, "ï", "ï")
OutString=StrReplace (OutString, "ð", "ð") 'kleines Eth (isländisch)
OutString=StrReplace (OutString, "ð", "ð")
OutString=StrReplace (OutString, "ñ", "ñ") 'n mit Tilde
OutString=StrReplace (OutString, "ñ", "ñ")
OutString=StrReplace (OutString, "ò", "ò") 'o mit accent grave (Gravis)
OutString=StrReplace (OutString, "ò", "ò")
OutString=StrReplace (OutString, "ó", "ó") 'o mit accent aigu (Akut)
OutString=StrReplace (OutString, "ó", "ó")
OutString=StrReplace (OutString, "ô", "ô") 'o mit Zirkumflex
OutString=StrReplace (OutString, "ô", "ô")
OutString=StrReplace (OutString, "õ", "õ") 'o mit Tilde
OutString=StrReplace (OutString, "õ", "õ")
OutString=StrReplace (OutString, "ö", "ö") 'o Umlaut
OutString=StrReplace (OutString, "ö", "ö")
OutString=StrReplace (OutString, "÷", "÷") 'Divisions-Zeichen
OutString=StrReplace (OutString, "÷", "÷")
OutString=StrReplace (OutString, "ø", "ø") 'o mit Schrägstrich
OutString=StrReplace (OutString, "ø", "ø")
OutString=StrReplace (OutString, "ù", "ù") 'u mit accent grave (Gravis)
OutString=StrReplace (OutString, "ù", "ù")
OutString=StrReplace (OutString, "ú", "ú") 'u mit accent aigu (Akut)
OutString=StrReplace (OutString, "ú", "ú")
OutString=StrReplace (OutString, "û", "û") 'u mit Zirkumflex
OutString=StrReplace (OutString, "û", "û")
OutString=StrReplace (OutString, "ü", "ü") 'u Umlaut
OutString=StrReplace (OutString, "ü", "ü")
OutString=StrReplace (OutString, "ý", "ý") 'y mit accent aigu (Akut)
OutString=StrReplace (OutString, "ý", "ý")
OutString=StrReplace (OutString, "þ", "þ") 'kleines Thorn (isländisch)
OutString=StrReplace (OutString, "þ", "þ")
OutString=StrReplace (OutString, "ÿ", "ÿ") 'y Umlaut
OutString=StrReplace (OutString, "ÿ", "ÿ")
Return OutString
End Function
#EndIf
/'
UTF8_to_ASCII arbeitet zusammen mit StrReplace
und aendert Sonderzeichen vom "UTF-8" Format in normale ASCII
Sonderzeichen um.
'/
#IfnDef UTF8_to_ASCII
Declare Function UTF8_to_ASCII (byval InString as String) as String
Function UTF8_to_ASCII (byval InString as String) as String
Dim OutString as String=InString
OutString=StrReplace (OutString, chr(226,130,172), chr(128))
OutString=StrReplace (OutString, chr(194,129), chr(129))
OutString=StrReplace (OutString, chr(226,128,154), chr(130))
OutString=StrReplace (OutString, chr(198,146), chr(131))
OutString=StrReplace (OutString, chr(226,128,158), chr(132))
OutString=StrReplace (OutString, chr(226,128,166), chr(133))
OutString=StrReplace (OutString, chr(226,128,160), chr(134))
OutString=StrReplace (OutString, chr(226,128,161), chr(135))
OutString=StrReplace (OutString, chr(203,134), chr(136))
OutString=StrReplace (OutString, chr(226,128,176), chr(137))
OutString=StrReplace (OutString, chr(197,160), chr(138))
OutString=StrReplace (OutString, chr(226,128,185), chr(139))
OutString=StrReplace (OutString, chr(197,146), chr(140))
OutString=StrReplace (OutString, chr(194,141), chr(141))
OutString=StrReplace (OutString, chr(197,189), chr(142))
OutString=StrReplace (OutString, chr(194,143), chr(143))
OutString=StrReplace (OutString, chr(194,144), chr(144))
OutString=StrReplace (OutString, chr(226,128,152), chr(145))
OutString=StrReplace (OutString, chr(226,128,153), chr(146))
OutString=StrReplace (OutString, chr(226,128,156), chr(147))
OutString=StrReplace (OutString, chr(226,128,157), chr(148))
OutString=StrReplace (OutString, chr(226,128,162), chr(149))
OutString=StrReplace (OutString, chr(226,128,147), chr(150))
OutString=StrReplace (OutString, chr(226,128,148), chr(151))
OutString=StrReplace (OutString, chr(203,156), chr(152))
OutString=StrReplace (OutString, chr(226,132,162), chr(153))
OutString=StrReplace (OutString, chr(197,161), chr(154))
OutString=StrReplace (OutString, chr(226,128,186), chr(155))
OutString=StrReplace (OutString, chr(197,147), chr(156))
OutString=StrReplace (OutString, chr(194,157), chr(157))
OutString=StrReplace (OutString, chr(197,190), chr(158))
OutString=StrReplace (OutString, chr(197,184), chr(159))
OutString=StrReplace (OutString, chr(194,160), chr(160))
OutString=StrReplace (OutString, chr(194,161), chr(161))
OutString=StrReplace (OutString, chr(194,162), chr(162))
OutString=StrReplace (OutString, chr(194,163), chr(163))
OutString=StrReplace (OutString, chr(194,164), chr(164))
OutString=StrReplace (OutString, chr(194,165), chr(165))
OutString=StrReplace (OutString, chr(194,166), chr(166))
OutString=StrReplace (OutString, chr(194,167), chr(167))
OutString=StrReplace (OutString, chr(194,168), chr(168))
OutString=StrReplace (OutString, chr(194,169), chr(169))
OutString=StrReplace (OutString, chr(194,170), chr(170))
OutString=StrReplace (OutString, chr(194,171), chr(171))
OutString=StrReplace (OutString, chr(194,172), chr(172))
OutString=StrReplace (OutString, chr(194,173), chr(173))
OutString=StrReplace (OutString, chr(194,174), chr(174))
OutString=StrReplace (OutString, chr(194,175), chr(175))
OutString=StrReplace (OutString, chr(194,176), chr(176))
OutString=StrReplace (OutString, chr(194,177), chr(177))
OutString=StrReplace (OutString, chr(194,178), chr(178))
OutString=StrReplace (OutString, chr(194,179), chr(179))
OutString=StrReplace (OutString, chr(194,180), chr(180))
OutString=StrReplace (OutString, chr(194,181), chr(181))
OutString=StrReplace (OutString, chr(194,182), chr(182))
OutString=StrReplace (OutString, chr(194,183), chr(183))
OutString=StrReplace (OutString, chr(194,184), chr(184))
OutString=StrReplace (OutString, chr(194,185), chr(185))
OutString=StrReplace (OutString, chr(194,186), chr(186))
OutString=StrReplace (OutString, chr(194,187), chr(187))
OutString=StrReplace (OutString, chr(194,188), chr(188))
OutString=StrReplace (OutString, chr(194,189), chr(189))
OutString=StrReplace (OutString, chr(194,190), chr(190))
OutString=StrReplace (OutString, chr(194,191), chr(191))
OutString=StrReplace (OutString, chr(195,128), chr(192))
OutString=StrReplace (OutString, chr(195,129), chr(193))
OutString=StrReplace (OutString, chr(195,130), chr(194))
OutString=StrReplace (OutString, chr(195,131), chr(195))
OutString=StrReplace (OutString, chr(195,132), chr(196))
OutString=StrReplace (OutString, chr(195,133), chr(197))
OutString=StrReplace (OutString, chr(195,134), chr(198))
OutString=StrReplace (OutString, chr(195,135), chr(199))
OutString=StrReplace (OutString, chr(195,136), chr(200))
OutString=StrReplace (OutString, chr(195,137), chr(201))
OutString=StrReplace (OutString, chr(195,138), chr(202))
OutString=StrReplace (OutString, chr(195,139), chr(203))
OutString=StrReplace (OutString, chr(195,140), chr(204))
OutString=StrReplace (OutString, chr(195,141), chr(205))
OutString=StrReplace (OutString, chr(195,142), chr(206))
OutString=StrReplace (OutString, chr(195,143), chr(207))
OutString=StrReplace (OutString, chr(195,144), chr(208))
OutString=StrReplace (OutString, chr(195,145), chr(209))
OutString=StrReplace (OutString, chr(195,146), chr(210))
OutString=StrReplace (OutString, chr(195,147), chr(211))
OutString=StrReplace (OutString, chr(195,148), chr(212))
OutString=StrReplace (OutString, chr(195,149), chr(213))
OutString=StrReplace (OutString, chr(195,150), chr(214))
OutString=StrReplace (OutString, chr(195,151), chr(215))
OutString=StrReplace (OutString, chr(195,152), chr(216))
OutString=StrReplace (OutString, chr(195,153), chr(217))
OutString=StrReplace (OutString, chr(195,154), chr(218))
OutString=StrReplace (OutString, chr(195,155), chr(219))
OutString=StrReplace (OutString, chr(195,156), chr(220))
OutString=StrReplace (OutString, chr(195,157), chr(221))
OutString=StrReplace (OutString, chr(195,158), chr(222))
OutString=StrReplace (OutString, chr(195,159), chr(223))
OutString=StrReplace (OutString, chr(195,160), chr(224))
OutString=StrReplace (OutString, chr(195,161), chr(225))
OutString=StrReplace (OutString, chr(195,162), chr(226))
OutString=StrReplace (OutString, chr(195,163), chr(227))
OutString=StrReplace (OutString, chr(195,164), chr(228))
OutString=StrReplace (OutString, chr(195,165), chr(229))
OutString=StrReplace (OutString, chr(195,166), chr(230))
OutString=StrReplace (OutString, chr(195,167), chr(231))
OutString=StrReplace (OutString, chr(195,168), chr(232))
OutString=StrReplace (OutString, chr(195,169), chr(233))
OutString=StrReplace (OutString, chr(195,170), chr(234))
OutString=StrReplace (OutString, chr(195,171), chr(235))
OutString=StrReplace (OutString, chr(195,172), chr(236))
OutString=StrReplace (OutString, chr(195,173), chr(237))
OutString=StrReplace (OutString, chr(195,174), chr(238))
OutString=StrReplace (OutString, chr(195,175), chr(239))
OutString=StrReplace (OutString, chr(195,176), chr(240))
OutString=StrReplace (OutString, chr(195,177), chr(241))
OutString=StrReplace (OutString, chr(195,178), chr(242))
OutString=StrReplace (OutString, chr(195,179), chr(243))
OutString=StrReplace (OutString, chr(195,180), chr(244))
OutString=StrReplace (OutString, chr(195,181), chr(245))
OutString=StrReplace (OutString, chr(195,182), chr(246))
OutString=StrReplace (OutString, chr(195,183), chr(247))
OutString=StrReplace (OutString, chr(195,184), chr(248))
OutString=StrReplace (OutString, chr(195,185), chr(249))
OutString=StrReplace (OutString, chr(195,186), chr(250))
OutString=StrReplace (OutString, chr(195,187), chr(251))
OutString=StrReplace (OutString, chr(195,188), chr(252))
OutString=StrReplace (OutString, chr(195,189), chr(253))
OutString=StrReplace (OutString, chr(195,190), chr(254))
OutString=StrReplace (OutString, chr(195,191), chr(255))
Return OutString
End Function
#EndIf
/'
SDLMainFunction:
Beinhaltet alle notwendigen (Standard) Socket Funktionen von SDL_Net
'/
#IfnDef SDLMainFunction
#Define SDLMainFunction
#inclib "SDL_net"
'Declares und Types'
Type Uint16 as ushort
type Uint32 as uinteger
type IPaddress
host as Uint32
port as Uint16
end type
Type TCPsocket as _TCPsocket ptr
Extern "Ë"
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, byval Port as Integer=80) 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
'----------------------------------------------------------------------------'
'Standart HTTP Functions
Const SDLRecvbufferlen = 8192
Const SDLCRLF = !"\r\n"
Const SDL_Referer = ""
Declare Function TCP_open (Byval hostname As String, byval Port as Integer=80) As TCPSocket
Declare Function TCP_http (Byval method As String="get", Byval Socket As TCPSocket, Byval hostname As String, Byval path As String="") 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, byval Port as Integer=80) 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, Port ) <> 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="") As Integer
'****************************************************************
'' send HTTP request
Dim sendbuffer As String
Dim MString As String
Select Case Lcase (method)
Case "post"
MString="POST /"
Case Else
MString="GET /"
End Select
SendBuffer= _
MString+path+" HTTP/1.1"+SDLCRLF+ _
"Host: "+hostname+SDLCRLF+ _
"Connection: close"+SDLCRLF
If MString="POST /" Then SendBuffer+= _
"Accept-Encoding: gzip"+SDLCRLF
SendBuffer+= _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5"+SDLCRLF+ _
"Accept-Language: de-de,de;q=0.8,en-us;q=0.5,en;q=0.3"+SDLCRLF+ _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7"+SDLCRLF+ _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4"+SDLCRLF+ _
"SDL_Referer: "+SDL_Referer+SDLCRLF
If MString="POST /" Then SendBuffer+= _
"Content-type: application/x-www-form-urlencoded"+SDLCRLF
SendBuffer+=SDLCRLF
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_close (Byval socket As TCPSocket) As Integer
'****************************************************************
'' close socket
SDLNet_TCP_Close( socket )
'' quit
SDLNet_Quit
Return 0
'****************************************************************
End Function 'TCP_close
'****************************************************************
'----------------------------------------------------------------------------------------------------------------------------------------------------------'
#EndIf
#IfnDef BlockFormat
Randomize Timer
Declare Function FL_MultiTag (Byval buffer As String,Byval SS As Uinteger, Byval pSE As Uinteger, Byval TagOpen As String, Byval TagClose As String) As Uinteger
Declare Function BlockFormat (Byval buffer As String) As String
'****************************************************************
Function BlockFormat (Byval buffer As String) As String
'****************************************************************
Dim SS As Uinteger
Dim SE As Uinteger
Dim pSE As Uinteger
Dim TagFound As Ubyte
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (buffer,"{{")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,"}}")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"{{","}}")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+2>Len(buffer),Len(buffer),pSE+2)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (buffer,"{|")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,"|}")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"{|","|}")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+2>Len(buffer),Len(buffer),pSE+2)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (Lcase(buffer),"(")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,")")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"(",")")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+1>Len(buffer),Len(buffer),pSE+1)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (Lcase(buffer),"[[bild:")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,"]]")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"[[","]]")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+2>Len(buffer),Len(buffer),pSE+2)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (Lcase(buffer),"[[image:")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,"]]")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"[[","]]")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+2>Len(buffer),Len(buffer),pSE+2)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
If Instr(Lcase(buffer),"<!--")>0 Then
buffer=Chr(32)+buffer+Chr(32)
SS=Instr(Lcase(buffer),"<!--")
If SS=0 Then
buffer=Trim(buffer)
Else
SE=Instr(SS,Lcase(buffer),"-->")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif(SE=0,Len(buffer),SE+3)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
End If
End If
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (Lcase(buffer),"[[")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,"]]")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"[[","]]")
Dim rString As String
Dim rS As Uinteger
Dim rE As Uinteger
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+2>Len(buffer),Len(buffer),pSE+2)
If SE-3<Len(buffer) Then
rS=SS+3:rE=SE-3
For l As Integer=SE-3 To SS+3 Step-1
If Mid(buffer,l,1)="|" Then rS=l+1:Exit For
'If Mid(buffer,l,1)=":" Then rS=l+1:Exit For
'If Mid(buffer,l,1)="#" Then rS=l+1:Exit For
Next l
rString=Mid(buffer,rS,1+(rE-rS))
End If
buffer=Mid(buffer,1,SS)+rString+Mid(buffer,SE,1+(Len(buffer)-SE))
Loop While TagFound=1
'-------------------------------------------------'
Do
buffer=Chr(32)+buffer+Chr(32)
TagFound=0
SS=Instr (buffer,"<")
If SS=0 Then buffer=Trim(buffer) : Exit Do
TagFound=1
pSE=Instr (SS,buffer,">")
pSE=Iif (pSE=0,Len(buffer),pSE)
pSE=FL_MultiTag(buffer,SS,pSE,"<",">")
SS=Iif (SS-1<1,1,SS-1)
SE=Iif (pSE+1>Len(buffer),Len(buffer),pSE+1)
buffer=Trim(Mid(buffer,1,SS)+Mid(buffer,SE,1+(Len(buffer)-SE)))
Loop While TagFound=1
'-------------------------------------------------'
buffer=StrReplace(buffer,"'''",Chr(34))
buffer=StrReplace(buffer,"''",Chr(34))
buffer=StrReplace(buffer,Chr(10),"")
buffer=StrReplace(buffer,Chr(13),"")
buffer=StrReplace(buffer,"[]","")
buffer=StrReplace(buffer,"[[","")
buffer=StrReplace(buffer,"]]","")
buffer=StrReplace(buffer,chr(34,39),"")
buffer=StrReplace(buffer,",*"," *")
buffer=StrReplace(buffer,"<br>"," ")
buffer=StrReplace(buffer," "," ")
'-------------------------------------------------'
If Instr(Lcase(buffer),"#redirect") Then Return Trim(buffer)
If Instr(Lcase(buffer),"* empty *") Then Return ""
If Instr(Lcase(buffer),"==")>35 Then buffer=mid(buffer,1,Instr(Lcase(buffer),"==")-1)
buffer=StrReplace(buffer,"=="," ^^ ")
buffer=StrReplace(buffer,"__TOC","")
buffer=StrReplace(buffer,"__","")
buffer=HTMLReplace(buffer)
'-------------------------------------------------'
Dim EC As String
buffer=Trim(buffer)
If Len(buffer)-1>OutStringLen Then
buffer=Mid(buffer,1,OutStringLen)
SS=Len(buffer)
Do
SS-=1
EC=Mid(buffer,SS,1)
If EC="." Or EC="!" Or EC="§" Or EC="*" Or EC="]" Or SS=1 Then
If EC="*" Then SS-=1
buffer=Mid(buffer,1,SS)
Exit Do
End If
Loop
End If
If Len(buffer)<2 Then buffer=""
Return trim(UTF8_to_ASCII(buffer))
'****************************************************************
End Function 'BlockFormat
'****************************************************************
'****************************************************************
Function FL_MultiTag (Byval buffer As String, _
Byval SS As Uinteger, _
Byval pSE As Uinteger, _
Byval TagOpen As String, _
Byval TagClose As String) As Uinteger
'****************************************************************
Dim MultiTagFound As Ubyte
Dim MultiTagSearch As Uinteger
MultiTagSearch=SS
'-------------------------------------------------'
Do
MultiTagFound=0
MultiTagSearch=Instr (MultiTagSearch+1,buffer,TagOpen)
If MultiTagSearch>SS And MultiTagSearch<pSE Then
MultiTagSearch+=Len(TagOpen)
MultiTagFound=1
pSE=Instr(pSE+Len(TagClose),buffer,TagClose)
If pSE=0 Then pSE=Len(buffer)
If pSE+Len(TagClose)>Len(buffer) Then pSE=Len(buffer)
End If
Loop While MultiTagFound=1
'-------------------------------------------------'
Return pSE
'****************************************************************
End Function 'FL_MultiTag
'-----------------------------------------------------------------------------'
#EndIf
'-----------------------------------------------------------------------------'
/'
"Wiki"
Aufruf: Wiki(SuchString[$][,sprache])
Standart ist Sprache auf Deutsch gestellt "DE", alternativ kann auch
in der englischen Wikipedia gesucht werden "EN"
Wiki ist die Aufruffunktion zu WikiSearch und gibt einen "String" mit den
Inhalt des gefunden ergebnisses zurueck
"WikiSearch"
Parameter werden von "Wiki" uebergeben
WikiSearch ist die Verarbeitungsfunktion fuer "Wiki"
'/
Declare Function WikiSearch (Byval SearchString As String, byval DEEN as String="de") As String
Declare Function Wiki (byval SearchString as String, byval DEEN as String="de") as String
'****************************************************************
Function WikiSearch (Byval SearchString As String, byval DEEN as String="de") As String
'****************************************************************
Dim socket As TCPsocket
'------------------------------------------------'
''Verbindung herstellen
socket = TCP_open (DEEN+".wikipedia.org")
''Wenn keine Verbindung hergestellt werden konnte
If socket=0 Then _
Return "Es konnte keine Verbindung mit Wikipedia hergestellt werden."
''SeachString (Sonderzeichen) Konvertieren
'SearchString=lcase((SearchString))
SearchString=StrReplace(SearchString,chr(132),"%E4")'ä UNI
SearchString=StrReplace(SearchString,chr(148),"%F6")'ö UNI
SearchString=StrReplace(SearchString,chr(129),"%FC")'ü UNI
SearchString=StrReplace(SearchString,chr(160),"%DF")'ß UNI
SearchString=StrReplace(SearchString,chr(228),"%E4")'ä ANSI
SearchString=StrReplace(SearchString,chr(246),"%F6")'ö ANSI
SearchString=StrReplace(SearchString,chr(252),"%FC")'ü ANSI
SearchString=StrReplace(SearchString,chr(223),"%DF")'ß ANSI
SearchString=StrReplace(SearchString,chr( 32),"%20")'ß ANSI
''Anfrage schicken
TCP_http ("get",socket,DEEN+".wikipedia.org", _
"w/index.php?title="+SearchString+ _
"&action=raw&ctype=text/javascript&dontcountme=s")
'------------------------------------------------'
''Anfrage ergebniss einlesen
Dim recvbuffer As Zstring * 5001
Dim LC as String=""
Dim bytes As Integer
do
bytes = SDLNet_TCP_Recv( socket, Strptr( recvbuffer ), 5000 )
if bytes<1 then exit do
LC+=recvbuffer
if len(LC)>4999 Then exit Do
loop
'------------------------------------------------'
''Server/Verbindungsdaten ausschneiden
Dim SS As Integer
SS=Instr(Lcase(LC),"Connection: close")
If SS=0 Then Return ""
SS+=17
'------------------------------------------------'
''Konvertieren
Dim buffer as String
buffer=Trim(Mid(LC,SS,1+(Len(LC)-SS)))
If Instr(Lcase(buffer),"#redirect") Then
SS=Instr(Lcase(buffer),"#redirect")
SE=Instr(SS,buffer,Chr(10,13))-1
return Trim(mid(buffer,SS,1+(SE-SS)))
End If
buffer=BlockFormat(buffer)
return buffer
'****************************************************************
End Function 'WikiSearch
'****************************************************************
'****************************************************************
Function Wiki (byval SearchString as String, byval DEEN as String="de") as String
'****************************************************************
Dim buffer as String
Dim DEENb as String=DEEN
If DEENb<>"de" Then DEENb="en"
SearchString=lcase((SearchString))
buffer=WikiSearch(SearchString,DEENb)
'------------------------------------------------'
''Redirect
Dim RDString as String
Dim RDS as UInteger
Dim SS as UInteger
Dim SE as UInteger
RDS=Instr(Lcase(buffer),"#redirect")
If RDS Then
buffer=StrReplace(buffer,"[[","")
buffer=StrReplace(buffer,"]]","")
SS=INSTR(RDS,buffer,chr(32))
SE=Len(buffer)
RDString=trim(mid(buffer,SS,1+(SE-SS)))
buffer=WikiSearch(RDString,DEENb)
End If
'------------------------------------------------'
Return buffer
'****************************************************************
End Function 'Wiki
'-----------------------------------------------------------------------------'