Tiedoston haku funktio.

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
Niilo93
Newcomer
Posts: 2
Joined: Sat Nov 03, 2007 2:43 pm

Tiedoston haku funktio.

Post by Niilo93 »

Tein funkion jolla voi hakea tiedostot kansiosta ja sen alikansioista.
Ainakin itse olen käyttänyt tätä yhessä musiikkisoittimessa.
Toi on loppujen lopuks aika purkka viritelmä ja ei ehkä se nopein tapa, mut toimii kuiteski.

Code: Select all

Type Kansiot
    Field Kansio$
    Field Check 
EndType 
Type Tiedostot //Tähän tyyppiin menee kaikki tiedostojen polut.
    Field Files$ 
EndType 
Function Search(Direct$,FileT$="") //direct$=Polku josta haetaan. FileT$=Tiedostopääte Esim. ".Bmp" hakee kaikki ".Bmp"Tiedostot
    Repeat 
        ChDir Direct$
        oDirect$=direct$
        StartSearch 
            While loppu=False 
                file$=FindFile()
                If File$="" Then loppu=1 
                If IsDirectory (File$)
                    addt$=RemoveChr(CurrentDir()+File$,".")
                    same=0
                    For IKansiot.Kansiot = Each Kansiot
                        If iKansiot\Kansio$=addt$ Then same=1:Exit
                    Next iKansiot.Kansiot
                    If same=0
                    newKansiot.Kansiot=New(Kansiot)
                    NewKansiot\Kansio$=addt$
                    EndIf 
                    NewKansiot\Check=0
                EndIf 
            Wend 
            loppu=0
            i=0
            For iKansiot.Kansiot = Each Kansiot
                If i=0
                    If iKansiot\Check=0
                        i+1
                        iKansiot\Check=1
                        Direct$=iKansiot\Kansio$+"\"
                    EndIf 
                   
                EndIf 
                
            Next IKansiot.Kansiot
            i=0
        EndSearch
        If oDirect$=Direct$ Then Exit 
    Forever 
    loppu=0
//lisätään tietoa -Tiedostot- tyyppiin
    Leng=Len(FileT$)
    Repeat 

        oDirect$=Direct$
        i=0
        For iKansiot.Kansiot = Each Kansiot
            If i=0
                Direct$=iKansiot\Kansio$+"\"
                iKansiot\Kansio$=0
                ChDir direct$
                Delete iKansiot
            EndIf 
            i+1
        Next iKansiot.Kansiot
        If oDirect$=Direct$ Then Exit 
        StartSearch 
            While loppu=0
                File$=FindFile()
                If file$="" Then loppu=1
                If Leng>0
                    If Lower(Right (File$,Leng))=Filet$
                        newTiedostot.Tiedostot=New(Tiedostot)
                        NewTiedostot\Files$= CurrentDir()+File$
                    EndIf 
                Else 
                    If Not IsDirectory (File$)
                        newTiedostot.Tiedostot=New(Tiedostot)
                        newTiedostot\Files$=CurrentDir()+File$
                    EndIf 
                EndIf 
            Wend 
        EndSearch 
            Loppu=0
    Forever 
EndFunction 
Function RemoveChr(txt$,r$) //txt$=merkkijono  //r$=poistettava merkki
    leng=Len(Txt$)-1
    lengg=leng 
    For a=0 to lengg
        at$=Left (txt$,1)
        If Not at$=r$
            ret$=ret$+at$
        EndIf 
        txt$=Right (txt$,leng)
        leng-1
    Next a
    Return ret$
EndFunction 
Toivottavasti jotain hyötyä jollekkin.
User avatar
Jare
Devoted Member
Posts: 877
Joined: Mon Aug 27, 2007 10:18 pm
Location: Pori
Contact:

Re: Tiedoston haku funktio.

Post by Jare »

Tässä vähän aikaa sitten tekemäni lyhyempi versio: http://cbkk.systec.fi/koodi.php?id=186
Joxi
Newcomer
Posts: 23
Joined: Sun Aug 26, 2007 5:40 pm
Location: Kuopio
Contact:

Re: Tiedoston haku funktio.

Post by Joxi »

Juuri tämmösissä tilanteissa kannattaa käyttää rekursiota, koska pääsee vähäemmällä koodailulla ja tulos on paljon nopeampaa. Koodi on kyllä nopeasti väänettyä ja mahdollisimman epäselvää mut toimii mainiosti.

Code: Select all

Type tiedostot
  Field polku As String 
  Field isdir As Short 
EndType 

Global tiedostopääte$

SCREEN 800,600
aika = Timer()

tiedostopääte = "" // ei tiedostopäätettä
findfiles("C:/Program files/coolbasic")
SetWindow "Suoritettiin "+(Timer()-aika)+"  milliseukunnissa."

For t.tiedostot = Each tiedostot 
  Text 0,y, t\polku + "  "+t\isdir
  y+10
Next t 

DrawScreen 
WaitKey

Function findfiles(root$)
  root = root + "/"
  ChDir root
  
  StartSearch
  file$ = FindFile()
  file = FindFile() 

  Repeat 
       
    file=FindFile()
  
    If IsDirectory(file)  

      EndSearch 
      findfiles(root+file) 
      ChDir root
      StartSearch 
  
      Repeat 
        joku$ = FindFile() 
      Until joku = file
      
    ElseIf Right(file,Len(tiedostopääte)) = tiedostopääte
      t.tiedostot = New(tiedostot)
      t\polku = root + file  
      If IsDirectory(root+file) Then t\isdir = 1
    EndIf 
     
  Until file = ""
 EndSearch 
 
  Return 0
EndFunction 
Image
Post Reply