Qbasicnews.com

'   Ethan Winer: PC Magazine's BASIC Techniques and Utilities Book - 353 -
'              Function FileCount% returns number of files meeting Spec
'$INCLUDE: 'REGTYPE.BI'
DEFINT A-Z
DECLARE FUNCTION FileCount% (Spec$, Attribute%)
DECLARE SUB LoadNames (FileSpec$, Array$(), Attribute%)
   
   TYPE DTAData 'used by find first/next
        Reserved AS STRING * 21 'reserved for use by DOS
        Attr AS STRING * 1 'the file's attribute
        Time AS INTEGER 'the file's time
        Date AS INTEGER 'the file's date
        Size AS LONG 'the file's size
        Named AS STRING * 13 'the file's name
   END TYPE
   DIM SHARED DTA AS DTAData 'shared so LoadNames can
   DIM SHARED Regs AS RegType ' access them too
   DIM Spec AS STRING * 65
   REDIM Names$(1 TO 1) 'create a dynamic array
   'Attribute = 19 'matches directories only
   Attribute = 39 'matches all files
   INPUT "Enter a file specification: ", Spec$
   CALL LoadNames(Spec$, Names$(), Attribute)
   FOR X = LEN(Spec$) TO 1 STEP -1 'isolate the drive/path
   Temp = ASC(MID$(Spec$, X, 1))
   IF Temp = 58 OR Temp = 92 THEN '":" or "\"
   Path$ = LEFT$(Spec$, X) 'keep what precedes that
   EXIT FOR 'and we're all done
   END IF
   NEXT
   FOR X = 1 TO UBOUND(Names$) 'print the names
   PRINT Path$; Names$(X)
   NEXT
   PRINT
   PRINT FileCount(Spec$, Attribute); "matching file(s)"
   'PRINT UBOUND(Names$); "matching file(s)"
   END

   'Function counts number of files meeting Spec 
   'Attribute = 39 'matches all files 19 'matches directories only
   FUNCTION FileCount% (Spec$, Attribute)
   STATIC Temp AS STRING * 65, Count 'make this private
   Regs.dx = VARPTR(DTA): Regs.ds = -1 'the DTA is in DGROUP
   Regs.ax = &H1A00 'specify service 1Ah
   CALL INTERRUPT(&H21, Regs, Regs)  'DOS set DTA service
   Count = 0 'clear the counter
   Temp = Spec$ + CHR$(0) 'make an ASCIIZ string
   IF Attribute AND 16 THEN DirFlag = -1 ELSE DirFlag = 0'no
   Regs.dx = VARPTR(Temp) 'SADD(Spec$) 'the file spec address
   'Regs.ds = -1 'QuickBASIC '= SSEG(Spec$) 'for BASIC PDS
   Regs.cx = Attribute: Regs.ax = &H4E00 'find first matching name
   DO
      CALL INTERRUPT(&H21, Regs, Regs) 'see if there's a match
      IF Regs.flags AND 1 THEN EXIT DO 'flag quits count
      IF DirFlag THEN                  'filter out Directories
         IF ASC(DTA.Attr) AND 16 THEN
           IF LEFT$(DTA.Named, 1) <> "." THEN Count = Count + 1
         END IF
      ELSE : Count = Count + 1'they want regular files
      END IF
      Regs.ax = &H4F00 'find next name
   LOOP
   FileCount% = Count 'assign the function
   END FUNCTION

               'displays filenames and puts them into an array
SUB LoadNames (Spec$, Array$(), Attribute) STATIC
STATIC Temp AS STRING * 65
Temp = Spec$ + CHR$(0) 'make an ASCIIZ string
NumFiles = FileCount%(Spec$, Attribute) 'count names
IF NumFiles = 0 THEN EXIT SUB 'exit if none
REDIM Array$(1 TO NumFiles) 'dimension the array
IF Attribute AND 16 THEN DirFlag = -1 ELSE DirFlag = 0 'no  eliminate!
   
'--The following code isn't strictly necessary because we know that FileCount already set the DTA address.
'Regs.DX = VARPTR(DTA): Regs.DS = -1 'the DTA in DGROUP
'Regs.AX = &H1A00 'specify service 1Ah
'CALL INTERRUPT(&H21, Regs, Regs) 'DOS set DTA service
Regs.dx = VARPTR(Temp)'SADD(Spec$) 'the file spec address
        'Regs.ds = -1 'for QuickBASIC 'Regs.DS = SSEG(Spec$) 'for BASIC PDS
Regs.cx = Attribute: Regs.ax = &H4E00: Count = 0
DO
   CALL INTERRUPT(&H21, Regs, Regs)  'see if there's a match
   IF (Regs.flags AND 1) THEN EXIT DO 'no more
   Valid = 0
   IF DirFlag THEN 'directories?
      IF ASC(DTA.Attr) AND 16 THEN
         IF LEFT$(DTA.Named, 1) <> "." THEN Valid = -1 'this name is valid
      END IF
   ELSE : Valid = -1    'they want regular files
   END IF
   IF Valid THEN 'process the file if it passed all the tests
       Count = Count + 1: Zero = INSTR(DTA.Named, CHR$(0))
       Array$(Count) = LEFT$(DTA.Named, Zero - 1)
   END IF
   Regs.ax = &H4F00 'find next matching name
LOOP
END SUB