PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Suchen per Wildcards

https://www.purebasic.fr/german/viewtopic.php?t=11673

Seite 2 von 2

Verfasst: 23.01.2007 13:52
von AND51
CNESM hat geschrieben:Scheinbar wurde das Vergleichen von Strings schon gut durch AND51 und NickTheQuick umgesetzt. Die Beispiele sollten dementsprechend auch genutzt werden :)
In der Tat. Es bleibt aber trotzdem dir überlassen, welchen Code du nimmst bzw. ob du überhaupt einen nimmst; du kannst die Codes auch umschrieben oder nachschreiben. Nachschreiben empfehle ich dir, wenn du richtig verstehen willst, wie solche "guten" Codes geschrieben werden.

Verfasst: 23.01.2007 23:10
von CNESM
@ Toms

Da ich gestern auf PB4.00 geupdatet habe, habe ich den Code nochmal 4.00 kompatibel gemacht:

Code: Alles auswählen

Global Such$, Verz$, l , Modus
Verz$ = "C:\Ordner\"

Declare SearchAllPath(Path$,Rek,File.s)
Declare SearchOnePath(Path$,Rek,File.s)

If OpenWindow(0, 0, 0, 400, 480, "Suche", #PB_Window_ScreenCentered) = 0 : End : EndIf
If CreateGadgetList(WindowID(0)) = 0 : End : EndIf

ButtonGadget(6, 290, 10,   100, 18,"Nur Hauptpfad")
ButtonGadget(8, 290, 40,   100, 18,"Alle Unterordner")
ButtonGadget(10, 290, 70,   100, 18,"End") 

StringGadget(11,8, 10,206,20,"*.BMP")
StringGadget(13,8, 40,206,20,"C:\Ordner\") 

x =  #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_FullRowSelect 
ListIconGadget (12, 10, 125, 380, 345,"Ergebnisse", 800, x)

Repeat
   Event = WaitWindowEvent()   
   If  Event = #PB_Event_Gadget Or Event =  #PB_Event_Menu
      Select  EventGadget()
   
         Case 6
         ClearGadgetItemList(12) : SearchOnePath(GetGadgetText(13), 0, GetGadgetText(11)) 
                  
         Case 8
         ClearGadgetItemList(12) : SearchAllPath(GetGadgetText(13),0,GetGadgetText(11)) 

         Case 10
         
         End

      EndSelect
   EndIf
Until Event = 0
End

Procedure SearchAllPath(Path$,Rek,File.s)
If ExamineDirectory(Rek,Path$,"")=0
   MessageRequester("Error!","Path checking failed!",0)
Else
   Repeat
      Typ=DirectoryEntryType(Rek):Name.s=DirectoryEntryName(Rek)
      If Typ=1
         If CountString(File.s,"*")=0 
            If Typ=1 And Name.s=File.s
                If ReadFile(0,Path$+Name.s)
                   AddGadgetItem(12,-1,Path$+Name.s)
                Else
                   MessageRequester("Error!","No file(s) found!",0)
                EndIf
            EndIf
         ElseIf CountString(File.s,"*")=3 And Left(File.s,1)="*" And Right(File.s,1)="*"
               NewPos=1
               StarPosition=1
               Found=1
               NewFile.s=RemoveString(File.s,"*")
               For A=1 To Len(NewFile.s)
                   If Found=0
                      Break
                   ElseIf Found=1
                      NewNewFile.s=Mid(NewFile.s,StarPosition,1)
                      Pos=FindString(Name.s,NewNewFile.s,NewPos)
                      If Pos=0
                         NewPos=NewPos+1
                         Found=0
                      Else
                         NewPos=Pos+1
                         StarPosition=StarPosition+1
                         Found=1
                      EndIf
                   EndIf
                Next
                If Found=1
                   AddGadgetItem(12,-1,Path$+Name.s+" ?")
                EndIf
         ElseIf Left(File.s,1)="*" And Right(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*")  
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf Left(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf Right(File.s,1)="*"
                NewFile.s=RemoveString(File.s,"*")
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf FindString(File.s,"*",1)<>0 
               Pos=FindString(File.s,"*",1)
               If Left(File.s,Pos-1)=Left(Name.s,Pos-1)
                  Length=Len(File.s)-Pos
                  If Right(File.s,Length)=Right(Name.s,Length) 
                     AddGadgetItem(12,-1,Path$+Name.s)
                  EndIf
               
               EndIf
         EndIf
    ElseIf Typ=2 And Name.s<>"."And Name.s<>".."
         SearchAllPath(Path$+Name.s+"\",Rek+1,File.s)
    EndIf
  Until NextDirectoryEntry(Rek)=0
EndIf
EndProcedure 


Procedure SearchOnePath(Path$,Rek,File.s)
If ExamineDirectory(Rek,Path$,"")=0
   MessageRequester("Error!","Path checking failed!",0)
Else
   Repeat
      Typ=DirectoryEntryType(Rek):Name.s=DirectoryEntryName(Rek)
      If Typ=1
         If CountString(File.s,"*")=0 
            If Typ=1 And Name.s=File.s
                If ReadFile(0,Path$+Name.s)
                   AddGadgetItem(12,-1,Path$+Name.s)
                Else
                   MessageRequester("Error!","No file(s) found!",0)
                EndIf
            EndIf
         ElseIf CountString(File.s,"*")=3 And Left(File.s,1)="*" And Right(File.s,1)="*"
               NewPos=1
               StarPosition=1
               Found=1
               NewFile.s=RemoveString(File.s,"*")
               For A=1 To Len(NewFile.s)
                   If Found=0
                      Break
                   ElseIf Found=1
                      NewNewFile.s=Mid(NewFile.s,StarPosition,1)
                      Pos=FindString(Name.s,NewNewFile.s,NewPos)

                      If Pos=0
                         NewPos=NewPos+1
                         Found=0
                      Else
                         NewPos=Pos+1
                         StarPosition=StarPosition+1
                         Found=1
                      EndIf
                   EndIf
                Next
                If Found=1
                   AddGadgetItem(12,-1,Path$+Name.s+" ?")
                EndIf
         ElseIf Left(File.s,1)="*" And Right(File.s,1)="*"
                NewFile.s=RemoveString(File.s,"*")
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf Left(File.s,1)="*"
                NewFile.s=RemoveString(File.s,"*")
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf Right(File.s,1)="*"
                NewFile.s=RemoveString(File.s,"*")
                If FindString(Name.s,NewFile.s,1)=0
                ElseIf FindString(Name.s,NewFile.s,1)<>0
                    AddGadgetItem(12,-1,Path$+Name.s)
                EndIf
         ElseIf FindString(File.s,"*",1)<>0 
               Pos=FindString(File.s,"*",1)
               If Left(File.s,Pos-1)=Left(Name.s,Pos-1)
                  Length=Len(File.s)-Pos
                  If Right(File.s,Length)=Right(Name.s,Length) 
                     AddGadgetItem(12,-1,Path$+Name.s)
                  EndIf
               
               EndIf
         EndIf
     EndIf
  Until NextDirectoryEntry(Rek)=0 
EndIf
EndProcedure
Dabei ist mir aufgefallen, das der Code bereits Groß und Kleinschreibung beachtet.

Hab ein Verzeichnis mit 2 Unterordner

Hauptverzeichnis (Enhaltene Dateien: Hallo.bmp)
Unterordner A (Enhaltene Dateien: HALLO.bmp)
Unterordner B ((Enhaltene Dateien: HALLO.BMP)

Folgender Ergebnisse erhalten ich:

Suche mit "*.bmp":
2 Dateien

Suche mit "*.BMP":
1 Datei

Suche mit "HALLO*":
2 Dateien

Suche mit "Hallo*":
1 Datei

Kannst du das bestätigen? Teste das bitte mal. Weiß nicht, ob das durch das Update kommt oder wir das vorher nicht gesehen haben :lol: Denke aber eher, das wir das übersehen haben :)
In der Tat. Es bleibt aber trotzdem dir überlassen, welchen Code du nimmst bzw. ob du überhaupt einen nimmst; du kannst die Codes auch umschrieben oder nachschreiben. Nachschreiben empfehle ich dir, wenn du richtig verstehen willst, wie solche "guten" Codes geschrieben werden.
Da kann ich nur zustimmen. Um das Programmieren zu erlernen ist es einfach wichtig, sich mit allen Proceduren auseinanderzusetzen. Ansonsten kopiert man sich die Codes einfach und weiß garnicht was man da macht. Daher: Einfach mal rumtesten und somit herausfinden, WAS der Code überhaupt macht oder nimm keinen Code und erweitere ihn. Braucht zwar Zeit und Geduld aber es lohnt sich und macht mehr Spaß!

Verfasst: 24.01.2007 18:20
von TomS
Hi. Mit der Ergänzung von ts-soft hat es auch funktioniert unter PB4.00

Zu deinem neuen Code:

Code: Alles auswählen

   Repeat
   NextDirectoryEntry(Rek) ;Das hier hat gefehlt!
      Typ=DirectoryEntryType(Rek):Name.s=DirectoryEntryName(Rek)
Bis dann, TomS

EDIT: Achso. Du dachtest ich will, dass die Suche CS ist. Ne. Nur nen kleinen Haken/Chekcobx o.ä, dass man das auswählen kann.
Klar suchen beide Versionen mit Case-Sensitive. Nur bin ich das als Windowsbenutzer nicht gewöhnt.^^

Verfasst: 24.01.2007 21:20
von CNESM
EDIT: Achso. Du dachtest ich will, dass die Suche CS ist. Ne. Nur nen kleinen Haken/Chekcobx o.ä, dass man das auswählen kann.
Klar suchen beide Versionen mit Case-Sensitive. Nur bin ich das als Windowsbenutzer nicht gewöhnt.^^
Da haben wir uns wohl etwas falsch verstanden. Wenn das so ist, kannst du natürlich die Strings einfach in Kleinbuchstaben konvertieren und dann vergleichen :)

Hier der berichtige Code mit der fehlenden Funktion (ungetestet):

Code: Alles auswählen

Global Such$, Verz$, l , Modus 
Verz$ = "C:\Ordner\" 

Declare SearchAllPath(Path$,Rek,File.s) 
Declare SearchOnePath(Path$,Rek,File.s) 

If OpenWindow(0, 0, 0, 400, 480, "Suche", #PB_Window_ScreenCentered) = 0 : End : EndIf 
If CreateGadgetList(WindowID(0)) = 0 : End : EndIf 

ButtonGadget(6, 290, 10,   100, 18,"Nur Hauptpfad") 
ButtonGadget(8, 290, 40,   100, 18,"Alle Unterordner") 
ButtonGadget(10, 290, 70,   100, 18,"End") 

StringGadget(11,8, 10,206,20,"*.BMP") 
StringGadget(13,8, 40,206,20,"C:\Ordner\") 

x =  #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_FullRowSelect 
ListIconGadget (12, 10, 125, 380, 345,"Ergebnisse", 800, x) 

Repeat 
   Event = WaitWindowEvent()    
   If  Event = #PB_Event_Gadget Or Event =  #PB_Event_Menu 
      Select  EventGadget() 
    
         Case 6 
         ClearGadgetItemList(12) : SearchOnePath(GetGadgetText(13), 0, GetGadgetText(11)) 
                  
         Case 8 
         ClearGadgetItemList(12) : SearchAllPath(GetGadgetText(13),0,GetGadgetText(11)) 

         Case 10 
          
         End 

      EndSelect 
   EndIf 
Until Event = 0 
End 

Procedure SearchAllPath(Path$,Rek,File.s) 
If ExamineDirectory(Rek,Path$,"")=0 
   MessageRequester("Error!","Path checking failed!",0) 
Else 
Repeat 
   NextDirectoryEntry(Rek) ;Das hier hat gefehlt! 
      Typ=DirectoryEntryType(Rek):Name.s=DirectoryEntryName(Rek)
      If Typ=1 
         If CountString(File.s,"*")=0 
            If Typ=1 And Name.s=File.s 
                If ReadFile(0,Path$+Name.s) 
                   AddGadgetItem(12,-1,Path$+Name.s) 
                Else 
                   MessageRequester("Error!","No file(s) found!",0) 
                EndIf 
            EndIf 
         ElseIf CountString(File.s,"*")=3 And Left(File.s,1)="*" And Right(File.s,1)="*" 
               NewPos=1 
               StarPosition=1 
               Found=1 
               NewFile.s=RemoveString(File.s,"*") 
               For A=1 To Len(NewFile.s) 
                   If Found=0 
                      Break 
                   ElseIf Found=1 
                      NewNewFile.s=Mid(NewFile.s,StarPosition,1) 
                      Pos=FindString(Name.s,NewNewFile.s,NewPos) 
                      If Pos=0 
                         NewPos=NewPos+1 
                         Found=0 
                      Else 
                         NewPos=Pos+1 
                         StarPosition=StarPosition+1 
                         Found=1 
                      EndIf 
                   EndIf 
                Next 
                If Found=1 
                   AddGadgetItem(12,-1,Path$+Name.s+" ?") 
                EndIf 
         ElseIf Left(File.s,1)="*" And Right(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*")  
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf Left(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf Right(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf FindString(File.s,"*",1)<>0 
               Pos=FindString(File.s,"*",1) 
               If Left(File.s,Pos-1)=Left(Name.s,Pos-1) 
                  Length=Len(File.s)-Pos 
                  If Right(File.s,Length)=Right(Name.s,Length) 
                     AddGadgetItem(12,-1,Path$+Name.s) 
                  EndIf 
                
               EndIf 
         EndIf 
    ElseIf Typ=2 And Name.s<>"."And Name.s<>".." 
         SearchAllPath(Path$+Name.s+"\",Rek+1,File.s) 
    EndIf 
  Until NextDirectoryEntry(Rek)=0 
EndIf 
EndProcedure 


Procedure SearchOnePath(Path$,Rek,File.s) 
If ExamineDirectory(Rek,Path$,"")=0 
   MessageRequester("Error!","Path checking failed!",0) 
Else 
Repeat 
   NextDirectoryEntry(Rek) ;Das hier hat gefehlt! 
      Typ=DirectoryEntryType(Rek):Name.s=DirectoryEntryName(Rek)
      If Typ=1 
         If CountString(File.s,"*")=0 
            If Typ=1 And Name.s=File.s 
                If ReadFile(0,Path$+Name.s) 
                   AddGadgetItem(12,-1,Path$+Name.s) 
                Else 
                   MessageRequester("Error!","No file(s) found!",0) 
                EndIf 
            EndIf 
         ElseIf CountString(File.s,"*")=3 And Left(File.s,1)="*" And Right(File.s,1)="*" 
               NewPos=1 
               StarPosition=1 
               Found=1 
               NewFile.s=RemoveString(File.s,"*") 
               For A=1 To Len(NewFile.s) 
                   If Found=0 
                      Break 
                   ElseIf Found=1 
                      NewNewFile.s=Mid(NewFile.s,StarPosition,1) 
                      Pos=FindString(Name.s,NewNewFile.s,NewPos) 

                      If Pos=0 
                         NewPos=NewPos+1 
                         Found=0 
                      Else 
                         NewPos=Pos+1 
                         StarPosition=StarPosition+1 
                         Found=1 
                      EndIf 
                   EndIf 
                Next 
                If Found=1 
                   AddGadgetItem(12,-1,Path$+Name.s+" ?") 
                EndIf 
         ElseIf Left(File.s,1)="*" And Right(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf Left(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf Right(File.s,1)="*" 
                NewFile.s=RemoveString(File.s,"*") 
                If FindString(Name.s,NewFile.s,1)=0 
                ElseIf FindString(Name.s,NewFile.s,1)<>0 
                    AddGadgetItem(12,-1,Path$+Name.s) 
                EndIf 
         ElseIf FindString(File.s,"*",1)<>0 
               Pos=FindString(File.s,"*",1) 
               If Left(File.s,Pos-1)=Left(Name.s,Pos-1) 
                  Length=Len(File.s)-Pos 
                  If Right(File.s,Length)=Right(Name.s,Length) 
                     AddGadgetItem(12,-1,Path$+Name.s) 
                  EndIf 
                
               EndIf 
         EndIf 
     EndIf 
  Until NextDirectoryEntry(Rek)=0 
EndIf 
EndProcedure
Edit by NicTheQuick: Code- und Quote-Tags vertauscht

Verfasst: 24.01.2007 22:25
von AND51
Du hast die CODE- und QUOTE-Tags vertauscht, dein Code ist dadurch sehr unleserlich; bitte ändere das noch, ja?
Alle Zeiten sind UTC+02:00
Seite 2 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de