Download text file
$IF 0
---------------------------- PowerBASIC/cc v1.0
---| DASoft |------------------------------------------
---------------------------- Public Domain DATE: 1998-10-25
| FILE NAME fDirTree.bas | code by
| DIRECTORY NB1cc | Don Schullian, Jr
---------------------------- www.DASoftVSS.com
PURPOSE: CREATE & maintain X-Tree list for a given drive
PARMAS: Tree$() the array to hold the items
Item& the element number TO be worked
Indent& either 1 OR 2 spaces indentation for each level
Drive$ the drive letter TO be X-Treed "C:\Whatever Is Fine"
RETURNS: SEE: individual functions
-------------------------------------------------------------------------
Hi,
There are 4 functions in this set that you'll require and one that is for
the exclusive use of fDirTree:
fDirTree - creates the working string elements for the list
RETURN: the number of items in the list
fDirTreePath - create a full path given an element number
RETURN: the full path name eg: "C:\MyDirectory\Data\"
fDirTreeFind - find the element number given a full path
RETURN: the element number for a path
DirTreeExpand - expands and collapses the individual subs
sets bytes 1 and 4 for each element
DirTreeGet - this is a 'local' sub and can only be called by fDirTree
PBMAIN is used as the menu function and shows how the tree can be displayed
and manipulated. It is meant as a guide and not a final product. In fact, it's
kind'a rough but it works (most of the time;) and it _IS_ test code.
The following code will build an X-tree list FOR a given drive. The current
drive is set to 'C' so if you don't want to do 'C' then change it in the
call to fDirTree.
Use this code as you will but I'd like to hear from you pro or con.
C'ya,
Don
d83@DASoftVSS.com
$ENDIF
$INCLUDE "WIN32API.INC"
TYPE DirTreeTYPE
Visible AS BYTE ' T/F if the item is visible
Level AS BYTE ' depth of directory 0 = root 1 = directory 2+ = sub dir
Offset AS BYTE ' offsett to start of actual directory string
Expanded AS BYTE ' T/F if item is expanded
END TYPE
DECLARE FUNCTION fDirTree (Tree() AS STRING,BYVAL Drive AS STRING,BYVAL Indent AS LONG) AS LONG
DECLARE FUNCTION fDirTreePath (Tree() AS STRING,BYVAL Item AS LONG) AS STRING
DECLARE SUB DirTreeExpand (Tree() AS STRING,BYVAL Item AS LONG,BYVAL LastItem AS LONG)
DECLARE FUNCTION fDirTreeFind (Tree() AS STRING,BYVAL Path AS STRING) AS LONG
DECLARE SUB DirTreeGet (Tree() AS STRING,tDT() AS DirTreeTYPE,DirCount AS LONG,MaxDirs AS LONG)
'
'----------------------------------------------------------------------------------------
'------------ START OF TEST CODE ------------------------------------------------------
'----------------------------------------------------------------------------------------
'
FUNCTION PBMAIN ()
LOCAL Button AS LONG
LOCAL Display AS STRING * 36
LOCAL FoS AS LONG
LOCAL Item AS LONG
LOCAL Last AS LONG
LOCAL LastDir AS LONG
LOCAL LoS AS LONG
LOCAL OldFoS AS LONG
LOCAL Row AS LONG
LOCAL Temp AS STRING * 39
DIM Tree (100) AS STRING ' our list of dirs
LastDir = fDirTree(Tree(),"C",2) ' you set the drive here
DIM Menu(LastDir) AS LONG ' create a pointer array
' for visible items
COLOR 15, 0 ' build the display screen
LOCATE 1, 9 : PRINT "Click here to move list."; '
LOCATE 13, 42 : PRINT "Click out here to end"; '
LOCATE 25, 9 : PRINT "Click here to move list."; '
COLOR 1, 15 '
LOCATE 2, 1 '
PRINT CHR$(218) + STRING$(36,196) + CHR$(191) '
FOR Row = 1 TO 21 '
PRINT CHR$(179) & SPACE$(36) & CHR$(179) '
NEXT '
PRINT CHR$(192) + STRING$(36,196) + CHR$(217) '
'
MOUSE 3, UP ' ready the mouse
MOUSE ON ' let the rodent run!
FoS = 1 ' first item # visable
LoS = 1 ' Last possible first item
DO ' menu loop
FoS = MIN(LoS,MAX(1,FoS)) ' keep FoS within bounds
IF Last = 0 THEN ' if we need to recount
FOR Item = 1 TO LastDir ' visible items
IF ASC(Tree(Item)) THEN '
INCR Last '
Menu(Last) = Item '
END IF '
NEXT '
LoS = MAX(1,Last - 20) ' reset last-first item
FoS = MIN(FoS,LoS) ' keep FoS in bounds
OldFoS = 0 ' force a reprint
END IF '
IF FoS <> OldFoS THEN ' if we need to reprint
Item = FoS ' 1st visible item
FOR Row = 3 TO 23 ' 21 rows all tolled
IF Item =< Last THEN ' if still in the list
Display = MID$(Tree(Menu(Item)),5) ' show only 'tree' stuff
ELSE ' else
Display = "" ' clear the line
END IF '
INCR Item ' next item #
LOCATE Row, 2 ' print the stuff
PRINT Display '
NEXT '
INPUT FLUSH ' clear mouse
END IF '
Button = ASC(WAITKEY$,4) ' get rodent stuff
IF Button < 1 THEN ITERATE ' hay! no keyboard here!
IF MOUSEY < 3 THEN ' scroll down
IF Button = 2 THEN FoS = FoS + 20 ELSE INCR FoS '
ELSEIF MOUSEY > 23 THEN ' scroll up
IF Button = 2 THEN FoS = FoS - 20 ELSE DECR FoS '
ELSEIF MOUSEX > 40 THEN ' all done!
EXIT LOOP '
ELSEIF MOUSEX < 40 THEN ' expand/collapse item
Item = Menu( MOUSEY + Fos - 3 ) ' get item number
Temp = fDirTreePath(Tree(),Item) ' get whole path
LOCATE 1, 41 : PRINT Temp; ' display most of it
Last = fDirTreeFind(Tree(),Temp) ' test fDirTreeFind
LOCATE 2, 41 : PRINT Last, Item ' the nbrs should be equal
DirTreeExpand Tree(), Item, LastDir ' call routine
Last = 0 ' force recount
END IF '
LOOP '
MOUSE OFF ' bye Mick
COLOR 7, 0 '
CLS '
END FUNCTION
'
'----------------------------------------------------------------------------------------
'------------ END OF TEST CODE -------------------------------------------------------
'----------------------------------------------------------------------------------------
'
FUNCTION fDirTree ( Tree() AS STRING, _
BYVAL Drive AS STRING, _
BYVAL Indent AS LONG ) AS LONG
DIM EndLevel AS STRING
DIM L AS LONG
DIM LastDir AS LONG
DIM NextLevel AS LONG
DIM NoKids AS STRING
DIM P AS LONG
DIM Spacer AS STRING
DIM Spcr AS STRING
DIM WithKids AS STRING
DIM X AS LONG
X = UBOUND(Tree(1)) '
DIM tDT(X) AS DirTreeTYPE '
'
tDT (1).Level = 0 'starting level
tDT (1).Visible = 1 'always visable
tDT (1).Offset = 5 '
tDT (1).Expanded = 1 ' always expanded
Tree(1) = UCASE$(LEFT$(Drive,1)) + ":\" 'root directory
LastDir = 1 'gotta start somewhere
Indent = MAX(2,MIN(1,Indent)) '1 or 2 no less, no more
WithKids = LEFT$(CHR$(043,196),Indent) 'plus sign
NoKids = LEFT$(CHR$(195,196),Indent) 'left bottom corner
Spacer = LEFT$(CHR$(179,032),Indent) 'vertical line
EndLevel = LEFT$(CHR$(192,196),Indent) 'left cross member
'
DirTreeGet Tree(), tDT(), LastDir, X 'load the directories
ARRAY SORT Tree(1) FOR LastDir, COLLATE UCASE, TAGARRAY tDT() 'sort the whole thing
'
FOR X = LastDir TO 2 STEP -1 'add tree stuff
Spcr = REPEAT$(tDT(X).Level,Spacer) ' create spacer to length
P = ( ( tDT(X).Level - 1 ) * Indent ) + 1 ' where to put other goodies
NextLevel = tDT(X+1).Level ' level of next dir item
SELECT CASE tDT(X).Level ' put other goodies
CASE = NextLevel '
MID$(Spcr,P,Indent) = NoKids ' no sub dirs under here
CASE > NextLevel '
MID$(Spcr,P,Indent) = EndLevel ' no sub dirs this level
CASE ELSE '
MID$(Spcr,P,Indent) = WithKids ' this one has sub dirs
NextLevel = LastDir ' set flag to last dir item
FOR L = X+1 TO LastDir ' check if this is last sub
IF tDT(L).Level = tDT(X).Level THEN EXIT SELECT ' another sub in this level
IF tDT(L).Level < tDT(X).Level THEN ' last sub in this level
NextLevel = L - 1 '
EXIT FOR '
END IF '
NEXT '
FOR L = X + 1 TO NextLevel ' replace all vert lines down
ASC(Tree(L),P+4) = 32 ' to next prev level
NEXT '
END SELECT '
tDT(X).Visible = CBYT(tDT(X).Level = 1 ) '
tDT(X).Offset = LEN(Spcr) + 5 '
Tree(X) = PARSE$(Tree(X),"\",tDT(X).Level+1) ' cut out last dir item
Tree(X) = tDT(X) & Spcr & Tree(X) ' create dir item package
NEXT '
Tree(1) = tDT(1) & Tree(1) '
'
FUNCTION = LastDir 'RETURN item count
END FUNCTION
'
'----------------------------------------------------------------------------------------
'
FUNCTION fDirTreeFind( Tree() AS STRING,BYVAL Path AS STRING ) AS LONG
LOCAL tDT AS DirTreeTYPE
LOCAL Delim AS STRING
LOCAL Found AS LONG
LOCAL LastDir AS LONG
LOCAL Pce AS LONG
LOCAL Pieces AS LONG
LOCAL Start AS LONG
LOCAL SubDir AS STRING
LastDir = UBOUND(Tree(1)) 'end of the road
Delim = CHR$(92) 'lookin' for "\"
Path = RTRIM$(Path,ANY CHR$(32,92)) 'trim things down to size
Path = UCASE$(Path) 'ucase it
Pieces = PARSECOUNT(Path,Delim) 'number of depths
Start = 2 'start here (assume drive ok)
'
IF Pieces < 2 THEN EXIT FUNCTION ' oops! drive only
'
FOR Pce = 2 TO Pieces ' start lookin'
SubDir = PARSE$(Path,Delim,Pce) ' cut out this directory
LSET tDT = Tree(Start) ' load goodies
ARRAY SCAN Tree(Start), FROM tDT.Offset TO 256, _ ' find a match
COLLATE UCASE, = SubDir, TO Found '
IF Found = 0 THEN EXIT FUNCTION ' nope... no match, bye!
Start = Start + Found - 1 ' new element number
IF Pce = Pieces THEN EXIT FOR ' all done!
DO ' look for next level
INCR Start ' start with next item
IF Start => LastDir THEN EXIT FUNCTION ' past the end of the array
SELECT CASE ASC(Tree(Start),2) ' next element's level
CASE < tDT.Level : EXIT FUNCTION ' went back up a level
CASE > tDT.Level : EXIT LOOP ' went down a level
END SELECT '
LOOP '
NEXT '
'
FUNCTION = Start 'RETURN element number
END FUNCTION
'
'----------------------------------------------------------------------------------------
'
FUNCTION fDirTreePath (Tree() AS STRING,BYVAL Item AS LONG) AS STRING
LOCAL tDT AS DirTreeTYPE
LOCAL Ofs AS LONG
LOCAL Path AS STRING
LSET tDT = Tree(Item) ' get the goodies
IF tDT.Level > 0 THEN ' if not root directory
Path = MID$(Tree(Item),tDT.Offset) & "\" ' start building path
WHILE tDT.Level > 1 ' while a sub dir
DECR Item ' previous item #
IF ASC(Tree(Item),2) < tDT.Level THEN ' if not next level up
Ofs = ASC(Tree(Item),3) ' offset to path info
Path = MID$(Tree(Item),Ofs) & "\" & Path ' add new dir to Path
DECR tDT.Level ' previous level
END IF '
WEND '
END IF '
'
FUNCTION = MID$(Tree(1),5) & Path ' add the root & RETURN
END FUNCTION
'
'----------------------------------------------------------------------------------------
'
SUB DirTreeExpand ( Tree() AS STRING, BYVAL Item AS LONG, BYVAL LastItem AS LONG )
LOCAL tDT AS DirTreeTYPE
LOCAL NextItem AS LONG
LOCAL P AS LONG
IF ( Item = 1 ) OR _ 'can't do anything with these 2
( Item = LastItem ) THEN EXIT SUB '
'
LSET tDT = Tree(Item) 'load the starting goodies
NextItem = (Item + 1) '
IF ASC(Tree(NextItem),2) =< tDT.Level THEN EXIT SUB 'this sub has no kid!
P = INSTR(Tree(Item),ANY CHR$(43,195,192)) 'position of + or corner
'
BIT TOGGLE tDT.Expanded, 0 'switch the expanded state
ASC(Tree(Item),4) = tDT.Expanded 'set expanded state
'
IF ISTRUE tDT.Expanded THEN 'expand
IF ASC(Tree(NextItem),P) = 32 THEN ' last item of level
ASC(Tree(Item),P) = 192 ' put the bottom left corner
ELSE ' else
ASC(Tree(Item),P) = 195 ' put the left cross
END IF '
INCR tDT.Level ' testing for next level
FOR Item = NextItem TO LastItem ' start testing
SELECT CASE ASC(Tree(Item),2) '
CASE < tDT.Level : EXIT FOR ' all done
CASE = tDT.Level : ASC(Tree(Item),1) = 1 ' set 'seen' flag
END SELECT '
NEXT '
ELSE 'collapse
ASC(Tree(Item),P) = 43 ' put the + sign again
FOR Item = NextItem TO LastItem ' start testing
SELECT CASE ASC(Tree(Item),2) ' test level of this sub
CASE = tDT.Level ' we're all done
EXIT FOR '
CASE > tDT.Level '
ASC(Tree(Item),1) = 0 ' reset 'seen' flag
IF ASC(Tree(Item),4) THEN ' if this sub is expanded
DirTreeExpand Tree(), Item, LastItem ' then collapse it
END IF '
END SELECT '
NEXT '
END IF '
END SUB
'
'----------------------------------------------------------------------------------------
'
SUB DirTreeGet (Tree() AS STRING , _
tDT () AS DirTreeTYPE, _
LastDir AS LONG , _
MaxDirs AS LONG )
LOCAL tDTA AS WIN32_FIND_DATA
LOCAL Hndl AS LONG
LOCAL Level AS LONG
LOCAL Mom AS LONG
LOCAL zPath AS ASCIIZ * 256
zPath = Tree(LastDir) & "*.*" ' new directory mask
Hndl = FindFirstFile( zPath, tDTA ) ' object handle
IF ISFALSE Hndl THEN EXIT SUB ' nothing this directory
' -----------------------
Mom = LastDir ' incoming directory item
Level = tDT(LastDir).Level + 1 ' this level
'
DO '
IF ISFALSE BIT(tDTA.dwFileAttributes, 4) THEN ITERATE ' if it's not a directory
IF ASC(tDTA.cFileName) = 46 THEN ITERATE ' if it's ".." or "."
'-----------------------------------------------------------'
INCR LastDir ' next array element
IF LastDir > MaxDirs THEN ' if past end of array
MaxDirs = MaxDirs + 50 ' add 50 new elements
REDIM PRESERVE Tree (MaxDirs) '
REDIM PRESERVE tDT (MaxDirs) '
END IF '
tDT (LastDir).Level = Level ' store the depth level
Tree(LastDir) = Tree(Mom) & tDTA.cFileName & "\" ' store d:\path\path
DirTreeGet Tree(), tDT(), LastDir, MaxDirs ' see if there are any kids
'-----------------------------------------------------------'
LOOP UNTIL ISFALSE FindNextFile(Hndl,tDTA) ' get next item
'
FindClose Hndl ' close object
END SUB