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