Finding of file by subset of name (for multi-disc computer)

Lubos · Post by **Lubos** » Sat Mar 07, 2015 9:55 pm

There are programs for cataloging, but a lot of people (including me) these simply not used. The discs are filled images, text and movies which are often only roughly categorized . When I started to fulfill the second 2 TB disc, I felt the need for some orientation in the flood.
The result of my efforts is a utility "Fïlofi EF".
Num3 (who advised me with a problematic diacritic) says: Windows shell is very tricky.
No doubt he is right. So I hope that the following code will help others.

Code: Select all

 
;*******************************************************************************

; Utility "FilofiEF" - serves for finding location of files in  disc E: and F:  with using subsets of file name 
;(regardless separators, diacritic and multiple spaces)

; After entering a  query ( single character is minimum query),
; the  file containig name of files from E:  and  F: is inspected, line by line.
; Empty query terminates program.
;
; Program includes protection against load an empty source file.
;
; The program contains three return points (labels) called by GOTO statement
;
; Used command  CharUpper_ ()  origins from Windows API.
;
; Residual Czech remarks are for my personal use.

;******************************************************************************

If ExamineDirectory(#PB_Any, "E:\", "*.*")

  query.s = "/U/C echo.|CHCP 1250 | dir E: /B/O:N/S   > efseznam.txt"
  Compiler = RunProgram("cmd.exe", query, GetCurrentDirectory(), #PB_Program_Open|#PB_Program_Read)

  WaitProgram(Compiler)
EndIf

If ExamineDirectory(#PB_Any, "F:\", "*.*")
  query.s = "/U/C echo.|CHCP 1250 | dir F: /B/O:N/S  >> efseznam.txt"
  Compiler = RunProgram("cmd.exe", query, GetCurrentDirectory(), #PB_Program_Open|#PB_Program_Read)

  WaitProgram(Compiler)
 
EndIf

;*******************************************************************************
;Procedures  for transforming special characters CP 1250 to diactriticless form
;and for replacing separators and spaces by one space

Procedure.s OneSpace(Retez$)

Retez$=ReplaceString(Retez$,"Ľ", "L")
Retez$=ReplaceString(Retez$,"ľ", "l")
Retez$=ReplaceString(Retez$,"ô", "o")
Retez$=ReplaceString(Retez$,"ŕ", "r")
Retez$=ReplaceString(Retez$,"ä", "a")
Retez$=ReplaceString(Retez$,"ĺ", "I")
Retez$=ReplaceString(Retez$,"Ô", "O")
Retez$=ReplaceString(Retez$,"Ĺ", "L")

Retez$=ReplaceString(Retez$,"á", "a")
Retez$=ReplaceString(Retez$,"č", "c")
Retez$=ReplaceString(Retez$,"é", "e")
Retez$=ReplaceString(Retez$,"í", "i")
Retez$=ReplaceString(Retez$,"š", "s")
Retez$=ReplaceString(Retez$,"ú", "u")
Retez$=ReplaceString(Retez$,"ů", "u")
Retez$=ReplaceString(Retez$,"ž", "z")
Retez$=ReplaceString(Retez$,"ě", "e")
Retez$=ReplaceString(Retez$,"ť", "t")
Retez$=ReplaceString(Retez$,"ý", "y")
Retez$=ReplaceString(Retez$,"ř", "r")

Retez$=ReplaceString(Retez$,"Á", "A")
Retez$=ReplaceString(Retez$,"Č", "C")
Retez$=ReplaceString(Retez$,"Ť", "T")
Retez$=ReplaceString(Retez$,"Ň", "N")
Retez$=ReplaceString(Retez$,"Ď", "D")
Retez$=ReplaceString(Retez$,"Ó", "O")
Retez$=ReplaceString(Retez$,"É", "E")
Retez$=ReplaceString(Retez$,"Ě", "E")
Retez$=ReplaceString(Retez$,"Í", "I")
Retez$=ReplaceString(Retez$,"Ř", "R")
Retez$=ReplaceString(Retez$,"Š", "S")
Retez$=ReplaceString(Retez$,"Ú", "U")
Retez$=ReplaceString(Retez$,"Ů", "U")
Retez$=ReplaceString(Retez$,"Ž", "Z")
Retez$=ReplaceString(Retez$,"Ý", "Y")
Retez$=ReplaceString(Retez$,"Ä", "A")
Retez$=ReplaceString(Retez$,"Ŕ", "R")


Retez$=ReplaceString(Retez$,"["," ")
Retez$=ReplaceString(Retez$,"]"," ")
Retez$=ReplaceString(Retez$,"{"," ") 
Retez$=ReplaceString(Retez$,"}"," ") 

Retez$=ReplaceString(Retez$,"*", " ")
Retez$=ReplaceString(Retez$,"?", " ")
Retez$=ReplaceString(Retez$,":", " ")
Retez$=ReplaceString(Retez$,"/", " ")
Retez$=ReplaceString(Retez$,"\", " ")
Retez$=ReplaceString(Retez$,">", " ")
Retez$=ReplaceString(Retez$,"<", " ")
Retez$=ReplaceString(Retez$,"-", " ")
Retez$=ReplaceString(Retez$,"_", " ")
Retez$=ReplaceString(Retez$,".", " ")
Retez$=ReplaceString(Retez$,",", " ")
Retez$=ReplaceString(Retez$,";", " ")
Retez$=ReplaceString(Retez$,"|", " ") 

Retez$=ReplaceString(Retez$,Chr(10), " ") 
Retez$=ReplaceString(Retez$,Chr(13), " ") 
Retez$=ReplaceString(Retez$,Chr(34), " ") ; "
Retez$=ReplaceString(Retez$,Chr(176), " ")
Retez$=ReplaceString(Retez$,Chr(239), "d")    
Retez$=ReplaceString(Retez$,Chr(243), "o")    
Retez$=ReplaceString(Retez$,Chr(242), "n")    

While CountString(Retez$,"  ")                  
  Retez$ = ReplaceString(Retez$,"  "," ")   
Wend   

Retez$ = LTrim(Retez$)  
Retez$ = RTrim(Retez$) 

ProcedureReturn Retez$
EndProcedure

;*******************************************************************************

Adresar$=GetCurrentDirectory()

ZDROJ:

Zdrojovy$=Adresar$+"efseznam.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
   MessageRequester(Title$, "Source file is missing!" )
  End
  ; soubor nemá mít nulovou délku
  ; proto se musí skočit zpět a  načíst nový soubor
EndIf

Titul$ ="Form a query! Empty string terminates program."

;*******************************************************************************

ZNOVA:
Celkem=0
Prazdne=0
Vyznamne=0
PuvodniDotaz$ = InputRequester("Content of disc E:  and  F:                      1.0", Titul$, "")

Dotaz$ = PuvodniDotaz$

CharUpper_(Dotaz$)  ; všechna písmena v dotazu budou velká
; nebyl použit příkaz UCase, protože nepřeváděl správně  š,ť,ž

Dotaz$=OneSpace(Dotaz$)

;*******************************************************************************

If Dotaz$ = ""
  ; dotaz nulové délky se pokládá za návrh k ukončení hledání v souboru

  Result = MessageRequester("Content of disc E: and  F:                         1.0", "Quit?",  #PB_MessageRequester_YesNo)

   OTAZKA:

  If Result = #PB_MessageRequester_Yes       ; stisknuto Yes (Ano)
    End                 ; program se ukončí
  ElseIf Result = #PB_MessageRequester_No    ; stisknuto No(Ne)
 
    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

 ;*****************************************************************************

Retez$="Answer_EF"

If CreateFile(1, Retez$+".txt")
  ; vytvoří se soubor
Else
  MessageRequester("Create file error for:", Retez$+".txt")
   Goto ZNOVA
EndIf

If ReadFile(0, Zdrojovy$)  

   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,#PB_Ascii )
    Celkem =Celkem+1

    If Len(PuvodniRadek$)=0
      Prazdne = Prazdne +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á
            
      Radek$=OneSpace(Radek$)

;*******************************************************************************
      
      Vyskyt = FindString(Radek$, Dotaz$,1)

      If Vyskyt > 0
        ; jestliže byla v řádku hledaná slova přítomna,  řádek je významný
        Vyznamne = Vyznamne+1
        If Vyznamne = 1
          ; při prvním výskytu významného řádku se vytvoří hlavička
          WriteStringN (1, " ")
          WriteStringN (1, "Source:  "+ Zdrojovy$)
          WriteStringN (1, "Query:  "+ PuvodniDotaz$)
          WriteStringN (1, " ")
          WriteStringN (1, "Result:  ")
          WriteString(1, Adresar$+"\"+Retez$+".txt")
          WriteStringN (1, " ")
          WriteStringN (1, " ")
        EndIf
        WriteStringN (1, PuvodniRadek$) ;  významné řádky se zapisují
      EndIf
    EndIf
  Wend

  Trvalo = ElapsedMilliseconds() -Zacatek
  ; doba  prohlížení databázového souboru
 
  If Vyznamne  > 0
    WriteStringN (1, " ")
    WriteStringN (1, "Result lines:  "+ Str(Vyznamne))
    WriteStringN (1, " ")
    WriteStringN (1, "Source lines:  "+ Str(Celkem) )
    WriteStringN (1, "Empty lines:  "+  Str(Prazdne))
    WriteStringN (1, "Time:  "+ Str(Trvalo) +" ms")

  EndIf

  CloseFile(0)               ; zavři oba dříve otevřené soubory
  CloseFile(1)

EndIf

If Vyznamne  > 0  
  RunProgram(GetCurrentDirectory()+Retez$+ ".txt")
EndIf

Titul$ = Dotaz$ + ": " + Str(Vyznamne) + "      Next question?"

Goto ZNOVA
End