'===========================================================================
' Subject: DIRECTORY LISTER                   Date: 10-17-96 (16:56)       
'  Author: Alvin Williams                     Code: QB, PDS                
'  Origin: jw32@gnn.com                     Packet: DOS.ABC
'===========================================================================
DECLARE SUB Help ()
' DirLister.. (C) WASC. 1994.  See legal-release below
' internet: LATEAGAIN@DELPHI.COM

' DirLister is a Subroutine to display and navigate through directories in
' multiple columns and pages. I wrote it because i can't stand scrolling
' pick lists and it's similar to a commercial product i use a lot.
'
' You may change the....
'  ..number of columns, number of rows , starting screen row and
' starting screen column. See the line...
'***USER VARIABLES***
' ...in the ListDir sub.
'
' Since PDS's DIR$ function won't return a Directory (duh!)
' and QB dosn't have any DIR$ function, you will
' have to load a library with the Interrupt call's.
' ie:
'          qb listdir / l c:\qb45\qb.qlb
'     or   qbx listdir /l c:\bc7\libs\qbx.qlb    for PDS 7.1
' Since more people seem to have QB4.5 than PDS, i've re-coded this to
' run as QB4.5 compatable.
'
'  PDS users need to swap the lines...
'           'Regs.ds = SSEG(spec$)   'PDS 7.1
'           Regs.ds = VARSEG(spec$)  'QB4.5
' ..in FUNCTION qbdir$()
' ..or not, depending on farstring usage.
'
' ...also the qbcurdir$() function can be removed and replaced
' with the PDS func, CURDIR$.
'
' MONO and HERC users need to redo all the COLOR statements.
'
'  The source code to DirLister is made available to readers of the
' All Basic Code Packets of ABC only.
' Any other distribution of the source code is prohibited.
' You may use/include/sell the compiled or 'Binary' version in anyway you
'see fit.




DEFINT A-Z
DECLARE SUB DirLister (weAlreadyDidItYN%, thisfile%, mask$, dr$, tag%, dircnt%, numfiles%)
DECLARE SUB mainInput (prmpt$, cmdm2$, mode%, modet%)
DECLARE FUNCTION qbdir$ (mode%, spec$, a%)
DECLARE FUNCTION qbcurdir$ ()

'
'$DYNAMIC
'if using qbx.bi or qb.bi, you shouldn't need this...
TYPE RegTypeX
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
' Data transfer Area, we need this and it has to be shared
TYPE dta0
 DTAmisc AS STRING * 21
 Attr AS STRING * 1    ' this.....
 Time AS INTEGER
 Date AS INTEGER
 Size AS LONG
 filename  AS STRING * 13  '..and this, are all we really need
END TYPE
DECLARE SUB InterruptX (Intnum, InRegs AS RegTypeX, OutRegs AS RegTypeX)

DIM SHARED regs AS RegTypeX
DIM SHARED buffer AS dta0

DIM SHARED MaxDirEntry AS INTEGER

'note: if you only want to return 1 file at a time, then this
' wouldn't need to be SHARED. You could REDIM it as necessary in the
' listdir() sub and erase it as needed. Rework the parameters to listdir()
' so that it returns the file name.
DIM SHARED filename$(1024)  'dir and file names
DIM SHARED fis%(1024)      'file-is%  root=1 dir=2 file=3 tagged file=6

CALL Help
mask$ = ""
orgdir$ = qbcurdir$ ' QB.45
'orgdir$ = CURDIR$   'PDS 7.1
CLS
DO
  IF mask$ = "" THEN   ' if user reset mask$ we don't want to mess with it
    mask$ = "*.*"
  END IF
  CLS
  CALL DirLister(weAlreadyDidItYN%, thisfile%, mask$, cd$, tag%, dircnt%, numfiles%)
  IF thisfile% = 0 THEN  'user pressed <Esc>, quit program
    CLS
    exitLOOPflag% = 1
  ELSE
   'if the select file is a directory... change to it
   IF fis%(thisfile%) = 2 OR fis%(thisfile%) = 1 THEN
    'strip arrow and space..2 char
    IF fis%(thisfile%) = 2 THEN
      l% = LEN(filename$(thisfile%))
      IF LEN(cd$) = 3 THEN   'in root  'c:\'
	m$ = ""
      ELSE    'in a dir 'C:\THISDIR'  need a '\' on the end
	m$ = "\"
      END IF
	s$ = cd$ + m$ + RIGHT$(filename$(thisfile%), l% - 2)
    ELSE
       s$ = ".."
    END IF
	CHDIR s$
	weAlreadyDidItYN% = 0  'new dir
	numfiles% = 0
	dircnt% = 0
   ELSE
  
    PRINT "You selected: ";
   IF tag% = 0 THEN
    PRINT filename$(thisfile%)
   ELSE
     PRINT
     FOR i% = dircnt% TO numfiles%
      IF fis%(i%) = 6 THEN PRINT filename$(i%)
     NEXT i%
   END IF
    PRINT "<Space bar> to see Directory again. "
    PRINT "<Esc> or <Q> to quit."
   
    mainInput "", k$, 1, mt%
    IF mt% = 27 THEN k$ = "Q"
    SELECT CASE k$
    'put any routines to process files here
    ' RUN, SHELL, ZIP, DELETE, etc.
    CASE "Q"   'Quit
      exitLOOPflag% = 1
    END SELECT
   END IF
  END IF
LOOP UNTIL exitLOOPflag% = 1

'clean up and exit
IF Xhere% <> 1 THEN ' exit where we started
 CHDIR orgdir$
END IF
CLS
CLOSE
END

REM $STATIC
SUB DirLister (weAlreadyDidItYN%, thisfile%, mask$, dr$, tag%, dircnt%, numfiles%)
' DirLister.. (C) WASC. 1994.
' LATEAGAIN@DELPHI.COM

STATIC filecnt%  '<--save this for next go around
DIM morep$(4)    '<--hold our Page Up , Page Down or both prompt
'set view window to 1-22..put commands and messages 23 to 25
theBIGloopEXIT% = 0
DO  '<---------theBIGloop
VIEW PRINT 1 TO 24

    IF weAlreadyDidItYN% = 0 THEN   'if we havn't done this before
	  weAlreadyDidItYN% = 1     'well we're gonna do it
	  filecnt% = 0  ' zero this because it's static
	  ' now load sub-dir's
	     dr$ = qbcurdir$  ' QB.45
	     'dr$ = CURDIR$   'PDS 7.1
	     drive$ = LEFT$(dr$, 2)        'Get the current drive.
	     null$ = qbdir$(0, "", 24)
	     d$ = qbdir$(1, "*.*", 16)
		IF d$ <> "" THEN
		   ef% = 0
		   DO
		      GOSUB doname
		      d$ = qbdir$(2, "*.*", 16)
		      IF d$ = "" THEN ef% = 1
		    LOOP UNTIL ef% = 1
		END IF
	  'now sort dirs
	  filecnt% = dircnt%
	  sortStart% = 1: sortend% = filecnt%
	  GOSUB GSsortfname         'change to CALL QuickSort for speed
	  'z$ = DIR$(mask$)    'PDS 7.1
	  z$ = qbdir$(1, mask$, 32)
	  IF z$ <> "" THEN         ' if that worked try for more
	    ef0% = 0: nomore% = 0

	    DO
	     IF filecnt% >= 1024 THEN nomore% = 1     'too many files
	     IF nomore% = 0 THEN                     'still going??
	       filecnt% = filecnt% + 1
	       fis%(filecnt%) = 3 'file
	       filename$(filecnt%) = z$
	       'z$ = DIR$  'PDS 7.1
	       z$ = qbdir$(2, mask$, 32)
	       IF z$ = "" THEN nomore% = 1    'last one
	     ELSE                             'no
	       ef0% = 1                       ' set loop exit
	     END IF
	    LOOP UNTIL ef0% = 1

	  ELSE    'no files
	   IF filecnt% = 0 THEN 'no dirs either..must have problems
	    LOCATE 1, 1
	    PRINT "No files matching "; mask$; " where found."
	    'wait for a keypress
	    mainInput "", k$, 1, mt%
	    VIEW PRINT 1 TO 24
	    EXIT SUB
	   END IF
	  END IF
	  'sort files
	  sortStart% = dircnt% + 1: sortend% = filecnt%
	  GOSUB GSsortfname
 END IF  'end of wealreadygotitYN%

 'settings for pgdown page up status and display prompt
 morep$(0) = "No more files. "
 morep$(1) = "More Files.. Press <Page Down> to show. "
 morep$(2) = "More Files.. Press <Page Up> to show. "
 morep$(3) = "More Files.. Press <Page Up> or <Page Down> to show. "
 l3$ = "Use <Space bar> to tag files. <F2> to change mask(*.*) <F1>=Help <Esc>=Quit "
 l% = LEN(l3$): l3$ = l3$ + SPACE$(80 - l%)

'show files in dir
 'filename$() is 12 char wide
 divider$ = " " + CHR$(179) + " "        ' do string work once
 'divider$ is 3 char wide..so.. fwidth% can't be less than 15.
 '***USER VARIABLES***   change as needed
 fwidth% = 15         'make sure this fits num cols
 StartRow% = 3:
 StartCol% = 2        '
 numRowsIncol% = 20  '***set this anywhere from 2 to 24
		     ' just make sure it fits the view print window
 numcols% = 5         'cant be more than 5 or less than 1
 '*****************

 virtRow% = numRowsIncol% + (StartRow% - 1)
 wedidcnt% = 0
 hirow% = StartRow%: hicol% = StartCol% 'start out at first file
 oldhirow% = hirow%: oldhicol% = hicol%
 thisfile% = 1: oldthisfile% = 1        'set ptr to the first file
 index% = 0                             'for multiple pages ie?:page 2 index=132
 oldindex% = 0
 wedidcnt% = 0
 oldwedidcnt% = 0
 numOnScreen% = numcols% * numRowsIncol%      'ie: 110= (22 rows *  5 col )
 numFullpages% = filecnt% \ numOnScreen%   'use for <home> <end>
 numextra% = filecnt% MOD numOnScreen%
 dirpage% = 1
 IF LEN(dr$) = 3 THEN  'faster than  mid$(
  k$ = ""
 ELSE
  k$ = "\"
 END IF

 numf$ = STR$(filecnt% - dircnt%) + "-Files " + STR$(dircnt%) + "-Director"
 IF dircnt% = 1 THEN
   numf$ = numf$ + "y"  'little grammer never hurts
 ELSE
  numf$ = numf$ + "ies"
 END IF
 
 l% = LEN(numf$)
 IF l% <= 80 THEN     'make the line fit the screen nicely
   numf$ = numf$ + SPACE$(80 - l%)
 ELSE
   numf$ = RIGHT$(numf$, 80)
 END IF

 title$ = "Dir: " + dr$ + k$ + mask$
 l% = LEN(title$)
 IF l% <= 80 THEN
   title$ = title$ + SPACE$(80 - l%)
 ELSE
   title$ = RIGHT$(title$, 80)
 END IF

exitLOOP2flag% = 0
DO
 LOCATE StartRow% - 1, 1:
 COLOR 0, 7
 LOCATE StartRow% - 1, 1: PRINT numf$;
 LOCATE StartRow% - 2, 1: PRINT title$;
 'LOCATE StartRow% + numRowsInCol%, 1: PRINT SPACE$(80);
 COLOR 7, 0

 pfLOOPexit% = 0
 column% = StartCol%          'start here 1,(0)
 rowcnt% = StartRow% - 1      ' we add 1 going in..set to (1 less) now
 oldindex% = index%
 oldthisfile% = thisfile%    ' if we are redrawing the page we need this
 wedidcnt% = oldwedidcnt%   'save to come back

 DO   '様様様様  print filename LOOP   pfLOOPexit%
   wedidcnt% = wedidcnt% + 1
   rowcnt% = rowcnt% + 1          ' next row
   lastMaxRow% = rowcnt%          'save this
   maxcol% = column%              'save this for pgup, pgdown
   ' the last column may not have maxrow% 's
   LOCATE rowcnt%, column%:
   IF fis%(wedidcnt%) = 6 THEN  'if file is tagged, then print bold
     COLOR 15, 0
     PRINT filename$(wedidcnt%);
     COLOR 7, 0
   ELSE
     PRINT filename$(wedidcnt%);  'else just print
   END IF
   LOCATE rowcnt%, column% + fwidth% - 2: PRINT divider$;
   IF wedidcnt% = filecnt% THEN                     'we do em all??
     pfLOOPexit% = 1
   ELSE                        'no
    IF rowcnt% = (numRowsIncol% + StartRow% - 1) THEN  ' we fill up this col?
      column% = column% + fwidth%   ' move over 1 col (15 char)
      IF column% > (numcols% * fwidth%) THEN   'IF column% > 70 THEN we fill up screen  ?
	'yes , set up to do new screen
	pfLOOPexit% = 1
      ELSE                   'no ..just move over
	rowcnt% = StartRow% - 1
      END IF

    END IF
  END IF
 LOOP UNTIL pfLOOPexit% = 1    '様様様様print filname LOOP  pfLOOPexit
'

 'figure out and  set more%, page up and page down flags
 IF wedidcnt% < filecnt% THEN
   IF wedidcnt% > numOnScreen% THEN  'if wedicnt% >110 but < filecnt%
    'we are in the middle
     more% = 3:   pgupok% = 1: pgdwnok% = 1   'next and previous pages exist
   ELSE
     more% = 1: pgupok% = 0: pgdwnok% = 1    ' just next pages exist
   END IF
 ELSE
   IF wedidcnt% > numOnScreen% THEN  'we are equal to file cnt,
   'but previous pages exist
     more% = 2: pgupok% = 1: pgdwnok% = 0  'so we show next pages exist but no previous
   ELSE         ' no previouspage, no next page..so
     more% = 0:  pgupok% = 0: pgdwnok% = 0    'no more files
   END IF
 END IF

 COLOR 0, 7
 LOCATE StartRow% + numRowsIncol%, 1
 k$ = " Use arrow keys to move. " + morep$(more%)
 l% = LEN(k$): k$ = k$ + SPACE$(80 - l%)
 PRINT k$;
 LOCATE StartRow% + numRowsIncol% + 1, 1
 PRINT l3$;
 COLOR 7, 0

 keyLOOPexit% = 0
 DO  '様様様様KEY LOOP
      'do this to keep from scrolling into a blank spot
      ' in col one of the next page
     IF maxcol% = StartCol% THEN 'short 1 col page trap for right arrow
	IF hirow% > lastMaxRow% THEN
	  hirow% = lastMaxRow%: oldhirow% = hirow%
	  'reclac thsifile%, save oldThisFile%
	  GOSUB GScalcThisfile
	  oldthisfile% = thisfile%  'reset this
	END IF
     END IF

       ' print old- location in plain color ie: un-highlite it
       LOCATE oldhirow%, oldhicol%:
	IF fis%(oldthisfile%) = 6 THEN 'its tagged
	  COLOR 15, 0
	  PRINT filename$(oldthisfile%);
	  COLOR 7, 0
	ELSE 'it aint tagged
	  PRINT filename$(oldthisfile%);
	END IF
       ' high-lite current one in different color
       LOCATE hirow%, hicol%:
       IF fis%(thisfile%) = 6 THEN 'its tagged
	 COLOR 15, 4
       ELSE  'no tag
	 COLOR 0, 4
       END IF
	 PRINT filename$(thisfile%);
       COLOR 7, 0      'reset to old colors

       mainInput "", k$, 1, mt%          ' get one keypress
       ' mt% contains the keycode
	IF k$ = CHR$(13) THEN mt% = 13
	oldhirow% = hirow%: oldhicol% = hicol%

	SELECT CASE mt%
	CASE 59 'F1=help
	   CALL Help
	   CLS
	     keyLOOPexit% = 1   'set for inner loop exit so we can
	     ' redraw the screen
	CASE 83   'delete
	 'confirm users choice
	 'kill file
	 'redo directory
	'CASE 1024  ' mouseMove
	'mouse routines deleted for space.
	'CASE 1025  'left mouse button click
	' fake <Enter>
	CASE 72  'up  arrow
	    IF hirow% = StartRow% THEN  'if first..start at bottom of previous col
		 hirow% = virtRow%
		 IF hicol% > StartRow% THEN    'move to prev column if not in first
		   hicol% = hicol% - fwidth%
		 ELSE                   ' move screen back if allowed
		  IF more% <> 0 AND more% <> 1 THEN
		   GOSUB GSdopageup
		  ELSE
		   hirow% = StartRow% 'stay put
		  END IF
		 END IF
	    ELSE
	       hirow% = hirow% - 1  'otherwise..go up one row
	    END IF
	CASE 80   'downarrrow%  '80
	    IF hirow% = virtRow% THEN  'if last, start at first row next column
	      IF hicol% < (numcols% - 1) * fwidth% THEN    'if not last col go to next
		 hirow% = StartRow%
		 hicol% = hicol% + fwidth%  '15
	      ELSE    'else last col move screen over if possible
		temp1% = hirow%  'save row
		GOSUB GSdopagedown
		IF wewentdown% = 0 THEN 'no good, save spot
		  hirow% = temp1%: oldhirow% = temp1%
		END IF
	      END IF
	    ELSE
	       hirow% = hirow% + 1    'otherwise go down one col
	    END IF
	CASE 75   'leftarrow%  '75     '
	    IF hicol% > StartCol% THEN
	      hicol% = hicol% - fwidth%    '15
	    ELSE  'see if another screen
	     IF more% <> 1 THEN 'keep from moving if on first page
	      'want to stay on same row for the new page..so...
	      'save old row%..because GSdopageup sets it to 22
	      temp1% = hirow%
	      GOSUB GSdopageup
	      'get our row back if it changed
		hirow% = temp1%: oldhirow% = temp1%
	     END IF
	    END IF
	CASE 77  'rightarrow
	    IF hicol% < (numcols% - 1) * fwidth% THEN
	       hicol% = hicol% + fwidth%
	    ELSE  'see if another screen
		'save old row%..because GSdopageup sets it to 1
		temp1% = hirow%
		GOSUB GSdopagedown
		'do this to keep from scrolling into a blank spot
		' in col one of the next page
		  hirow% = temp1%: oldhirow% = temp1%
	    END IF
	CASE 81   'page down
	   'if at top of page, set to bottom
	   IF (hicol% <> maxcol% AND hirow% <> lastMaxRow%) OR (hicol% = maxcol% AND hirow% <> lastMaxRow%) THEN
	     hicol% = maxcol%: hirow% = lastMaxRow%           ' |check for 1 col screen
	   ELSE  'set to next page
	      GOSUB GSdopagedown
	   END IF
	CASE 73    'page up
	   'if at bottom of page, set to top unless at top of page 1
	   ' in which case we stay put
	   IF NOT (hirow% = StartRow% AND hicol% = StartCol%) OR (hirow% = StartRow% AND hicol% = StartCol% AND (more% = 1 OR more% = 0)) THEN   'don't ask
	      hirow% = StartRow%: hicol% = StartCol%
	   ELSE  'do a new page
	    IF more% <> 1 THEN  'this is to keep hirow%=StartRow% ,hicol%=StartCol%
	    ' if we are at the first page
	      GOSUB GSdopageup
	    END IF
	   END IF
	CASE 71  '<Home>
	  ' just redraw the first page, set highlite
	  ' to the first file/directory
	  CLS : keyLOOPexit% = 1   'set to redraw
	  hicol% = StartCol%: hirow% = StartRow%
	  oldhicol% = hicol%: oldhirow% = hirow%
	  index% = 0: oldwedidcnt% = 0
	  thisfile% = 1: oldthisfile% = 1
	CASE 79 '<End>
	     CLS : keyLOOPexit% = 1   'set to redraw
	     IF numFullpages% >= 1 AND numextra% <> 0 THEN
	      ' cover's 1 page and half page
	       index% = numFullpages% * numOnScreen%
	     ELSE
	      IF numFullpages% <> 0 THEN
	       index% = filecnt% - (numFullpages% * numOnScreen%)
	      END IF
	     END IF
	       oldwedidcnt% = index%
	     IF numFullpages% = 0 THEN
	       temp2% = filecnt%
	     ELSE
	       temp2% = numextra%
	     END IF
	     thismanycol% = (temp2% \ numRowsIncol%)
	     IF (temp2% MOD numRowsIncol%) > 0 THEN
		thismanycol% = thismanycol% + 1
	     END IF
	     IF thismanycol% = 0 THEN
	       hicol% = StartCol%
	     ELSE
	       hicol% = ((thismanycol% * fwidth%) - fwidth%) + StartCol%
	     END IF
	     hirow% = ((numextra% MOD numRowsIncol%) - 1) + StartRow%
	     oldhirow% = hirow%: oldhicol% = hicol%
	CASE 27  '<Esc> exit and abort program
	    CLS
	    thisfile% = 0: tag% = 0          ' zero pointer to show no choice
	     EXIT SUB   '<----EXIT POINT
	CASE 13   '<Enter> 'when we exit, thisfile% is pointing to filename$(thisfile%)
	    numfiles% = filecnt%
	    CLS : keyLOOPexit% = 1: exitLOOP2flag% = 1
	    theBIGloopEXIT% = 1
	CASE 60  '<F2>  change mask$
	  'works better in a message box, but anyway...
	  LOCATE 23, 1: PRINT SPACE$(27);   'clean off screen line for input
	  LOCATE 23, 1: mainInput "Enter new mask ", mask$, 0, mt%
	  IF mask$ = "" THEN mask$ = "*.*"
	  CLS : keyLOOPexit% = 1: exitLOOP2flag% = 1
	  weAlreadyDidItYN% = 0: filecnt% = 0: dircnt% = 0
	CASE 320   'space bar..tag a file
	   'if fis%() is not a dir,
	    IF fis%(thisfile%) = 3 THEN
	      tag% = tag% + 1
	      fis%(thisfile%) = 6
	    ELSE
	      IF fis%(thisfile%) = 6 THEN
		tag% = tag% - 1
		fis%(thisfile%) = 3
	      END IF
	    END IF
	END SELECT
	
	' calculate new file pointer
	GOSUB GScalcThisfile

  LOOP UNTIL keyLOOPexit% = 1   '様様様様KEY LOOP

LOOP UNTIL exitLOOP2flag% = 1

LOOP UNTIL theBIGloopEXIT% = 1

'clean up
VIEW PRINT 1 TO 24
EXIT SUB



'SUB routines

GSdopagedown:
       wewentdown% = 0           'set to default ..no
       IF pgdwnok% = 1 THEN      'if ok to go down
	     CLS :    wewentdown% = 1     'show we went down
	     oldwedidcnt% = wedidcnt%
	     oldindex% = index%
	     index% = wedidcnt%
	     hirow% = StartRow%: hicol% = StartCol%  'start out at first file on
					   ' screen  ie:LOCATE 1, 1
	     oldhirow% = hirow%: oldhicol% = hicol%  'preset old Locations
	     thisfile% = index% + 1:       ' set pointer
	     IF thisfile% > filecnt% THEN thisfile% = filecnt%
	     oldthisfile% = thisfile%               'hilight the first file
	     keyLOOPexit% = 1   'set for inner loop exit so we can
	     ' redraw the screen
      END IF
RETURN
GSdopageup:
  wewentup% = 0    'set to default
  IF pgupok% = 1 THEN
    wewentup% = 1   'show we went up
    CLS
    index% = index% - numOnScreen%     'bump the index back
    oldindex% = oldindex% - numOnScreen%
    oldwedidcnt% = oldwedidcnt% - numOnScreen%
   'start out at last position on page
   'since we are going up, the last position has to be ...
    hirow% = virtRow%: hicol% = ((numcols% * fwidth%) - fwidth%) + StartCol%
    oldhirow% = hirow%: oldhicol% = hicol%
    thisfile% = index% + numOnScreen%   '110
    oldthisfile% = thisfile%      'point to the first file
    keyLOOPexit% = 1            'set for inner loop exit
  END IF

RETURN


GSsortfname:
' create a Quicksort SUB for speed
' be sure and set STACK for enough room
' for recursive calls on 1024 files
' mean while.... plain old shell sort
' courtesy of MicroSoft(C) examples
 'nothing new here...just make sure to sort fis%() along with filename$()
noSwitch% = 0
Offset = (sortend% - sortStart%) \ 2
DO WHILE Offset > 0
Limit = sortend% - Offset
DO
Switch = noSwitch%
FOR temp1% = sortStart% TO Limit
IF filename$(temp1%) > filename$(temp1% + Offset) THEN
SWAP filename$(temp1%), filename$(temp1% + Offset)
SWAP fis%(temp1%), fis%(temp1% + Offset)  'swap file is
Switch = temp1%
END IF
NEXT temp1%
Limit = Switch - Offset
LOOP WHILE Switch
Offset = Offset \ 2
LOOP

RETURN

GScalcThisfile:
 ' save oldThisFile% to
  oldthisfile% = thisfile%                 ' save old file pointer
  thisfile% = index% + (((hicol% \ fwidth%) * 1) * numRowsIncol%) + (hirow% - (StartRow% - 1))
  'the above line is equal to
  ' SELECT CASE hicol%
  ' CASE StartCol% 'column is 1
  '    thisfile% = index% + (0 * numRowsInCol%) + (hirow% - (StartRow% - 1))
  ' CASE fwidth% + startCol% 'column 2
  '    thisfile% = index% + (1 * numRowsInCol%) + (hirow% - (StartRow% - 1))           'x1=0 + hilited row + 22
  '....etc
  ' if user tries to go to a blank area of the screen
  ' just stay where we were .. see trap for short 1 col page
  IF thisfile% > filecnt% THEN
     thisfile% = oldthisfile%
     hirow% = oldhirow%: hicol% = oldhicol%
  END IF

RETURN

doname:
   SELECT CASE d$
   CASE "."
      'do nothing
   CASE ".."
      dircnt% = dircnt% + 1
      filename$(dircnt%) = CHR$(24) + " " + d$'up arrow
      fis%(dircnt%) = 1   'root
   CASE ELSE
     dircnt% = dircnt% + 1
     filename$(dircnt%) = CHR$(25) + " " + d$'down
     fis%(dircnt%) = 2    'dir
   END SELECT
RETURN

END SUB

SUB Help
'
CLS
PRINT "**You can change this to use a window or something more upscale.**"
PRINT "**Just work it into your screen/window/setup**"
PRINT "Key usage...."
PRINT "<Enter> to change to directory or pick file."
PRINT "<F2> to change mask (*.*)"
PRINT "<Arrow Keys> to move from file to file or to next page."
PRINT "<Page Up> Go to top of current page or to previous page"
PRINT "<Page Down> Go to bottom of current page or to next page"
PRINT "<Home> Go to current root directory"
PRINT "<End> Go to last file on list"
PRINT "<Space Bar> Tags files in current directory"
PRINT "<Esc> Quit program"
PRINT "<F1> Help"
PRINT
mainInput "Press any key to continue...", k$, 1, mt%


END SUB

DEFSNG A-Z
SUB mainInput (prmpt$, cmdm2$, mode%, modet%)
modet% = 0
STATIC OOldrow%, Ooldcol%, cmdo$, otc%, obc%


PRINT prmpt$;    'print prompt
StartPos% = POS(0)
STATIC cmdM$
SELECT CASE mode%
CASE 1                          'GET 1 CHARACTER AND RETURN
cmdM$ = "": inef% = 0
DO
 kk$ = INKEY$
 l% = LEN(kk$)
 IF l% > 0 THEN
  inef% = 1
  IF kk$ = CHR$(27) THEN
    modet% = 27
  ELSE
     IF l% > 1 THEN
	 c$ = RIGHT$(kk$, 1)
	 IF c$ <> "" THEN
	  scan% = ASC(c$)
	  modet% = scan%

	 END IF
     END IF
  END IF
 END IF
LOOP UNTIL inef% = 1
cmdm2$ = UCASE$(kk$)
IF cmdm2$ = CHR$(32) THEN modet% = 320
CASE ELSE   'input a UCASE$(string$) and exit when CR,Esc or a Func key is hit
 LOCATE , , 1
 cmdM$ = "": inef% = 0
 GOSUB keyloop
 PRINT
 cmdm2$ = UCASE$(cmdM$)
 modet% = scan%
END SELECT

EXIT SUB

keyloop:
DO
 kk$ = INKEY$
 l% = LEN(kk$)
 IF l% > 0 THEN
  IF l% < 2 THEN
   a% = ASC(kk$)
   IF a% <> 13 THEN      'IF kk$ <> CHR$(13) THEN  <Enter>
     IF a% = 27 THEN     'IF kk$ = CHR$(27) THEN  <Esc>
       cmdm2$ = CHR$(27)
       modet% = 27
       EXIT SUB  '<---------exit point
     END IF
     IF a% = 8 THEN       'IF kk$ = CHR$(8) THEN  'BACK SPACE KEY
      l% = LEN(cmdM$)
      IF l% > 1 THEN 'no effect
	cmdM$ = MID$(cmdM$, 1, l% - 1)
      ELSE
	cmdM$ = ""
      END IF
      Currow% = CSRLIN: CurCol% = POS(0)
      IF CurCol% > StartPos% THEN  'locate cursor, go back one, print a space
       CurCol% = CurCol% - 1
       LOCATE Currow%, CurCol%
       PRINT " ";
       LOCATE Currow%, CurCol%
      END IF
     ELSE
      cmdM$ = cmdM$ + kk$
      PRINT kk$;
     END IF
   ELSE
     inef% = 1
     scan% = 13
   END IF
  ELSE 'its control characters or function key
	 c$ = RIGHT$(kk$, 1)
	 IF c$ <> "" THEN
	   scan% = ASC(c$)
	   inef% = 1
	 END IF
   END IF
  END IF
LOOP UNTIL inef% = 1


RETURN
END SUB

DEFINT A-Z
FUNCTION qbcurdir$
' DirLister.. (C) WASC. 1994.
' LATEAGAIN@DELPHI.COM
  
   dbuffer$ = STRING$(65, CHR$(32))
   'see if drive is ready
  
   'get current drive
   regs.ax = &H1900
   CALL InterruptX(&H21, regs, regs)
   al% = regs.ax MOD 256
   c$ = CHR$(al% + 65) + ":\"    'A:=0 B:=1 C:=2 for prev INT
   'get directory
   drive% = al% + 1              'A:=1 B:=2 C:=3 for this INT
   regs.ax = &H4700
   regs.si = SADD(dbuffer$)
   regs.ds = VARSEG(dbuffer$)
   regs.dx = drive%
   CALL InterruptX(&H21, regs, regs)
   ecode% = regs.ax
  IF ecode% THEN
    zl% = INSTR(dbuffer$, CHR$(0))
    qbcurdir$ = c$ + LEFT$(dbuffer$, zl% - 1)
    dbuffer$ = ""
  ELSE
    qbcurdir$ = ""
    dbuffer$ = ""
  END IF

  
END FUNCTION

FUNCTION qbdir$ (mode%, spec$, a%)
 ' a%=32 for files  16 for directories
 ' a%=24 for normal files and dirs
 STATIC attrib%
 SELECT CASE mode%
 CASE 0
    'call with a%=24 for normanl files
    'Set DTA Buffer
    regs.ax = &H1A00
    regs.ds = VARSEG(buffer)
    regs.dx = VARPTR(buffer)
    CALL InterruptX(&H21, regs, regs)
    attrib = a%
 CASE 1
	   spec$ = spec$ + CHR$(0)
	   regs.ax = &H4E00
	   regs.cx = attrib%
	   'Regs.ds = SSEG(spec$)   'PDS 7.1
	   regs.ds = VARSEG(spec$)
	   regs.dx = SADD(spec$)
	   CALL InterruptX(&H21, regs, regs)
	   ecode% = regs.ax
       IF ecode THEN
	 qbdir$ = ""
       ELSE
	 IF ASC(buffer.Attr) = a% THEN
	   zl% = INSTR(buffer.filename, CHR$(0))
	   qbdir$ = LEFT$(buffer.filename, zl% - 1)
	 ELSE   'found a match to spec$ but not to attribute
	   'and we need to return something
	   'recursive call
	   f$ = qbdir$(2, spec$, a%)
	   qbdir$ = f$
	 END IF
       END IF
       EXIT FUNCTION
 CASE 2  'Find next file or dir
     DO
       regs.ax = &H4F00
       CALL InterruptX(&H21, regs, regs)
       ecode = regs.ax
       IF ecode THEN
	 qbdir$ = ""
	 EXIT FUNCTION
       ELSE
	IF ASC(buffer.Attr) = a% THEN
	  zl% = INSTR(buffer.filename, CHR$(0))
	  qbdir$ = LEFT$(buffer.filename, zl% - 1)
	  EXIT FUNCTION
	END IF
       END IF
     LOOP
 CASE 3  'Find next DIR only
     DO
       regs.ax = &H4F00
       CALL InterruptX(&H21, regs, regs)
       ecode = regs.ax
       IF ecode THEN
	   qbdir$ = ""
	   EXIT FUNCTION
       ELSE
	 IF ASC(buffer.Attr) = a% THEN
	   zl% = INSTR(buffer.filename, CHR$(0))
	   qbdir$ = LEFT$(buffer.filename, zl% - 1)
	   EXIT FUNCTION
	 END IF
       END IF
     LOOP
 END SELECT
EXIT FUNCTION



END FUNCTION