GETTREE.BAS 1/2 (All QB

 BBS: Inland Empire Archive
Date: 12-01-92 (05:15)             Number: 343
From: JERRY ALDRICH                Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: GETTREE.BAS 1/2  (All QB       Conf: (2) Quik_Bas

Howdy,

Yesterday, I found myself in need of a routine to read and display the
directory tree in QB (actually PDS 7.1).  I scanned the echo and found
there was a discussion going on about how to do just that.  Seemed to
be 2 answers, get a LIB, and use SHELL "DIR > DIR.TXT".  Since I didn't
want to go searching for a lib, I tried the latter.  Basically, I modified
the WHEREIS program to look for directories instead of files.  It worked,
but it was also SLOWWWW!  On a 386sx/16 with a 15ms IDE drive and 176
directories, it took 97 seconds (compiled) to do the scan.  I KNEW there
had the be a better way!  I put some thought into it, and the following
code developed.  It will NOT work on a Mono system, due to the fact it
uses 2 video pages, but it works just fine with color.  The resulting
program will scan the same drive in 16.7 Seconds (compiled) or 19.5
seconds in the environment.  And it's ALL QB code!  Here 'tis:

------------------------------ CUT HERE -----------------------------------
DECLARE SUB GetDirs (Path$, Level%)
DECLARE SUB ShowTree ()
DEFINT A-Z
' Dimension Array to Hold Directories and Variable for Number of Dirs
DIM SHARED Path$(300), DCnt

' Set Active and Visual Pages to 1 and Clear Screen
SCREEN 0, , 1, 1: CLS

' Prompt User for Drive Letter and Prepare Screen
PRINT "Get Tree For Which Drive :";
DO: Drive$ = UCASE$(INKEY$): LOOP UNTIL LEN(Drive$): PRINT Drive$
PRINT "Scanning Drive " + Drive$ + " :"

' Set Frist Path to Root and Directory Count to 1
Path$(1) = Drive$ + ":": DCnt = 1

' Send Output to Page 0 (hide it)
SCREEN 0, , 0, 1

' Start Recursive Directory Scan
GetDirs Path$(1), 1

' Clear Screen and Set OutPut Back to Page 1 and Show Tree
CLS : SCREEN 0, , 1, 1
ShowTree

' Set All Pages to 0 and End
SCREEN 0, , 0, 0
END

SUB GetDirs (Path$, Level)
' Clear Screen, Display Sub Directories in Path$, Find out Last Line
CLS : FILES RTRIM$(Path$) + "\*.": LastLin = CSRLIN - 3

' Start Scanning Each Line of the Screen for Directory Entries
FOR Lin = 1 TO LastLin
  FOR Col = 0 TO 3   ' Start with Column Offset of 0
    D$ = ""          ' Clear Temp Character Variable
    DEF SEG = &HB800 ' Set Default Segment to Video Memory
    ' Read One Entry (17 Characters) From Video Memory
    FOR Char = 0 TO 34 STEP 2
      D$ = D$ + CHR$(PEEK(Lin * 160 + Col * 36 + Char))
    NEXT
    DEF SEG ' Set Default Segement Back to QB Data
    ' If Entry is a Sub Directory
    IF INSTR(D$, "<DIR>") AND INSTR(D$, ".") = 0 THEN
      ' Update Count on Visible Page
      DCnt = DCnt + 1: SCREEN 0, , 1, 1: LOCATE 2, 19
      PRINT LTRIM$(STR$(DCnt)): SCREEN 0, , 0, 1
      ' Add the Parent Path to the Name
      P$ = RTRIM$(Path$) + "\" + RTRIM$(LEFT$(D$, INSTR(D$, " ")))
      ' Store it to the Array
      Path$(DCnt) = P$
      ' Do a Recursive Search of That Sub for Subs
      GetDirs P$, Level + 1
      ' Find Last \ in Directory Name
      DO
        W = INSTR(W + 1, P$, "\"): IF W THEN P = W
      LOOP WHILE W
      ' Parse Out the Parent Directory
      P$ = LEFT$(P$, P - 1)
      ' Clear Screen, Re-Display Parent Directory, and Get Last Line
      CLS : FILES P$ + "\*.": LastLin = CSRLIN - 3
    END IF
  NEXT
NEXT
END SUB

----------------------- CONTINUED IN NEXT MESSAGE ----------------------
--- DB 1.50/004079
 * Origin: The Bumpkinland BBS - "Home of BLand Software" (1:296/3)