File Filter

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
StarBootics
Addict
Addict
Posts: 1006
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

File Filter

Post by StarBootics »

Hello everyone,

As far as I know ExamineDirectory() don't allow to set multiple pattern. So If you need to retain 2 or more file types you need to Examine the directory for each file type you need. So I have created a small library to be used in conjunction with ExamineDirectory() to test if the file extension is one of we are looking for. See the examples provided with the source code.

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Code generated by : Dev-Object - V2.2.3
; Project name : File Filter
; File name : FileFilter - OOP.pb
; File Version : 1.0.0
; Programmation : OK
; Programmed by : StarBootics
; Creation Date : September 8th, 2023
; Last update : September 8th, 2023
; Coded for PureBasic : V6.03 beta 5 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming notes
;
; A small file filter to be used in conjunction with
; ExamineDirectory() or a list of filenames.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule FileFilter
  
  Interface FileFilter
    
    GetExtensions.s()
    SetExtensions(Extensions.s)
    IsAccepted.i(FileName.s)
    Free()
    
  EndInterface
  
  Declare.i New(Extensions.s)
  
EndDeclareModule

Module FileFilter
  
  DisableDebugger
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Structure declaration <<<<<

  Structure Private_Members
    
    VirtualTable.i
    Extensions.s
    ExtensionMax.l
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The observator <<<<<

  Procedure.s GetExtensions(*This.Private_Members)
    
    ProcedureReturn *This\Extensions
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The mutator <<<<<

  Procedure SetExtensions(*This.Private_Members, Extensions.s)
    
    *This\Extensions = Extensions
    *This\ExtensionMax = CountString(Extensions, "|") + 1
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The IsAccepted operator <<<<<
  
  Procedure.i IsAccepted(*This.Private_Members, FileName.s)
    
    For ExtensionID = 1 To *This\ExtensionMax
      If LCase(GetExtensionPart(FileName)) = LCase(StringField(*This\Extensions, ExtensionID, "|"))
        ProcedureReturn #True
      EndIf
    Next
    
    ProcedureReturn #False
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Destructor <<<<<

  Procedure Free(*This.Private_Members)
    
    FreeStructure(*This)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Constructor <<<<<

  Procedure.i New(Extensions.s)
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    SetExtensions(*This, Extensions)
    
    ProcedureReturn *This
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Virtual Table Entries <<<<<

  DataSection
    START_METHODS:
    Data.i @GetExtensions()
    Data.i @SetExtensions()
    Data.i @IsAccepted()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
  EnableDebugger
  
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.001 seconds (118000.00 lines/second) <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

CompilerIf #PB_Compiler_IsMainFile
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; We want PB Source files and PB Include files only
  
  FileFilter.FileFilter::FileFilter = FileFilter::New("pb|pbi")
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; Example #1
  
  Macro AddElementEx(ListName, Element)
    AddElement(ListName)
    ListName = Element
  EndMacro
  
  NewList FileNames.s()
  
  AddElementEx(FileNames(), "Constants.pb")
  AddElementEx(FileNames(), "Custom Gadgets.pbi")
  AddElementEx(FileNames(), "Messages.txt")
  AddElementEx(FileNames(), "Main.pb")
  AddElementEx(FileNames(), "project.pbp")
  AddElementEx(FileNames(), "form.pbf")
 
  DisableDebugger
  
  StartTime = ElapsedMilliseconds()
  
  For TestID = 0 To 10000
    
    ForEach FileNames()
      
      If FileFilter\IsAccepted(FileNames())
        Debug "File accepted : " + FileNames()
      Else
        Debug "File not accepted : " + FileNames()
      EndIf
      
    Next
    
  Next
  
  ElapsedTime = ElapsedMilliseconds()-StartTime
  
  EnableDebugger
  
  Debug "Elapsed Time : " + Str(ElapsedTime) + " milliseconds" 
  
  Debug ""
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; Example #2
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; We want bmp and png image files only
  
  FileFilter\SetExtensions("bmp|png")
  
  If ExamineDirectory(0, GetUserDirectory(#PB_Directory_Pictures), "*.*")
    
    While NextDirectoryEntry(0)
      
      EntryName.s = DirectoryEntryName(0)
      
      If EntryName <> "." And EntryName <> ".."
        
        If DirectoryEntryType(0) = #PB_DirectoryEntry_File
          
          If FileFilter\IsAccepted(EntryName)
            Debug "File accepted : " + EntryName
          Else
            Debug "File not accepted : " + EntryName
          EndIf
          
        EndIf
        
      EndIf
      
    Wend
    
    FinishDirectory(0)
    
  EndIf
  
  FileFilter\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; AUTOMATICALLY GENERATED CODE, DO NOT MODIFY
; UNLESS YOU REALLY, REALLY, REALLY MEAN IT !!
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Code generated by : Dev-Object - V2.2.3
; Project name : FileFilter
; File name : FileFilter - OOP.pb
; File Version : 2.0.0
; Programmation : OK
; Programmed by : StarBootics
; Creation Date : September 8th, 2023
; Last update : September 10th, 2023
; Coded for PureBasic : V6.03 beta 5 LTS
; Platform : Windows, Linux, MacOS X
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Programming notes
;
; A small file filter to be used in conjonction with
; ExamineDirectory() or a list of filenames.
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

DeclareModule FileFilter
  
  Interface FileFilter
    
    GetExtensions.s()
    SetExtensions(Extensions.s)
    IsAccepted.i(FileName.s)
    Free()
    
  EndInterface
  
  Declare.i New(Extensions.s)
  
EndDeclareModule

Module FileFilter
  
  DisableDebugger
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< Structure declaration <<<<<

  Structure Private_Members
    
    VirtualTable.i
    List Extensions.s()
    
  EndStructure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The observator <<<<<

  Procedure.s GetExtensions(*This.Private_Members)
    
    ForEach *This\Extensions()
      
      Extensions.s + *This\Extensions()
      
      If ListIndex(*This\Extensions()) < ListSize(*This\Extensions()) - 1
        Extensions + "|"
      EndIf
    
    Next
    
    ProcedureReturn Extensions
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The mutator <<<<<

  Procedure SetExtensions(*This.Private_Members, Extensions.s)
    
    ClearList(*This\Extensions())
    
    ExtensionMax.l = CountString(Extensions, "|") + 1
    
    For ExtensionID.l = 1 To ExtensionMax
      AddElement(*This\Extensions())
      *This\Extensions() = LCase(StringField(Extensions, ExtensionID, "|"))
    Next
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The IsAccepted operator <<<<<
  
  Procedure.i IsAccepted(*This.Private_Members, FileName.s)
    
    ForEach *This\Extensions()
      If LCase(GetExtensionPart(FileName)) = *This\Extensions()
        ProcedureReturn #True
      EndIf
    Next
    
    ProcedureReturn #False
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Destructor <<<<<

  Procedure Free(*This.Private_Members)
    
    FreeStructure(*This)
    
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Constructor <<<<<

  Procedure.i New(Extensions.s)
    
    *This.Private_Members = AllocateStructure(Private_Members)
    *This\VirtualTable = ?START_METHODS
    
    SetExtensions(*This, Extensions)
    
    ProcedureReturn *This
  EndProcedure
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; <<<<< The Virtual Table Entries <<<<<

  DataSection
    START_METHODS:
    Data.i @GetExtensions()
    Data.i @SetExtensions()
    Data.i @IsAccepted()
    Data.i @Free()
    END_METHODS:
  EndDataSection
  
  EnableDebugger
  
EndModule

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code generated in : 00.001 seconds (118000.00 lines/second) <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

CompilerIf #PB_Compiler_IsMainFile
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; We want PB Source files and PB Include files only
  
  FileFilter.FileFilter::FileFilter = FileFilter::New("pb|pbi")
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; Example #1
  
  Macro AddElementEx(ListName, Element)
    AddElement(ListName)
    ListName = Element
  EndMacro
  
  NewList FileNames.s()
  
  AddElementEx(FileNames(), "Constants.pb")
  AddElementEx(FileNames(), "Custom Gadgets.pbi")
  AddElementEx(FileNames(), "Messages.txt")
  AddElementEx(FileNames(), "Main.pb")
  AddElementEx(FileNames(), "project.pbp")
  AddElementEx(FileNames(), "form.pbf")
  
  DisableDebugger
  
  StartTime = ElapsedMilliseconds()
  
  For TestID = 0 To 10000
    
    ForEach FileNames()
      
      If FileFilter\IsAccepted(FileNames())
        Debug "File accepted : " + FileNames()
      Else
        Debug "File not accepted : " + FileNames()
      EndIf
      
    Next
    
  Next
  
  ElapsedTime = ElapsedMilliseconds()-StartTime
  
  EnableDebugger
  
  Debug "Elapsed Time : " + Str(ElapsedTime) + " milliseconds" 
  
  Debug ""
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; Example #2
  
  ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  ; We want bmp and png image files only
  
  FileFilter\SetExtensions("bmp|png")
  
  If ExamineDirectory(0, GetUserDirectory(#PB_Directory_Pictures), "*.*")
    
    While NextDirectoryEntry(0)
      
      EntryName.s = DirectoryEntryName(0)
      
      If EntryName <> "." And EntryName <> ".."
        
        If DirectoryEntryType(0) = #PB_DirectoryEntry_File
          
          If FileFilter\IsAccepted(EntryName)
            Debug "File accepted : " + EntryName
          Else
            Debug "File not accepted : " + EntryName
          EndIf
          
        EndIf
        
      EndIf
      
    Wend
    
    FinishDirectory(0)
    
  EndIf

  FileFilter\Free()
  
CompilerEndIf

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<
Best regards
StarBootics
Last edited by StarBootics on Mon Sep 11, 2023 1:14 am, edited 2 times in total.
The Stone Age did not end due to a shortage of stones !
Top
User avatar
Janni
Enthusiast
Enthusiast
Posts: 127
Joined: Mon Feb 21, 2022 5:58 pm
Location: Norway

Re: File Filter

Post by Janni »

Cool! thanks for sharing :D
Spec: Linux Mint 20.3 Cinnamon, i7-3770K, 16GB RAM, RTX 2070 Super
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: File Filter

Post by Kwai chang caine »

Can be usefull, thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
AZJIO
Addict
Addict
Posts: 2191
Joined: Sun May 14, 2017 1:48 am

Re: File Filter

Post by AZJIO »

Why doesn't the recursive call work?

Code: Select all

	FileFilter.FileFilter::FileFilter = FileFilter::New("pb|pbi")
	FileFilter\SetExtensions("pb|pbi")
	
	Global i
	
	Procedure FileSearch(List Files.s(), dir.s)
		Protected name.s, id
		
		If Right(dir, 1) <> #PS$
			dir + #PS$
		EndIf
		
		id = ExamineDirectory(#PB_Any, dir, "")
		If id
			While NextDirectoryEntry(id)
				name = DirectoryEntryName(id)
				If name = "." Or name = ".."
					Continue
				EndIf
				If DirectoryEntryType(id) = #PB_DirectoryEntry_Directory ; if the path is a folder
					FileSearch(Files(), dir + name + "\")				 ; recursive call to subfolder
				ElseIf FileFilter\IsAccepted(name) And AddElement(Files())
					Files() = dir + DirectoryEntryName(id)
					i + 1
				EndIf
			Wend
			FinishDirectory(id)
		EndIf
	EndProcedure
	
	Define NewList Files.s()
	; FileSearch(Files(), "C:\ProgramData\PureBasic\Examples\")
	FileSearch(Files(), GetTemporaryDirectory())
	FileFilter\Free()
	Debug i
Top
User avatar
StarBootics
Addict
Addict
Posts: 1006
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: File Filter

Post by StarBootics »

Hello AZJIO,

I have tweaked your code for linux and your code work.

Code: Select all

  Global FileFilter.FileFilter::FileFilter = FileFilter::New("pb|pbi")
  FileFilter\SetExtensions("pb|pbi")
  
  Global i
  
  Procedure FileSearch(List Files.s(), dir.s)
    Protected name.s, id
    
    If Right(dir, 1) <> #PS$
      dir + #PS$
    EndIf
    
    id = ExamineDirectory(#PB_Any, dir, "")
    If id
      While NextDirectoryEntry(id)
        name = DirectoryEntryName(id)
        If name = "." Or name = ".."
          Continue
        EndIf
        If DirectoryEntryType(id) = #PB_DirectoryEntry_Directory ; if the path is a folder
          FileSearch(Files(), dir + name + "/")                  ; recursive call to subfolder
        ElseIf FileFilter\IsAccepted(name) And AddElement(Files())
          Files() = dir + DirectoryEntryName(id)
          i + 1
        EndIf
      Wend
      FinishDirectory(id)
    EndIf
    
  EndProcedure
  
  Define NewList Files.s()
  FileSearch(Files(), "/home/starbootics/Files/Codes PureBasic/")
  ; FileSearch(Files(), GetTemporaryDirectory())
  FileFilter\Free()
  Debug i
  
CompilerEndIf


In my case the debugger output show 8440. Are you sure you have the right initial directory ?

Best regards
StarBootics
The Stone Age did not end due to a shortage of stones !
Top
AZJIO
Addict
Addict
Posts: 2191
Joined: Sun May 14, 2017 1:48 am

Re: File Filter

Post by AZJIO »

The problem was the missing "Global" in the first line.
My function is 10% faster (with flag 2).

If the mask is large, then querying the elements using StringField() for each file extension is slow, it is better to use SplitL
filter = "bmp|gif|jpg|jpeg|png|tif|tiff"

Code: Select all

    For ExtensionID = 1 To *This\ExtensionMax
      If LCase(GetExtensionPart(FileName)) = LCase(StringField(*This\Extensions, ExtensionID, "|"))
        ProcedureReturn #True
      EndIf
    Next
Add list

Code: Select all

; Structure Private_Members
		List Ext.s()


; Procedure SetExtensions(*This.Private_Members, Extensions.s)
		SplitL(Extensions, *This\Ext(), "|")
; 		SplitL(LCase(Extensions), *This\Ext(), "|") ; ?
		; convert to lowercase 1 time, instead of doing it for each file
		ForEach *This\Ext()
			*This\Ext() = LCase(*This\Ext())
		Next
		
		
; Procedure.i IsAccepted(*This.Private_Members, FileName.s)
		ForEach *This\Ext()
			If LCase(GetExtensionPart(FileName)) = *This\Ext()
				ProcedureReturn #True
			EndIf
		Next
Top
User avatar
StarBootics
Addict
Addict
Posts: 1006
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: File Filter

Post by StarBootics »

Hello everyone,

Just to let you know that I have added the V2.0.0 in the first post of this topic.Thanks to AZJIO for pointing out the performance issue.

Best regards
StarBootics
The Stone Age did not end due to a shortage of stones !
Top
Post Reply

Return to “Tricks 'n' Tips”