Re: DIR$ Help 2/

 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 =
    END IF

    '--- Same tests as above.
    IF (ASC(DTA.Attr) AND &H10) = &H10 OR FileNames THEN GOSUB ExtractName

GetFile = Directory$

    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

SUB SetDTA (Segment, Offset) = &H1A00
Regs.ds = Segment
Regs.dx = Offset
CALL interrupt(&H21, Regs, Regs)

SUB ShowTree (PathSpec$, Position AS INTEGER)

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
    Column = ((Position - 1) * 2) + 1
        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$
            '--- 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

    '--- 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
        KeyStroke = INKEY$
        IF LEN(KeyStroke) THEN
            IF ASC(KeyStroke) = 3 THEN END
            EXIT DO
        END IF

    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

  --------------------------[ 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)
Outer Court
Echo Basic Postings

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