Evidently a small snipet is not enough.
Code: Select all
;Procedure Prevod for transforming CodePage 1250 to CodePage 852
Test$=("příliš žluťoučký kůň úpěl ďábelské ódy Ř Í Š Ž Ť Č Ý Ů Ň Ú Ě Ď Á É Ó")
Procedure.s Vymena (StaryZnak$, NovyZnak$)
Shared Vysledny$
Vysledny$= ReplaceString(Vysledny$,StaryZnak$,NovyZnak$)
ProcedureReturn Vysledny$
EndProcedure
Procedure.s Prevod(Prevadeny$)
Shared Vysledny$
Vysledny$=Prevadeny$
Vymena("Ľ", "L")
Vymena("ľ", "l")
Vymena("ô", "o")
Vymena("ŕ", "r")
Vymena("ä", "a")
Vymena("ĺ", "I")
Vymena("Ô", "O")
Vymena("Ĺ", "L")
Vymena("á", "a")
Vymena("č", "c")
Vymena("é", "e")
Vymena("í", "i")
Vymena("š", "s")
Vymena("ú", "u")
Vymena("ů", "u")
Vymena("ž", "z")
Vymena("Á", "A")
Vymena("Č", "C")
Vymena("Ť", "T")
Vymena("Ň", "N")
Vymena("Ď", "D")
Vymena("Ó", "O")
Vymena("É", "E")
Vymena("Ě", "E")
Vymena("Í", "I")
Vymena("Ř", "R")
Vymena("Š", "S")
Vymena("Ú", "U")
Vymena("Ů", "U")
Vymena("Ž", "Z")
Vymena("Ý", "Y")
Vymena("ě", "e")
Vymena("ť", "t")
Vymena("Ä", "A")
Vymena("ý", "y")
Vymena("ř", "r")
Vymena("Ŕ", "R")
Vymena(Chr(239), "d") ;d
Vymena(Chr(243), "o") ;o
Vymena(Chr(242), "n") ;n
Vymena(Chr(176), Chr(32))
Vymena(Chr(10), Chr(32))
Vymena(Chr(13), Chr(32))
ProcedureReturn Vysledny$
EndProcedure
Macro PrintN(Jakykoliv)
Prevod(Jakykoliv)
Print(Vysledny$+ #CRLF$)
EndMacro
; Příklad XXVIII (PB 4.20)
; Název souboru: POPELKA 1_8.PB
; vyhledávací utilita spolupracující s programem Notepad
; v úvodním okně se nejprve vybere soubor textového typu
; po zadání minimálně jednoznakového dotazu
; POPELKA ve zvoleném souboru prohledává řádek po řádku
; řádky obsahující všechna slova dotazu vypisuje do výsledkového souboru
; slova se mohou v prohledávaném řádku vyskytovat kdekoliv
; sousloví (dvojice slov oddělené pevnou mezerou) se hledají pomocí %% ;
; (dvojitá procenta v dotazu při vyhledávání představují jednu mezeru)
; prázdný dotaz program ukončuje
; program obsahuje ochranu proti načtení prázdného zdrojového souboru
; v programu jsou tři návratové body (návěští) používané příkazem Goto
; použit příkaz CharUpper_() pocházející z Windows API
AdresarPopelky$=GetCurrentDirectory()
Dim Slovo$(50)
If CreateDirectory(AdresarPopelky$+"POPEL")
EndIf
Directory$ = AdresarPopelky$+"\POPEL\"
ZDROJ:
Zdrojovy$=AdresarPopelky$+"allvideo.txt"
If Zdrojovy$
If ReadFile(0, Zdrojovy$)
DelkaSouboru = Lof(0) ; zjištění délky otevřeného souboru
CloseFile(0)
EndIf
EndIf
If DelkaSouboru=0
StandardFile$ = ""
Goto ZDROJ
; soubor nemá mít nulovou délku
; proto se musí skočit zpět a načíst nový soubor
EndIf
For i = 1 To Len(Zdrojovy$)
BezCesty$ = BezCesty$+ Mid(Zdrojovy$,i,1)
If Mid(Zdrojovy$,i,1) ="\"
BezCesty$= ""
EndIf
Next i
If Len(BezCesty$) > 0
Tecka = FindString(BezCesty$, ".",1)
If Tecka > 0
Podadresar$ = Left(BezCesty$,Tecka-1)
EndIf
Podadresar$=AdresarPopelky$+"POPEL\"+Podadresar$
If CreateDirectory(Podadresar$)
Else
EndIf
EndIf
If Len(BezCesty$) >30
Database$ = Left(BezCesty$,27)+ "..."
Else
Database$= BezCesty$
EndIf
Database$ = Space(30-Len(Database$))+Database$
Titul$ ="Vlož hledanou část slova ! Prázdný řádek ukončí dotazy."
ZNOVA:
RadkyCelkem=0
RadkyPrazdne=0
RadkyVyznamne=0
PuvodniDotaz$ = InputRequester("VideoDisky 1.0 "+Database$, Titul$, "")
Dotaz$ = LTrim(PuvodniDotaz$) ; odstranit mezery vpředu
Dotaz$ = RTrim(Dotaz$) ; i vzadu
While CountString(Dotaz$," ") ; když jsou 2 mezery za sebou
Dotaz$ = ReplaceString(Dotaz$," "," ") ; nahraď 2 mezery jednou
Wend ; opakuj kontrolu přítomnosti dvou mezer
CharUpper_(Dotaz$) ; všechna písmena v dotazu budou velká
; nebyl použit příkaz UCase, protože nepřeváděl správně š,ť,ž
If Dotaz$ = ""
; dotaz nulové délky se pokládá za návrh k ukončení hledání v souboru
Result = MessageRequester("VideoDisky 1.0", "Ukončit program ?", #PB_MessageRequester_YesNo)
; jazyk dotazu MessageRequester je dán jazykem operačního systému
OTAZKA:
If Result = #PB_MessageRequester_Yes ; stisknuto Yes (Ano)
End ; program se ukončí
ElseIf Result = #PB_MessageRequester_No ; stisknuto No(Ne)
StandardFile$ = ""
Goto ZDROJ ; znovu se nabídne adresářové okénko pro načtení nového souboru
Else
Goto OTAZKA ; stisknutí Cancel (Storno) nebo Esc otázku nezruší
EndIf
EndIf
; dotaz byl zkontrolován a nemá nulovou délku
Dotaz$ = Dotaz$ +" "
; přidá se jedna mezera, ukončující poslední slovo v dotazu
; v tomto okamžiku je každé slovo v dotazu ukončeno právě jednou mezerou
; mezera tedy může být použita ke zjištění konce slova
SetCurrentDirectory(Podadresar$)
; soubor do něhož se ukládá výsledek bude mít jméno odpovídající dotazu
; přípustný název souboru nesmí obsahovat * ? : / > < \ "
; tyto znaky se proto v názvu souboru nahrazují slovním vypsáním
Pripustny$=ReplaceString(Dotaz$,"*", " hvezdicka ")
Pripustny$=ReplaceString(Pripustny$,"?"," otaznik ")
Pripustny$=ReplaceString(Pripustny$,":"," dvojtecka ")
Pripustny$=ReplaceString(Pripustny$,"/", " lomitko ")
Pripustny$=ReplaceString(Pripustny$,"\", " zpetne lomitko ")
Pripustny$=ReplaceString(Pripustny$,">", " vetsi nez ")
Pripustny$=ReplaceString(Pripustny$,"<", " mensi nez ")
Pripustny$=ReplaceString(Pripustny$,Chr(34), " uvozovky ")
If CreateFile(1, Pripustny$+".txt")
; vytvoří se soubor o názvu vytvořeném z textu dotazu
; nepřípustné znaky jsou nahrazeny slovy
Else
MessageRequester("Nejde vytvořit soubor:", Pripustny$+".txt")
; tato eventualita by normálně neměla nastat – ošetřena je zde „pro jistotu“
Goto ZNOVA
EndIf
If ReadFile(0, Zdrojovy$) ; jestliže jde přečíst soubor tak pokračujeme…
Tvoreny$=""
Pocetslov=0
For i = 1 To Len (Dotaz$)
; dotaz se uloží po slovech do indexovaných proměných Slovo$(i)
If Mid(Dotaz$,i,1) = " " ; čte jeden znak z i-té pozice v řetězci dotazu
Pocetslov=Pocetslov+1
Slovo$(Pocetslov) = Tvoreny$
Tvoreny$=""
Else
Tvoreny$ = Tvoreny$+ Mid(Dotaz$,i,1)
; dokud se neobjeví mezera, tvoří se Tvoreny$
EndIf
Next i
For j = 1 To PocetSlov
Slovo$(j)=ReplaceString(Slovo$(j),"%%"," ")
Next j
; zdvojená procenta se užívají jako pevná mezera k hledání sousloví
;***************************************************************************
Total$=""
For j = 1 To PocetSlov
Total$ =Total$+ Slovo$(j)
Next j
Total$=Prevod(Total$)
Slovo$(1)=Total$
Pocetslov=1
;*******************************************************
Zacatek = ElapsedMilliseconds()
; specifická funkce udávající počet milisekund od startu počítače
While Eof(0) = 0 ; smyčku provádět dokud se nedojde na konec souboru
PuvodniRadek$=ReadString(0)
RadkyCelkem =RadkyCelkem+1
If Len(PuvodniRadek$)=0
RadkyPrazdne = RadkyPrazdne +1
Else ; hledat má smysl v jen v neprázdných řádcích
Radek$ = PuvodniRadek$
CharUpper_(Radek$) ; všechna písmena v řádku budou velká
;*******************************************************************
; odstranění oddělovačů
Radek$=RemoveString(Radek$," ")
Radek$=RemoveString(Radek$,"\")
Radek$=RemoveString(Radek$,"_")
Radek$=RemoveString(Radek$,",")
Radek$=RemoveString(Radek$,"-")
Radek$=RemoveString(Radek$,".")
Radek$=RemoveString(Radek$,";")
Radek$=Prevod(Radek$)
;******************************************************************
Vyskyt =1
For j = 1 To PocetSlov
Vyskyt = FindString(Radek$, Slovo$(j),1)
If Vyskyt = 0 ; pokud v řádku právě hledané slovo chybí
Break
; další slova se nehledají - Break ukončí provádění smyčky
EndIf
Next j
If Vyskyt > 0
; jestliže byla v řádku všechna hledaná slova přítomna, řádek je významný
RadkyVyznamne = RadkyVyznamne+1
If RadkyVyznamne = 1
; při prvním výskytu významného řádku se vytvoří hlavička
WriteStringN (1, " ")
WriteStringN (1, "Zdrojový soubor: "+ Zdrojovy$)
WriteStringN (1, "Hledáno: "+ PuvodniDotaz$)
WriteStringN (1, " ")
WriteStringN (1, "Výsledkový soubor: ")
WriteString(1, Podadresar$+"\"+Pripustny$+".txt")
WriteStringN (1, " ")
EndIf
WriteStringN (1, PuvodniRadek$) ; významné řádky se zapisují
EndIf
EndIf
Wend
Trvalo = ElapsedMilliseconds() -Zacatek
; doba prohlížení databázového souboru
PocetRadkuVyznamnych$= Str(RadkyVyznamne)
PocetRadkuCelkem$= Str(RadkyCelkem)
PocetRadkuPrazdnych$= Str(RadkyPrazdne)
If RadkyVyznamne > 0
WriteStringN (1, " ")
WriteStringN (1, "Počet řádků výsledku: "+ PocetRadkuVyznamnych$)
WriteStringN (1, " ")
WriteStringN (1, "Počet řádků zdroje: "+ PocetRadkuCelkem$ )
WriteStringN (1, "Počet prázdných řádků: "+PocetRadkuPrazdnych$)
WriteStringN (1, "Potřebný čas: "+ Str(Trvalo) +" ms")
EndIf
CloseFile(0) ; zavři oba dříve otevřené soubory
CloseFile(1)
EndIf
Adres$=GetCurrentDirectory()
If RadkyVyznamne > 0 ; jestliže vyhověl alespoň jeden řádek
; pak má smysl spouštět externí program zobrazující vyhovující řádky
RunProgram("Notepad.exe",Pripustny$+".txt",Adres$)
; Notepad zobrazí výsledek
EndIf
Titul$ = Pripustny$ + ".txt: " + PocetRadkuVyznamnych$ + " Další ?"
Goto ZNOVA
End
A small text file : "allvideo.txt" must be present too.
