Directory Search Function
This is a reusable function (with demonstration program)which can be used in your program, or even modified to fit your needs. The function uses a recursive call into itself to catalog a directory tree up and down. Here is the details of the function - which appears part way down the page:
Function FileTree(MaxEntries, CurrentEntry, CurrentLevel, Path$, txLen, Tree, Subdirs, SortKey)
About FileTree:
Function returns an formatted string array containing the directory and file tree from the specified path and down (optional)
Prerequisites:
Requires that programmer setup an string array named FileTree$(x) to hold the formatted result of the FileTree function. It also requires a two dimensioned string array named Finfo$(10,3) to hold the results of the files statements. Arrays are global so they are not passed into the function.
Arguments:
Return Value:
The function returns the latest entry that a value was written into. If after calling the function it returns with zero you know that no files or subdirectories exist.
'** FileTree Demonstration 'demonstrate the files command 'first predimension the array we need Dim Finfo$(10,3) Dim FileTree$(2000) MaxEntries = 1999 ForegroundColor$ = "Black" BackgroundColor$ = "Buttonface" TexteditorColor$ = "White" TextboxColor$ = "White" ComboboxColor$ = "White" ListboxColor$ = "White" 'NoMainWin WindowWidth = 411 : WindowHeight = 480 UpperLeftX = Int((DisplayWidth-WindowWidth)/2) UpperLeftY = Int((DisplayHeight-WindowHeight)/2) Groupbox #main.gbx1, "", 10, 395, 380, 10 Button #main.browse, "Browse...",[browse],UL, 322, 10, 70, 23 Button #main.files, "Get Files",[files],UL, 150, 415, 100, 25 Button #main.about, "About",[about],UL, 10, 415, 100, 25 Button #main.quit, "Exit",[quit],UL, 290, 415, 100, 25 Textbox #main.tbx, 10, 10, 310, 24 Texteditor #main.tEd, 10, 40, 380, 350 Open "FileTree Demonstration" For Window As #main Print #main, "trapclose [quit]" Print #main, "font ms_sans_serif 10" Print #main.tEd, "!font Courier_New 9" #main.tbx "Enter path or click Browse to select path" 'I added these lines to remove the edit menu 'that the texteditor automatically puts into the menu. hMain=hWnd(#main) hMainMenu=GetMenu(hMain) hMainEdit=GetSubMenu(hMainMenu,0) result=RemoveMenu(hMainMenu,hMainEdit) Call DrawMenuBar hWnd(#main) [loop] Wait [quit] Close #main End [browse] Folder$ = BrowseFolders$() If Folder$ <> "" Then Print Folder$ #main.tbx Folder$ Else #main.tbx "Enter path or click Browse to select path" End If GoTo [loop] [files] 'Get the path from the textbox #main.tbx, "!contents? Path$"; If Instr(Path$,":\") = 0 Then Notice "Error!" + Chr$(13) + "A file path is required" GoTo [loop] Else #main.tEd "!cls" 'FileTree(MaxEntries, CurrentEntry, CurrentLevel, Path$, txLen, Tree, Subdirs, SortKey) Entries = FileTree(MaxEntries, 0, 0, Path$, 24, 1, 1, 1) If Entries > 0 Then For x = 1 to Entries 'I learned the hard way to pad my output with a leading space in case any filenames 'begin with a "!" - which LB interprets as a command - and it looks better too #main.tEd " " + FileTree$(x) + Chr$(13); Next x Print #main.tEd, "!origin 0 0"; End If GoTo [loop] [about] CallDLL #user32, "MessageBeep", _MB_ICONINFORMATION As long, beepResult As boolean mbflags = _MB_ICONINFORMATION OR _MB_OK message$ = "Directory Tree - written by Brad Moore, copyright 2002, all rights reserved. " + _ "Thanks For your interest. This program demonstrates the FileTree function " + _ "for which I am the author. FileTree will recursively traverse the directory structure " + _ "beginning at the specified path and return a string array or sub directories " + _ "and files. There are several options that give the function greater " + _ "functionality. Read the function help in the basic source code for details. " + _ "Use of this program and the function is granted without requirement of notice, " + _ "royalty or credit. You may incorporate this Function or the program into your " + _ "code and use as desired. Please do not distribute as is without obtaining " + _ "permission. - Thanks Alyce and Laz for the portions I have lifted from your work. Brad." calldll #user32, "MessageBoxA", _ 0 As long, _ message$ As ptr, _ "About Directory Tree" As ptr, _ mbflags As long, _ mbResult As long 'mbResult CODES: 1=ok 2=cancel 3=abort 4=retry 5=ignore 6=yes 7=no GoTo [loop] ' -=-=-=-=-=-=-=-=-=-=- Functions -=-=-=-=-=-=-=-=-=-=-=- Function FileTree(MaxEntries, CurrentEntry, CurrentLevel, Path$, txLen, Tree, Subdirs, SortKey) 'About FileTree: '--------------- 'Function returns an formatted string array containing the directory ' and file tree from the specified path and down (optional) ' 'Prerequisites: '------------- 'Requires that programmer setup an string array named FileTree$(x) to hold ' the formatted result of the FileTree function. It also requires a two ' dimensioned string array named Finfo$(10,3) to hold the results of the ' files statements. Arrays are global so they are not passed into the ' function. ' 'Arguments: '---------- 'MaxEntries is the maximum number of entries permitted in the array ' FileTree$(x). It is the value of x, the size of array. 'CurrentEntry is the current element in the array that was LAST ' populated. It is used as a pointer to load the next array element. ' When the function is first called this value is zero. 'CurrentLevel is the relative level in the directory structure ' that we are at compared with the original level called - ' this is always set to zero when the function is called. 'Path$ is the directory path to the directory we are creating ' a tree for. 'txLen is the value representing the number of MAX characters filename ' strings can hold. The default (if zero is passed) is 15 'Tree and Subdirs are both Boolean switches. Set Tree = 1 if you ' want the function to traverse the whole directory tree (i.e. list ' all files in directory and subdirectories). Any other value will ' disable this feature. ' Set Subdirs = 1 if you want the function to print subdirectry names ' along with the filenames. Any other value will disable this feature. 'SortKey is used to specify whether to sort files by name or size. Set to ' value of 1 to sort by name, any other value will cause a sort by size. ' 'Return Value: '------------- 'The function returns the latest entry that a value was written ' into. If after calling the function it returns with zero you ' know that no files or subdirectories exist. 'Make sure that the value passed for txLen is adequate If txLen = 0 Then txLen = 15 'First check for grievious errors If Path$ = "" or MaxEntries = 0 Then 'We are done - can't go on FileTree$(1) = "Error - Path is blank, or MaxEntries = 0: Can't continue" CurrentEntry = 1 Else 'Now make sure we have not exceeded the MaxEntries Value If CurrentEntry + 3 < MaxEntries Then 'Print the Directory Heading FileTree$(CurrentEntry+1) = Left$(Path$, txLen+40) FileTree$(CurrentEntry+2) = "--------------------------------------------------" CurrentEntry = CurrentEntry + 3 'get the file info and stick it into the Finfo array Files Path$, "*.*", Finfo$() 'items in Finfo$(0,?) - now have information we can use qtyFiles = Val(Finfo$(0, 0)) qtySubDirs = Val(Finfo$(0, 1)) 'If we have elected to include subdirs then sort & print them first If Subdirs = 1 and qtySubDirs > 0 Then 'here we sort the subdirectories in the array by name Sort Finfo$(), qtyFiles+1, qtyFiles+qtySubDirs, 0 For z = qtyFiles + 1 to qtyFiles + qtySubDirs FileTree$(CurrentEntry) = Left$("..\" + Finfo$(z, 1) + "\" + Space$(txLen+6),txLen + 6) + _ " directory" 'Insure there is room for the next entry CurrentEntry = CurrentEntry + 1 If CurrentEntry >= MaxEntries Then Exit For Next z End If 'Now we will process the files on this level (of recursion) If qtyFiles > 0 Then 'reformat the file info (pad the file size so that sizes are right aligned) For x = 1 to qtyFiles Finfo$(x, 1) = Right$(" " + Finfo$(x, 1), 9) Next x 'Check Sort Key indicatior and sort files by name or by size If SortKey = 1 Then '1 = sort by name 'now sort the files in the array by name '(Last argument in Sort command is sort field: 0 = Name, 1 = size) Sort Finfo$(), qtyFiles, 1, 0 Else 'Any other value = sort by size 'now sort the files in the array by size '(Last argument in Sort command is sort field: 0 = Name, 1 = size) Sort Finfo$(), 1, qtyFiles, 1 End If 'now add the file information to the FileTree$ array For x = qtyFiles to 1 step -1 kbyte$ = Using("#####.#",(Val(Finfo$(x, 1))/1000)) FileTree$(CurrentEntry) = Left$(Finfo$(x, 0) + Space$(txLen), txLen+1) + _ " "; kbyte$; " kb "; Finfo$(x, 2) 'Insure there is room for the next entry CurrentEntry = CurrentEntry + 1 If CurrentEntry >= MaxEntries Then Exit For Next x End If 'Recurse any subdirectories if there are any and if Tree flag is set to one. If qtySubDirs > 0 and Tree = 1 Then 'We will plan to recurse for each sub-directory 'Unfortunatly the array with our subdirectories does 'not withstand recursion, so we must track our current 'endicy and also rebuild the array Finfo$ each time 'we return from a recursive call x = 1 'Unfortunately control loops (FOR-NEXT and WHILE-WEND) do not 'perserve thier control information after recursion - must use 'explicit looping [FileTree.Loop] 'Rebuild the array Finfo$: 'get the file info and stick it into the Finfo array Files Path$, "*.*", Finfo$() 'items in Finfo$(0,?) now have information we can use qtyFiles = Val(Finfo$(0, 0)) qtySubDirs = Val(Finfo$(0, 1)) 'now sort the subdirectories in the array by name '(Last element is Sort Field 0 = Name, 1 = size) Sort Finfo$(), qtyFiles+1, qtyFiles+qtySubDirs, 0 'Build the new path to pass (Make sure it path ends in path delimiter 'before appending next layer path) If Right$(Path$,1) <> "\" Then Path$ = Path$ + "\" NewPath$ = Path$ + Finfo$(x+qtyFiles,1) + "\" 'call FileTree recursively CurrentEntry = FileTree(MaxEntries, CurrentEntry, _ CurrentLevel+1, NewPath$, txLen, Tree, Subdirs, SortKey) 'increment our counter that tracks which endicy we are on... x = x + 1 If x <= qtySubDirs AND CurrentEntry+5 < MaxEntries Then GoTo [FileTree.Loop] End If End If End If FileTree = CurrentEntry End Function 'function and sub programs to support removing the edit menu 'from the window's menu. The calls are coutesy Alyce Watson Sub DrawMenuBar hWnd CallDLL #user32, "DrawMenuBar",_ hWnd As long, r As boolean End Sub Function GetSubMenu(hMenuBar,nPos) CallDLL #user32, "GetSubMenu",_ hMenuBar As long, nPos As long,_ GetSubMenu As long End Function Function GetMenu(hWnd) CallDLL #user32, "GetMenu",hWnd As long,_ GetMenu As long End Function Function RemoveMenu(hMenu,hSubMenu) CallDLL #user32, "RemoveMenu", hMenu As long,_ hSubMenu As long, _MF_BYCOMMAND As long,_ RemoveMenu As boolean End Function 'The following Function is courtesy Lazman (with help from Alyce) 'It opens a system window and allows the use to search for and select a 'folder, not a file like what is possible with the FILEDIALOG command Function BrowseFolders$() struct BrowseInfo, _ hWnd As long, _ Root As long, _ DName$ As ptr, _ 'max path Title$ As ptr, _ 'null terminated Flags As long, _ lpfn As long, _ 'null lParam As long, _ 'null iImage As long CallDLL #shell32, "SHBrowseForFolder", _ BrowseInfo As struct, _ ID As long Path$ = Space$(256)+Chr$(0) CallDLL #shell32, "SHGetPathFromIDList", _ ID As long, _ Path$ As ptr, _ ret As boolean Open "ole32.dll" For DLL As #ole32 CallDLL #ole32, "CoTaskMemFree", _ ID As long, _ ret As void Close #ole32 BrowseFolders$ = Trim$(Path$) End Function