Recursive Directory 2/

 BBS: Inland Empire Archive
Date: 04-14-92 (16:46)             Number: 79
From: MICHAEL MALLEY               Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: Recursive Directory   2/       Conf: (2) Quik_Bas

>>> Continued from previous message
'--- Sets the level of searching and returns any errors on the first call
Position = 1
ShowTree Spec, Position
SELECT CASE Position
    CASE &H3
        PRINT "Invalid path"
    CASE &H12
        PRINT "No Directories"
END SELECT
END

SUB GetDTA (DTASeg, DTAOff)

Regs.ax = &H2F00
CALL InterruptX(&H21, Regs, Regs)
DTASeg = Regs.es
DTAOff = Regs.bx

END SUB

FUNCTION GetFile$ (Spec$, DTA AS DTAType, FileNames AS INTEGER)

'--- If a pathspec is sent, start with a search for a new file.
IF LEN(Spec$) THEN

    SetDTA VARSEG(DTA), VARPTR(DTA)

    Regs.ax = &H4E00
    Regs.cx = &H10
    IF FileNames THEN Regs.cx = &H6
    '--- QB users use VARSEG
    Regs.ds = SSEG(Spec$)
    Regs.dx = SADD(Spec$)

    CALL InterruptX(&H21, Regs, Regs)

    IF Regs.flags AND 1 THEN
        ErrorLevel = Regs.ax
        EXIT FUNCTION
    END IF

    '--- If the first file returned is a directory, get the name and
    '    find out if it is a valid directory
    IF (ASC(DTA.Attr) AND &H10) = &H10 OR FileNames THEN GOSUB ExtractName
END IF

DO UNTIL ExitFlag
    SetDTA VARSEG(DTA), VARPTR(DTA)

    '--- Try to find another file
    Regs.ax = &H4F00
    CALL InterruptX(&H21, Regs, Regs)

    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
>>> Continued to next message

 * SLMR 2.1a * He's got a magnet!  Everybody BACKUP!!! - Cmdr. Data

--- Maximus 2.01wb
 * Origin: UltraTech - Nashville, TN  (615) 356-0453 {HST} (1:116/30)