BBS: Inland Empire Archive Date: 07-19-92 (07:19) Number: 55 From: MICHAEL MALLEY Refer#: NONE To: BOB SEWELL Recvd: NO Subj: Re: DIR$ Help 2/ Conf: (2) Quik_Bas
>>> Continued from previous message
IF Regs.flags AND 1 THEN
ErrorLevel = Regs.ax
EXIT FUNCTION
END IF
'--- Same tests as above.
IF (ASC(DTA.Attr) AND &H10) = &H10 OR FileNames THEN GOSUB ExtractName
LOOP
GetFile = Directory$
EXIT FUNCTION
ExtractName:
Directory$ = LEFT$(DTA.Name, INSTR(DTA.Name, CHR$(0)) - 1)
'--- If the directory returned is not the current, ".", or the
' parent, "..", we can stop searching. If we returned either
' of these, the search would never stop.
IF ASC(Directory$) <> 46 OR FileNames THEN ExitFlag = True
RETURN
END FUNCTION
SUB SetDTA (Segment, Offset)
Regs.ax = &H1A00
Regs.ds = Segment
Regs.dx = Offset
CALL interrupt(&H21, Regs, Regs)
END SUB
SUB ShowTree (PathSpec$, Position AS INTEGER)
DIM DTA AS DTAType
Directory$ = GetFile((PathSpec$ + "\*.*" + CHR$(0)), DTA, False)
FirstTime = True
IF ErrorLevel THEN
'--- If an error occurs here and we are on our first level, something
' was wrong with the pathspec, or there are simply no directories.
IF ShowFiles AND ErrorLevel <> 3 THEN
Column = ((Position - 2) * 2) + 2
GOSUB ListFiles
END IF
IF Position = 1 THEN Position = ErrorLevel
ErrorLevel = ErrorLevel XOR ErrorLevel
ELSE
Column = ((Position - 1) * 2) + 1
DO
IF Position > 1 AND NOT FirstTime THEN GOSUB DrawTree
'--- Attempt to get another directory
NewDirectory$ = GetFile("", DTA, False)
'--- Due to the way the last graphic character on a Position must
' be drawn, either ASCII 195 or 192, it must be known whether
' or not there is another subdirectory before you can call
' ShowTree again. This insures that you don't have any false
' nests when there are no more subdirectories.
IF ErrorLevel = 0 THEN
'If there is one, set the Position flag and call ShowTree
MID$(Levels, Position) = CHR$(1)
IF ShowFiles AND FirstTime THEN
GOSUB ListFiles
GOSUB DrawTree
ELSEIF NOT ShowFiles THEN
GOSUB DrawTree
END IF
PRINT TAB(Column); CHR$(195); CHR$(196); Directory$
ShowTree PathSpec$ + "\" + Directory$, Position + 1
SWAP Directory$, NewDirectory$
ELSE
'--- When this section occurs, it means there are no more
' subdirectories at this level of nesting. Control is
' returned to either the previous level of ShowTree, or
' the main module after checking for further nested
' directories.
IF ShowFiles AND FirstTime THEN
MID$(Levels, Position) = CHR$(1)
GOSUB ListFiles
FirstTime = True
END IF
ErrorLevel = ErrorLevel XOR ErrorLevel
MID$(Levels, Position) = CHR$(ErrorLevel)
IF NOT ShowFiles OR FirstTime THEN GOSUB DrawTree
PRINT TAB(Column); CHR$(192); STRING$(1, 196); Directory$
ExitFlag = True
ShowTree PathSpec$ + "\" + Directory$, Position + 1
END IF
LOOP UNTIL ExitFlag
END IF
EXIT SUB
DrawTree:
'--- This method of drawing the tree will allow for all nested
' levels of subdirectories, up the the DOS maximum of 32, to
' be shown on the screen without the screen wrapping and
' extra carraige returns that TREE.COM does. It also shows
' all directories graphically which is better than the way
' PC Tools handles it.
'--- Allow user termination by looking for <CTRL>+C
DO
KeyStroke = INKEY$
IF LEN(KeyStroke) THEN
IF ASC(KeyStroke) = 3 THEN END
ELSE
EXIT DO
END IF
LOOP
FOR Counter = 1 TO Position - 1
'--- Use TAB instead of LOCATE so device redirection works
PRINT TAB(((Counter - 1) * 2) + 1);
IF ASC(MID$(Levels, Counter, 1)) THEN PRINT CHR$(179);
NEXT Counter
RETURN
--------------------------[ End Code ]---------------------
* SLMR 2.1a * I am the terror that posts in the night!
--- Maximus 2.00
* Origin: The Line Source BBS, Maximus [CBCS] (717)236-1375) (1:270/116)

Books at Amazon:
Back to BASIC: The History, Corruption, and Future of the Language
Hackers: Heroes of the Computer Revolution (including Tiny BASIC)
Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution
The Advent of the Algorithm: The Idea that Rules the World
Moths in the Machine: The Power and Perils of Programming
Mastering Visual Basic .NET