PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

File system bits and pieces

https://www.purebasic.fr/english/viewtopic.php?t=15336

Page 1 of 1

File system bits and pieces

Posted: Mon May 30, 2005 10:02 pm
by utopiomania
Code updated For 5.20+

I'm busy translating a few programs to PureBasic and would like to post some tiny bits of them for testing
and in case you can use any of it.

These three procedures are meant to be 'file type aware', REM/UNREM in the event handler to check out
each of them. The 'docs' are to be found in the remarks in the procedures themselves. :wink:

Code: Select all

;FILESYSTEM PROCEDURES

;DECLARATIONS
Declare GetDirEntries(Path.s,Ext.s,Dirs,Excl)
Declare GetAllDirEntries(Path.s,Ext.s,I,N,Dirs,Excl)
Declare FindFileTypesInDir(Path.s,Ext.s,Excl)
Declare GetDirsWithFileTypes(Path.s,Ext.s,Excl)
Declare.s GetAppDir()

#MaxDirEntries=128000
Dim DirEntries.s(#MAxDirEntries)

Procedure GetDirEntries(Path.s,Ext.s,Dirs,Excl)
  ;Fills in the array DirEntries with directory entries in path.
  ;Lists all(Ext.s="") or some(Ext.s=".rtf;.htm;" etc.) filetypes.
  ;Includes directories if Dirs=1.
  ;Excludes hidden and system entries if Excl=1.
  If ExamineDirectory(0,Path.s,"*.*")
    Repeat
      WindowEvent()
      FileType=NextDirectoryEntry(1)
      If FileType
        Name.s=DirectoryEntryName(1)
        Attr=DirectoryEntryAttributes(1)
        Incl=1
        If Excl And (Attr&#PB_FileSystem_Hidden)|(Attr&#PB_FileSystem_System)
          ;Hidden or system file, do not include
          Incl=0
        EndIf
        If Incl
          ;Entry attributes ok, entry eligible for inclusion
          If FileType=2
            ;The entry is a directory
            If Dirs And Name.s<>"." And Name.s<>".."
              ;To be included and is not a dot entry
              Shared DirEntries()
              DirEntries.s(I)=Path.s+Name.s+"\"
              I+1
              DirEntries.s(I)=""
            EndIf
          Else
            ;The entry is a file
            If Ext.s
              ;List files with some extensions
              FileExt.s="."+GetExtensionPart(Name.s)+";"
              If Len(FileExt.s) And FindString(LCase(Ext.s),LCase(FileExt),1)
                DirEntries.s(I)=Path.s+Name.s
                I+1
              EndIf
            Else
              ;List files with all extensions
              DirEntries.s(I)=Path.s+Name.s
              I+1
              DirEntries.s(I)=""
            EndIf
          EndIf
        EndIf
      EndIf
    Until FileType=0
  EndIf
  ProcedureReturn I
EndProcedure

Procedure GetAllDirEntries(Path.s,Ext.s,I,N,Dirs,Excl)
  ;Fills in the array DirEntries with directory entries in path
  ;and in subdirectories of path.
  ;Lists all(Ext.s="") or some(Ext.s=".rtf;.htm;" etc.) filetypes.
  ;Includes directories if Dirs=1.
  ;Excludes hidden and system entries if Excl=1.
  If ExamineDirectory(N,Path.s,"*.*")
    Repeat
      WindowEvent()
      FileType=NextDirectoryEntry(N)
      If FileType
        Name.s=DirectoryEntryName(N)
        Attr=DirectoryEntryAttributes(N)
        Incl=1
        If Excl And (Attr&#PB_FileSystem_Hidden)|(Attr&#PB_FileSystem_System)
          ;Hidden or system file, do not include
          Incl=0
        EndIf
        If Incl
          ;Entry attributes ok, entry eligible for inclusion
          If FileType=2
            ;The entry is a directory
            If Name.s<>"." And Name.s<>".."
              ;Open it
              I=GetAllDirEntries(Path.s+Name.s+"\",Ext.s,I,N+1,Dirs,Excl)
              ;Returned,  use the current directory
              ;                   UseDirectory(N)
              If Dirs
                ;Include directory entries
                Shared DirEntries()
                DirEntries.s(I)=Path.s+Name.s+"\"
                I+1
                DirEntries.s(I)=""
              EndIf
            EndIf
          Else
            ;The entry is a file
            If Ext.s
              ;List files with some extensions
              FileExt.s="."+GetExtensionPart(Name.s)+";"
              If Len(FileExt.s) And FindString(LCase(Ext.s),LCase(FileExt),1)
                DirEntries.s(I)=Path.s+Name.s
                I+1
                DirEntries.s(I)=""
              EndIf
            Else
              ;List files with all extensions
              DirEntries.s(I)=Path.s+Name.s
              I+1
              DirEntries.s(I)=""
            EndIf
          EndIf
        EndIf
      EndIf
    Until FileType=0
  EndIf
  ProcedureReturn I
EndProcedure

Procedure GetDirsWithFileTypes(Path.s,Ext.s,Excl)
  ;Fills in the array DirEntries with directory entries in path
  ;that contains filetypes listed in Ext.s(Ext.s=".rtf;.htm;" etc.).
  ;Excludes hidden and system entries if Excl=1.
  If ExamineDirectory(N,Path.s,"*.*")
    Repeat
      FileType=NextDirectoryEntry(n)
      If FileType
        Name.s=DirectoryEntryName(n)
        Attr=DirectoryEntryAttributes(n)
        Incl=1
        If Excl And (Attr&#PB_FileSystem_Hidden)|(Attr&#PB_FileSystem_System)
          ;Hidden or system file, do not include
          Incl=0
        EndIf
        If Incl
          ;Entry attributes ok, entry eligible for inclusion
          If FileType=2
            ;The entry is a directory
            If Name.s<>"." And Name.s<>".."
              ;Open it and look for some filetypes
              If FindFileTypesInDir(Path.s+Name.s+"\",Ext.s,N+1)
                ;Found a filetype in or under it
                Shared DirEntries()
                DirEntries(I)=Path.s+Name.s+"\"
                I+1
                DirEntries.s(I)=""
              EndIf
              
            EndIf
          Else
            ;The entry is a file
            ;Store it ????
          EndIf
        EndIf
      EndIf
    Until FileType=0
  EndIf
  ProcedureReturn I
EndProcedure

Procedure FindFileTypesInDir(Path.s,Ext.s,N)
  ;Searches Path.s recursively and returns 1 if it contains
  ;filetypes listed in Ext.s(Ext.s=".rtf;.htm;" etc.).
  ;Called by GetDirsWithFileTypes() to probe for filetypes.
  If ExamineDirectory(N,Path.s,"")
    Repeat
      FileType=NextDirectoryEntry(n)
      If FileType
        Name.s=DirectoryEntryName(n)
        If FileType=2
          ;The entry is a directory
          If Name.s<>"." And Name.s<>".."
            ;Open it and look for some filetypes
            If FindFileTypesInDir(Path.s+Name.s+"\",Ext.s,N+1)
              ;Found, unwind
              ProcedureReturn 1
            EndIf
            
          EndIf
        Else
          ;The entry is a file
          FileExt.s="."+GetExtensionPart(Name.s)+";"
          If Len(FileExt.s) And FindString(LCase(Ext.s),LCase(FileExt),1)
            ;Found, unwind
            ProcedureReturn 1
          EndIf
        EndIf
      EndIf
    Until FileType=0
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.s GetAppDir()
  ;Returns the current application directory
  AppDir.s=Space(255) 
  GetCurrentDirectory_(255,@AppDir.s)
  If Right(AppDir.s,1)<>"\"
    AppDir.s+"\"
  EndIf
  ProcedureReturn AppDir.s
EndProcedure
;FILESYSTEM PROCEDURES END

;FILESYSTEM PROCEDURES TESTPROGRAM
;CONTROL ID'S
Enumeration
  #IDWinMain
  #IDEdtDir
  #IDBtnBrowse
  #IDLstDir
EndEnumeration

;MAIN WINDOW
Flags=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
OpenWindow(#IDWinMain,0,0,800,400,"File System Procedures",Flags)

;MAIN WINDOW CONTROLS

StringGadget(#IDEdtDir,10,10,710,25,Path.s)
ButtonGadget(#IDBtnBrowse,730,10,60,25,"Browse")
ListViewGadget(#IDLstDir,10,45,780,345)

Path.s=GetAppDir()

;EVENT LOOP
Repeat
  EventID=WaitWindowEvent()
  Select EventID
    Case #PB_Event_CloseWindow
      Exit=1
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #IDBtnBrowse
          Path.s=PathRequester("",Path.s)
          If Path.s
            SetGadgetText(#IDEdtDir,Path.s)
            
            I=0:N=0
            ;           Unrem to test procedure #1
            ;            GetDirEntries(Path.s,"",0,1)
            
            ;           Unrem to test procedure #2
            GetAllDirEntries(Path.s,".txt;.rtf;.htm;.pb;",I,N,0,1)
            
            ;           Unrem to test procedure #3
            ;            GetDirsWithFileTypes(Path.s,".lnk;.url;",1)
            I=0
            While DirEntries.s(I)
              WindowEvent()
              AddGadgetItem(#IDLstDir,-1,DirEntries.s(I))
              I+1
            Wend
            AddGadgetItem(#IDLstDir,-1,Str(I)+" entries found.")
          EndIf
      EndSelect
  EndSelect
Until Exit
End

Posted: Mon May 30, 2005 10:10 pm
by Paul
Certainly not a good idea to use GetCurrentDirectory_() for App path since current directory will change when you start using file commands or requesters.

Use GetModuleFileName_()

Code: Select all

Procedure.s GetAppDir()
  AppDir.s=Space(512)
  GetModuleFileName_(0,@AppDir,512)
  AppDir=GetPathPart(AppDir)
  If Right(AppDir,1)<>"\":AppDir+"\":EndIf
  ProcedureReturn AppDir
EndProcedure

Posted: Mon May 30, 2005 10:46 pm
by utopiomania
Thanks. I use it once here to get to my applications startup folder. What's wrong with that? :?:

Posted: Fri Jun 10, 2005 5:16 pm
by utopiomania
I just found out one thing that I didn't find in the manual. The recursive procedure GetAllDirEntries()
above, and the While DirEntries() ... AddgadgetItem().. in the message loop is so intense they freezes the
gadgets until finished, but inserting a WindowEvent() at the right places in the loops allows them to
update even at 100% CPU! :)

This doesn't allow me to handle messages in the message loop while the procedure runs, but it allows
Windows to update the gadgets involved in real time. Maybe this could be added to the manual, because it
can solve some problems much simpler than using threads to do the same. :?:

Posted: Mon Jun 13, 2005 8:06 pm
by utopiomania
I just finished this, it's supposed to rename files according to a file's filetime and a user supplied format
string accepting a few two character Ucase tokens, and passing nearly everything else on except illegal
characters. :)

Code: Select all

;DECLARATIONS
Declare.s FileTimeToFileName(Path.s,Format.s,When)
Declare.s GetAppDir()


Procedure.s FileTimeToFileName(Path.s,Format.s,When)
  Time.FILETIME
  LocTime.FILETIME
  SysTime.SYSTEMTIME        
  
  Id=ReadFile(0,Path)
  
  Select When
    Case 0 ;Created    
      GetFileTime_(Id,Time,0,0)
    Case 1 ;Accessed
      GetFileTime_(Id,0,Time,0)
    Case 2 ;Modified
      GetFileTime_(Id,0,0,Time)            
  EndSelect
  
  FileTimeToLocalFileTime_(Time,LocTime)
  FileTimeToSystemTime_(LocTime,SysTime)
  CloseFile(0)
  
  For I=1 To Len(Format) Step 2
    Select Mid(Format,I,2)
      Case "YR" ;Year
        Name.s+Right(Str(SysTime\wYear),4)      
      Case "MN" ;Month
        Name.s+Right("0"+Str(SysTime\wMonth),2)
      Case "DY" ;Day
        Name.s+Right("0"+Str(SysTime\wDay),2)
      Case "HR" ;Hour
        Name.s+Right("0"+Str(SysTime\wHour),2)           
      Case "MI" ;Minute
        Name.s+Right("0"+Str(SysTime\wMinute),2)
      Case "SE" ;Second
        Name.s+Right("0"+Str(SysTime\wSecond),2)  
      Case "MS" ;Millisecond
        Name.s+Right("0"+Str(SysTime\wMilliSeconds),2)  
      Default ;Pass on
        If FindString(Chr(34)+"\/*<>|#.",Mid(Format,I,1),1)=0
          Name.s+Mid(Format,I,1)
          I-1          
        EndIf          
    EndSelect
  Next
  Name+"."+GetExtensionPart(Path.s)

  ProcedureReturn LTrim(Name)
EndProcedure


Procedure.s GetAppDir()
  ;Returns the current application directory
  AppDir.s=Space(255)  
  GetCurrentDirectory_(255,@AppDir.s)
  If Right(AppDir.s,1)<>"\"
    AppDir.s+"\"
  EndIf
  ProcedureReturn AppDir.s
EndProcedure


;TEST
Path.s=OpenFileRequester("Pick a filename",GetAppDir(),"",0)

; !
Format.s="..\/<>*#|. YR-MN-DY_HR:MI:SE:MS This is the new filename :) "

MessageRequester(GetFilePart(Path.s),FileTimeToFileName(Path.s,Format.s,0))
End



; IDE Options = PureBasic v3.94 Beta 1 - Windows x86
; EnableXP
; Executable = C:\Programmation\PureBasic\Examples\FileSystem.exe
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited