'===========================================================================
' Subject: FAST DIRECTORY CHANGER             Date: 12-30-92 (00:00)       
'  Author: John Gallas                        Code: QB, PDS                
'  Origin: FAST,DIRECTORY,CHANGER           Packet: DOS.ABC
'===========================================================================
' JD.BAS  -  Fast Directory Changer  -  By John Gallas  -  12/30/92

' Use it as you wish, just don't forget who really wrote it.

DEFINT A-Z

DECLARE SUB AddDirs (CurrentDir$, ListOfEm$)
DECLARE SUB ScanDrive ()

DECLARE FUNCTION CurDir$ ()
DECLARE FUNCTION DIR$ (FileSpec$)

' $INCLUDE: 'QB.BI'

CONST DOS = &H21
CONST SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00

CONST True = -1, False = 0

IF COMMAND$ = "" THEN

    PRINT
    PRINT "JD 1.0  By John Gallas"
    PRINT
    PRINT "Usage: JD <full or partial directory name>"
    PRINT "   or: JD /SCAN to create a new directory database."
    END

END IF

IF INSTR(COMMAND$, "/SCAN") THEN  'they wanna scan the drive

    ScanDrive
    END

END IF


'open the file
OPEN "\JD.IDX" FOR BINARY AS #1
'create a string to hold its contents
DirList$ = STRING$(LOF(1), 0)
'read in the string
GET #1, , DirList$
'close the file
CLOSE #1

Search$ = RTRIM$(LTRIM$(COMMAND$))

'We have to start scanning the list of directories after the current
'directoriy's entry, incase theres another dir with the same pattern.
Temp$ = "C:\" + CurDir$

Check = INSTR(DirList$, Temp$ + CHR$(0))

Pointer = 1

IF Check THEN Pointer = Check + LEN(Temp$) + 5

IF INSTR(Temp$, Search$) = 0 THEN
   'the current directory is definatly not one of the possible choices, so
   'set the pointer back to 1.
   Pointer = 1
END IF

Times = 1
Success = False

DO

   Check = INSTR(Pointer, DirList$, Search$)

   IF Check = 0 THEN  'check if its in an earlier entry
	 IF Times = 2 THEN Success = False: EXIT DO
	 Pointer = 1: Times = 2
   ELSE
	 Success = True
	 EXIT DO
   END IF

LOOP

IF Success THEN

   'find the entry closest to Check
   FOR x = Check TO 1 STEP -1
	x$ = MID$(DirList$, x, 1)
	IF x$ = CHR$(0) THEN x = x + 1: EXIT FOR
	IF x = 1 THEN EXIT FOR
   NEXT x
   x2 = INSTR(x, DirList$, CHR$(0))
   ToGo$ = MID$(DirList$, x, x2 - x)
   CHDIR ToGo$

ELSE

   PRINT "Directory not found!"

END IF

END

SUB AddDirs (CurrentDir$, ListOfEm$)

Temp$ = CurrentDir$

'Do this for the 1 exception that we're scanning C:\, because we won't get
'any files when we ask for a list in C:\\*.*
IF RIGHT$(Temp$, 1) = "\" THEN Temp$ = LEFT$(Temp$, LEN(Temp$) - 1)

x$ = Temp$ + "\*.*"
d$ = Temp$ + "\"

File$ = DIR$(x$)

DO WHILE LEN(File$)
  ListOfEm$ = ListOfEm$ + d$ + File$
  File$ = DIR$("")
LOOP

END SUB

FUNCTION CurDir$

'reads the current directory

DIM Reg AS RegTypeX
DIM CurrentDrive AS INTEGER
DIM CurrentDir AS STRING * 64

	'Get current disk drive
	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