===========================================================================
 BBS: The Abacus * HST/DS * Potterville, MI
Date: 06-09-93 (17:17)             Number: 24
From: DIK COATES                   Refer#: 51
  To: EVANS MARTIN                  Recvd: NO  
Subj: Re: DIRS                       Conf: (35) Quick Basi
---------------------------------------------------------------------------
>>>> QUOTING Evans Martin to Bennett Hendry <<<<

 BH> in order to work with them.  ANY ideas would be appreciated.
 BH> Thanks!
 EM> Meeee Toooo!  Send me some source if you find it.

It's a matter of setting the attribute for sub-directory, and
filtering the files... The interrupt call returns files as
well as directories...

Entered into Public Domain by R.A. Coates on June 9, 1993

'$INCLUDE: 'DTA.bi'
'$INCLUDE: 'qbx.bi'

REDIM filelst(1) AS DTAType

srch$ = ""
attr% = 16
CLS
CALL Dirr(srch$, attr%, filelst(), nf%)

FOR c% = 1 TO nf%
  PRINT filelst(c%).fname, filelst(c%).fsize
NEXT c%

FUNCTION CountFiles% (srch$, attr%)
  DIM DTA AS DTAType

  CALL SrchFile(srch$, attr%, DTA, cflag%)

  DO UNTIL cflag%
    numfiles% = numfiles% + 1
    CALL SrchNext(DTA, cflag%)
  LOOP

  CountFiles% = numfiles% - 1
END FUNCTION

' Attributes: Bit location    7   6   5   4   3   2   1   0
'                                    32  16   8   4   2   1
'                                     A   D   V   S   H   RO
'
' Where A   denotes Archive
'       D   denotes Sub-Directory
'       V   denotes Volume Label
'       S   denotes System Files
'       H   denotes Hidden Files
'       RO  denotes Read-Only Files
'
SUB Dirr (srch$, attr%, filelst() AS DTAType, nf%)
  nf% = CountFiles%(srch$, attr%)

  IF nf% > 0 THEN
    REDIM filelst(1 TO nf% + 1) AS DTAType
    CALL GetFiles(srch$, attr%, filelst())
  ELSE
    nf% = 0
  END IF
END SUB

SUB GetFiles (srch$, attr%, filelst() AS DTAType)
  DIM DTA AS DTAType
  CALL SrchFile(srch$, attr%, DTA, cflag%)

  IF (cflag% AND 1) <> 0 THEN
    filelst(1) = DTA
    c% = 1
  END IF

  DO UNTIL cflag%
    c% = c% + 1
    DTA.fname = STRING$(13, 0)
    CALL SrchNext(DTA, cflag%)
    filelst(c%) = DTA
  LOOP
END SUB

SUB SrchFile (srch$, attr%, DTA AS DTAType, cflag%)
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
  DIM F AS STRING * 64

  IF srch$ = "" THEN
    srch$ = "*.*"
  END IF

  InRegs.ax = &H1A00                  'set DTA address
  InRegs.ds = VARSEG(DTA)
  InRegs.dx = VARPTR(DTA)
  CALL InterruptX(&H21, InRegs, OutRegs)

  F = srch$ + CHR$(0)                 'NUL terminated ASCIIZ string
  InRegs.ax = &H4E00
  InRegs.cx = attr%
  InRegs.ds = VARSEG(F)
  InRegs.dx = VARPTR(F)
  CALL InterruptX(&H21, InRegs, OutRegs)

  cflag% = OutRegs.ax
END SUB

SUB SrchNext (DTA AS DTAType, cflag%)
  DIM InRegs AS RegTypeX
  DIM OutRegs AS RegTypeX
  InRegs.ax = &H4F00
  CALL InterruptX(&H21, InRegs, OutRegs)
  cflag% = OutRegs.ax
END SUB

'DTA.BI File

DECLARE FUNCTION CountFiles% (srch$, attr%)
DECLARE SUB Dirr (srch$, attr%, filelst() AS ANY, nf%)
DECLARE SUB GetFiles (srch$, attr%, filelst() AS ANY)
DECLARE SUB SrchFile (srch$, attr%, DTA AS ANY, cflag%)
DECLARE SUB SrchNext (DTA AS ANY, cflag%)

TYPE DTAType
  reserved AS STRING * 21
  attr AS STRING * 1
  ftime AS STRING * 2
  fdate AS STRING * 2
  fsize AS LONG
  fname AS STRING * 13
END TYPE


Something to dabble with... would appreciate any improvements to
the source... also should be entered into the PD...

Regards Dik

... It's raining, It's pouring, the old man is... dead, Jim.
___ Blue Wave/QWK v2.12

--- Maximus 2.01wb
 * Origin: Birdz'n Bytes (1:229/110)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/110 159/100 125 430 575 950 203/23 209/209
SEEN-BY: 261/1023 280/1 390/1 396/1 15 397/2 2230/100 2440/5 3603/20