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