PureBoard

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

[PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

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

Seite 1 von 1

[PB 4.0] Eine weitere Routine zur rekursiven Dateisuche

Verfasst: 06.03.2006 13:51
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

Verfasst: 07.07.2006 18:50
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())

Verfasst: 07.07.2006 19:04
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

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

Verfasst: 05.09.2010 22:27
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

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

Verfasst: 05.09.2010 23:03
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

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

Verfasst: 06.09.2010 19:57
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

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

Verfasst: 06.09.2010 22:13
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

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

Verfasst: 06.09.2010 22:41
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:

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

Verfasst: 06.09.2010 22:50
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.

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

Verfasst: 06.09.2010 22:56
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
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de