FAST DIRECTORY CHANGE 2/2

 BBS: Inland Empire Archive
Date: 01-09-93 (11:30)             Number: 265
From: JOHN GALLAS                  Refer#: NONE
  To: ALL                           Recvd: NO  
Subj: FAST DIRECTORY CHANGE 2/2      Conf: (2) Quik_Bas

>>> Continued from previous message
     Reg.ax = &H19 * 256
     INTERRUPTX &H21, Reg, Reg
     CurrentDrive = Reg.ax MOD 256

     'Get current directory

     Reg.ax = &H47 * 256
     Reg.dx = CurrentDrive + 1  'Note adding one to drive for this, or
                                  'could use 0 for default drive
     Reg.ds = VARSEG(CurrentDir)
     Reg.si = VARPTR(CurrentDir)
     INTERRUPTX &H21, Reg, Reg

     x = INSTR(CurrentDir, CHR$(0))
     IF x = 1 THEN CurDir$ = "\" ELSE CurDir$ = LEFT$(CurrentDir, x - 1)

END FUNCTION

' This function was origionally written by Dave Cleary.  I made a few
'modifications to it so that it would only find directories.  I put a
'* next to the lines that I changed.
FUNCTION DIR$ (FileSpec$) STATIC

     DIM DTA AS STRING * 44, Regs AS RegTypeX
     Null$ = CHR$(0)

ReTry:    '*

     '-----  Set up our own DTA so we don't destroy COMMAND$
        Regs.ax = SetDTA                    'Set DTA function
        Regs.dx = VARPTR(DTA)               'DS:DX points to our DTA
        Regs.ds = -1                        'Use current value for DS
        INTERRUPTX DOS, Regs, Regs          'Do the interrupt

     '-----  Check to see if this is First or Next
        IF LEN(FileSpec$) THEN              'FileSpec$ isn't null, so
                                            'FindFirst
           FileSpecZ$ = FileSpec$ + Null$   'Make FileSpec$ into an ASCIIZ
                                            'string
           Regs.ax = FindFirst              'Perform a FindFirst
           Regs.cx = 16                     '* I changed this to look for dirs
           Regs.dx = SADD(FileSpecZ$)       'DS:DX points to ASCIIZ file
           Regs.ds = -1                     'Use current DS
        ELSE                                'We have a null FileSpec$,
           Regs.ax = FindNext               'so FindNext
        END IF

        INTERRUPTX DOS, Regs, Regs          'Do the interrupt

     '-----  Return file name or null
        IF Regs.flags AND 1 THEN            'No files found
           DIR$ = ""                        'Return null string
           EXIT FUNCTION
        ELSE
           '* check if its . or .., if so, can't accept it.
           IF ASC(MID$(DTA, 22, 1)) <> 16 THEN
             'its not a subdirectory, so skip it
             GOTO ReTry
           END IF
           IF MID$(DTA, 31, 1) = "." THEN   '*If its . or ..
             FileSpec$ = ""
             GOTO ReTry
           END IF
        END IF
        Null = INSTR(31, DTA, Null$)     'Get the filename found
        DIR$ = MID$(DTA, 31, Null - 30)  'It's an ASCIIZ string starting
                                         'at offset 30 of the DTA

END FUNCTION

SUB ScanDrive

PRINT "Scanning Directories..."

Path$ = "C:\*.*"
DPath$ = "C:\"
DirList$ = "C:\" + CHR$(0)

'Go through DirList$ and search each subdirectory in it.

Place = 1

DO

  x = INSTR(Place, DirList$, CHR$(0))
  IF x THEN
     'theres yet another subdirectory in the list
     'find out what it is
     DPath$ = MID$(DirList$, Place, x - Place)
     Place = x + 1
     LOCATE , 1: PRINT DPath$; "       ";
     AddDirs DPath$, DirList$
  ELSE
     EXIT DO
  END IF

LOOP

OPEN "\JD.IDX" FOR BINARY AS #1
PUT #1, , DirList$
CLOSE #1

PRINT
PRINT "Done."

END

END SUB

'-----------------------Truncate Here-------------------------

 * OLX 2.1 TD * Iraqi Bingo: B-52...F-16...M-1...F-18...F-117...

--- TMail v1.30.4
 * Origin: TC-AMS MLTBBS 2.2 - Minnetonka, MN (612)-938-4799 (1:282/7)