[PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

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
Kiffi
Beiträge: 10711
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

[PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von Kiffi »

Tach,

hier ein weiterer kleiner Code, mit dem man einen Datenträger rekursiv
nach Dateien durchsuchen kann. Die Besonderheit hier ist, dass man in
der aufzurufenden Routine 2 Prozeduren angeben kann, die dann
angesprungen werden, wenn entweder eine Datei oder ein Ordner
gefunden wird. Des weiteren lässt sich die Rekursion nach Belieben
abbrechen.

Hier ein Beispielaufruf der Include-Datei:

Code: Alles auswählen

XIncludeFile "FindFiles.pbi"

Procedure FoundFile(Directory$, Filename$)
  
  Static lCounter
  
  Select LCase(GetExtensionPart(Filename$)) 
    Case "ico", "png"
      Debug "Found file: " + Directory$ + Filename$
      lCounter + 1
      If lCounter > 99
        FindFiles_Stop() ; Rekursive Dateisuche stoppen
      EndIf
  EndSelect
    
EndProcedure

Procedure FoundDirectory(Directory$)
  Debug "Found Directory: " + Directory$ 
EndProcedure

; Hier wird die eigentliche Suchroutine aufgerufen
; wir übergeben neben dem Pfad, der durchsucht werden soll,
; die Adresse der Prozedur FoundFile(), die dann aufgerufen wird
; wenn eine Datei gefunden wird und die Adresse der Prozedur
; FoundDirectory(), die aufgerufen wird, wenn ein Ordner gefunden
; wird.

FindFiles_Start("D:\icons\", @FoundFile(), @FoundDirectory())
Und hier der Include-Code (speichern unter [c]FindFiles.pbi[/c]):

Code: Alles auswählen

EnableExplicit

Global NotifyFunctionFindFile
Global NotifyFunctionFindDirectory
Global StopFindFiles

Procedure BrowseDirectory(DirectoryToBrowse.s)
  
  Define.l DirectoryNumber
  Define.s FoundFileName
  Define.s FoundDirectory
  Define.s FoundDirectoryName
  
  If Right(DirectoryToBrowse, 1) <> "\" : DirectoryToBrowse + "\" : EndIf
  
  DirectoryNumber = ExamineDirectory(#PB_Any, DirectoryToBrowse, "")
  
  If DirectoryNumber
    While NextDirectoryEntry(DirectoryNumber)
      Select DirectoryEntryType(DirectoryNumber)
        Case #PB_DirectoryEntry_File
          FoundFileName = DirectoryEntryName(DirectoryNumber)
          If NotifyFunctionFindFile
            CallFunctionFast(NotifyFunctionFindFile, DirectoryToBrowse, FoundFileName)
          EndIf
        Case #PB_DirectoryEntry_Directory
          FoundDirectoryName = DirectoryEntryName(DirectoryNumber)
          If FoundDirectoryName <> "." And FoundDirectoryName <> ".."
            If NotifyFunctionFindDirectory
              FoundDirectory = DirectoryToBrowse + FoundDirectoryName
              CallFunctionFast(NotifyFunctionFindDirectory, FoundDirectory)
            EndIf
            If StopFindFiles : Break : EndIf
            BrowseDirectory(DirectoryToBrowse + FoundDirectoryName)
          EndIf
      EndSelect
      If StopFindFiles : Break : EndIf
    Wend
    FinishDirectory(DirectoryNumber)
  EndIf
  
EndProcedure

Procedure FindFiles_Start(DirectoryToBrowse.s, FunctionToCallIfFindFile.l, FunctionToCallIfFindDirectory.l)
  
  NotifyFunctionFindFile      = FunctionToCallIfFindFile
  NotifyFunctionFindDirectory = FunctionToCallIfFindDirectory
  
  StopFindFiles = #False
  
  BrowseDirectory(DirectoryToBrowse)
  
EndProcedure

Procedure FindFiles_Stop()
  StopFindFiles = #True
EndProcedure
Grüße ... Kiffi
a²+b²=mc²
Nach oben
Benutzeravatar
MVXA
Beiträge: 3823
Registriert: 11.09.2004 00:45
Wohnort: Bremen, Deutschland
Kontaktdaten:
Kontaktdaten von MVXA

Beitrag von MVXA »

Ich habe mir mal die Freiheit genommen und den schicken Code etwas
verändert. Vielleicht hat noch jemand ein paar Anregungen ;).

Code: Alles auswählen

EnableExplicit

Prototype clbSearchFile(lType.l, sName.s)

Procedure FindFile_Stop(Status) 
    Shared lStopFindFiles.l
    
    lStopFindFiles = Status
EndProcedure

Procedure BrowseDirectory(sPath.s, *pClbFound = #Null)
    Protected lDicID.l, qFiles.q, sDirName.s
    Static pCallBack.clbSearchFile
    Shared lStopFindFiles.l
    
    If (Right(sPath, 1) <> "\"): sPath + "\"  : EndIf
    If (Not pCallBack): pCallBack = *pClbFound: EndIf
    
    lDicID = ExamineDirectory(#PB_Any, sPath, "*.*")
    If lDicID
        While NextDirectoryEntry(lDicID)
            qFiles + 1
        
            If DirectoryEntryType(lDicID) =  #PB_DirectoryEntry_File
                If Not pCallBack(1, sPath + DirectoryEntryName(lDicID))
                    Break
                EndIf
            
            Else
                sDirName = DirectoryEntryName(lDicID)
                
                If (sDirName <> ".") And (sDirName <> "..")
                    If lStopFindFiles : Break : EndIf
                
                    Select pCallBack(2, sPath + sDirName)   
                        Case #True
                            qFiles + BrowseDirectory(sPath + sDirName)
                            
                        Case #False  
                            Continue
                        
                        Default: Break
                    EndSelect
                EndIf
            EndIf
            
            If lStopFindFiles : Break : EndIf
        Wend
        
        FinishDirectory(lDicID)
        ProcedureReturn qFiles
    EndIf
EndProcedure

Procedure Datei(Type, Name$)
    If GetAsyncKeyState_(#VK_ESCAPE)
        FindFile_Stop(#True)
        
    Else    
        If Type = 2
            Debug "[DIR]" + Name$
            ProcedureReturn #True
            
        Else
            Debug Name$
            ProcedureReturn #True
        EndIf
    EndIf
EndProcedure

Debug BrowseDirectory("C:\", @Datei())
Bild
Nach oben
Benutzeravatar
Kiffi
Beiträge: 10711
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Beitrag von Kiffi »

> Ich habe mir mal die Freiheit genommen und den schicken Code etwas
> verändert.

gerne! Ich komme zwar momentan aus Zeitgründen nicht dazu, die
Funktionsweise Deines Codes in Gänze zu erfassen, aber Verbesserungen
sind immer willkommen. :D

> Vielleicht hat noch jemand ein paar Anregungen ;).

immer her damit! :-)

Grüße ... Kiffi
a²+b²=mc²
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von Falko »

> Vielleicht hat noch jemand ein paar Anregungen ;).

immer her damit! :-)

Grüße ... Kiffi
Läuft leider nicht mehr mit PB 4.51RC... aufgrund der Änderungen in CallCunctionFast :freak: .

Gruß Falko
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von ts-soft »

Falko hat geschrieben: Läuft leider nicht mehr mit PB 4.51RC... aufgrund der Änderungen in CallCunctionFast :freak: .

Gruß Falko
Nimm den Code von MVXA, der nutzt bereits Prototypes oder stell Peters Code um auf Prototype.

So langsam kann ich das callfunction... gedöns nicht mehr lesen

Gruß
Thomas
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von Falko »

ts-soft hat geschrieben:
Falko hat geschrieben: Läuft leider nicht mehr mit PB 4.51RC... aufgrund der Änderungen in CallCunctionFast :freak: .

Gruß Falko
Nimm den Code von MVXA, der nutzt bereits Prototypes oder stell Peters Code um auf Prototype.

So langsam kann ich das callfunction... gedöns nicht mehr lesen

Gruß
Thomas
Ich habe ja nichts gegen MVXA's Code, aber ich wollte gerne den OriginalSource von Peter gerne an die aktuelle PB-Version 4.51 anpassen.

Soweit habe ich nach einigen Versuchen hier Peters PBI-Datei auf Prototyp umgestellt.
So wie es aussieht, läuft er jetzt.

Code: Alles auswählen

EnableExplicit

Prototype.s ProtoNotifyFunctionFindfile(DirectoryToBrowse.s, FoundFileName.s)
Prototype.s ProtoNotifyFunctionFindDirectory(FoundDirectory.s)


Global.ProtoNotifyFunctionFindfile NotifyFunctionFindFile
Global.ProtoNotifyFunctionFindDirectory NotifyFunctionFindDirectory
Global StopFindFiles


Procedure.s BrowseDirectory(DirectoryToBrowse.s)
 
  Define.l DirectoryNumber
  Define.s FoundFileName
  Define.s FoundDirectory
  Define.s FoundDirectoryName
  
  ;Static NotifyFunctionFindFile.ProtoNotifyFunctionFindfile
  ;Static NotifyFunctionFindDirectory.ProtoNotifyFunctionFindDirectory
  
  If Right(DirectoryToBrowse, 1) <> "\" : DirectoryToBrowse + "\" : EndIf
 
  DirectoryNumber = ExamineDirectory(#PB_Any, DirectoryToBrowse, "")
 
  If DirectoryNumber
    While NextDirectoryEntry(DirectoryNumber)
      Select DirectoryEntryType(DirectoryNumber)
        Case #PB_DirectoryEntry_File
          FoundFileName = DirectoryEntryName(DirectoryNumber)
          NotifyFunctionFindFile(DirectoryToBrowse, FoundFileName)
        Case #PB_DirectoryEntry_Directory
          FoundDirectoryName = DirectoryEntryName(DirectoryNumber)
          If FoundDirectoryName <> "." And FoundDirectoryName <> ".."
              FoundDirectory = DirectoryToBrowse + FoundDirectoryName
              NotifyFunctionFindDirectory(FoundDirectory)
           If StopFindFiles : Break : EndIf
           Debug  BrowseDirectory(DirectoryToBrowse + FoundDirectoryName)
          EndIf
      EndSelect
      If StopFindFiles : Break : EndIf
    Wend
    FinishDirectory(DirectoryNumber)
  EndIf
  
EndProcedure

Procedure FindFiles_Start(DirectoryToBrowse.s, FunctionToCallIfFindFile.l, FunctionToCallIfFindDirectory.l)
 
  NotifyFunctionFindFile      = FunctionToCallIfFindFile
  NotifyFunctionFindDirectory = FunctionToCallIfFindDirectory
 
  StopFindFiles = #False
 
  BrowseDirectory(DirectoryToBrowse)
 
EndProcedure

Procedure FindFiles_Stop()
  StopFindFiles = #True
EndProcedure
Falls ihr da noch Fehler findet, würde ich mich sehr freuen, diese bereinigen zu können.
Ansonsten kann man sagen, das endlich das Problem mit dem Call...Fast und String hiermit bereinigt ist.

Gruß Falko
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:
Kontaktdaten von edel

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von edel »

Peters Include fuer 4.5

Code: Alles auswählen

EnableExplicit

Global NotifyFunctionFindFile
Global NotifyFunctionFindDirectory
Global StopFindFiles

Procedure BrowseDirectory(DirectoryToBrowse.s)
  
  Define.l DirectoryNumber
  Define.s FoundFileName
  Define.s FoundDirectory
  Define.s FoundDirectoryName
  
  If Right(DirectoryToBrowse, 1) <> "\" : DirectoryToBrowse + "\" : EndIf
  
  DirectoryNumber = ExamineDirectory(#PB_Any, DirectoryToBrowse, "")
  
  If DirectoryNumber
    While NextDirectoryEntry(DirectoryNumber)
      Select DirectoryEntryType(DirectoryNumber)
        Case #PB_DirectoryEntry_File
          FoundFileName = DirectoryEntryName(DirectoryNumber)
          If NotifyFunctionFindFile
            CallFunctionFast(NotifyFunctionFindFile, @DirectoryToBrowse, @FoundFileName)
          EndIf
        Case #PB_DirectoryEntry_Directory
          FoundDirectoryName = DirectoryEntryName(DirectoryNumber)
          If FoundDirectoryName <> "." And FoundDirectoryName <> ".."
            If NotifyFunctionFindDirectory
              FoundDirectory = DirectoryToBrowse + FoundDirectoryName
              CallFunctionFast(NotifyFunctionFindDirectory, @FoundDirectory)
            EndIf
            If StopFindFiles : Break : EndIf
            BrowseDirectory(DirectoryToBrowse + FoundDirectoryName)
          EndIf
      EndSelect
      If StopFindFiles : Break : EndIf
    Wend
    FinishDirectory(DirectoryNumber)
  EndIf
  
EndProcedure

Procedure FindFiles_Start(DirectoryToBrowse.s, FunctionToCallIfFindFile.l, FunctionToCallIfFindDirectory.l)
  
  NotifyFunctionFindFile      = FunctionToCallIfFindFile
  NotifyFunctionFindDirectory = FunctionToCallIfFindDirectory
  
  StopFindFiles = #False
  
  BrowseDirectory(DirectoryToBrowse)
  
EndProcedure

Procedure FindFiles_Stop()
  StopFindFiles = #True
EndProcedure
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von ts-soft »

edel hat geschrieben:Peters Include fuer 4.5
Nur kompatible dazu. Ein Code für PB >= 4 Enthält keine Call..., da nicht mehr
empfohlen :mrgreen:
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
Benutzeravatar
edel
Beiträge: 3667
Registriert: 28.07.2005 12:39
Computerausstattung: GameBoy
Kontaktdaten:
Kontaktdaten von edel

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von edel »

Soll jeder fuer sich entscheiden, womit er besser zurecht kommt. Da hilft es auch nicht, wenn du 20 mal am Tag Prototyp anbetest.
Nach oben
Benutzeravatar
Falko
Admin
Beiträge: 3535
Registriert: 29.08.2004 11:27
Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit)
Kontaktdaten:
Kontaktdaten von Falko

Re: [PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Beitrag von Falko »

edel hat geschrieben:Soll jeder fuer sich entscheiden, womit er besser zurecht kommt. Da hilft es auch nicht, wenn du 20 mal am Tag Prototyp anbetest.
Danke @edel. An die Adressübergabe der Strings mit "@" hatte ich nun überhaupt nicht daran gedacht.

Gruß Falko
Bild
Win11 Pro 64-Bit, PB_6.11b1
‮
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“