Suchen per Wildcards

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag 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.
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Nach oben
CNESM
Beiträge: 311
Registriert: 29.08.2004 15:16
Kontaktdaten:
Kontaktdaten von CNESM

Beitrag 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ß!
Nach oben
Benutzeravatar
TomS
Beiträge: 1508
Registriert: 23.12.2005 12:41
Wohnort: München

Beitrag 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.^^
Nach oben
CNESM
Beiträge: 311
Registriert: 29.08.2004 15:16
Kontaktdaten:
Kontaktdaten von CNESM

Beitrag 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
Nach oben
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Du hast die CODE- und QUOTE-Tags vertauscht, dein Code ist dadurch sehr unleserlich; bitte ändere das noch, ja?
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“