Code archives/File Utilities/Filename lister
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
List filenames in named directory to a named text file. | |||||
Const One%=1,Two%=2 Global TextBuffer%,XPels%,YPels% Graphics 640,480,32,2 YPels=FontHeight()-One XPels=GraphicsWidth()-One NoFiles=FileList("C:\","CList.txt",True) End Function FileList(FolderName$,StreamName$,Recurse%) ;Read elapsed millisecs T=MilliSecs() ;Create workspace WorkSpace%=CreateBank(8) ;Create text buffer TextBuffer=CreateImage(XPels+One,YPels+One,Two) ;Ensure empty output file exists StreamNo=WriteFile(StreamName) ;Terminate output file CloseFile StreamNo ;Prepare output file StreamNo=OpenFile(StreamName) ;Descriptors to screen Text 0,0,"Scrutinising directory: " Text 0,40,"Files Found: " ;Switch active buffer to textbuffer SetBuffer ImageBuffer(TextBuffer,False) ;White text Color 255,255,255 FlushFileList(FolderName,StreamNo,Recurse,WorkSpace) ;Calculate time taken TString$=(MilliSecs()-T)/1000. ;Write duration and filecount to file WriteLine StreamNo,PeekInt(WorkSpace,False)+" files found in "+TString$+" seconds" ;Terminate file CloseFile StreamNo ;Free textbuffer FreeImage TextWindow FreeBank WorkSpace End Function Function FlushFileList(FolderName$,StreamNo%,Recurse%,WorkSpace%) ; V1.1 ;-------------------------------------------------------- ;Output list of files from named directory to named file. ;-------------------------------------------------------- ;Prepare folder for read ThisFolder=ReadDir(FolderName) ;If a valid file Handle was obtained If ThisFolder ;Update screen ;Initialise text CopyRect False,False,XPels,YPels,False,False,ImageBuffer(TextBuffer,One) ;Apply text Text 0,0,FolderName ;Update screen CopyRect False,False,XPels,YPels,False,20,ImageBuffer(TextBuffer,False),FrontBuffer() ;Iterate files Repeat ;Enquire next filename FileName$=NextFile(ThisFolder) ;Ensure a name returned otherwise exit loop If Len(FileName) ;Determine - subdirectory name or a file? Select FileType(FolderName+FileName) Case One PokeInt WorkSpace,False,PeekInt(WorkSpace,False)+One ;Update screen CopyRect False,False,XPels,YPels,False,False,ImageBuffer(TextBuffer,One) Text False,False,PeekInt(WorkSpace,False) CopyRect False,False,XPels,YPels,100,40,ImageBuffer(TextBuffer,False),FrontBuffer() ;Its a valid name - Add to file WriteLine StreamNo,FolderName+FileName ;Update screen CopyRect False,False,XPels,YPels,False,False,ImageBuffer(TextBuffer,One) Text False,False,FileName CopyRect False,False,XPels,YPels,False,60,ImageBuffer(TextBuffer,False),FrontBuffer() Case Two ;Its a directory Select FileName Case ".",".." ;Ignore these (means dir (where we are) and parent dir (in which we are)) Default ;Recurse with subdirectory name If Recurse Then FlushFileList(FolderName+FileName+"\",StreamNo,Recurse,WorkSpace) End Select End Select Else Exit End If Forever ;Terminate directory commitment CloseDir ThisFolder End If End Function |
Comments
None.
Code Archives Forum