home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / listings / v_02_08 / 2n08023b < prev    next >
Text File  |  1991-07-01  |  3KB  |  99 lines
  1.      'Listing 3 - DIR.BAS
  2.      'Reads specified directory into string array.
  3.  
  4.      DEFINT A-Z
  5.      '$INCLUDE: 'qb.bi'
  6.  
  7.      DECLARE SUB GetDir (FileSpec$, Array$())
  8.      DECLARE FUNCTION FileCount (FileSpec$)
  9.  
  10.      CLS
  11.      INPUT "Enter desired path & file spec: ", Temp$
  12.      PRINT
  13.  
  14.      Elements = FileCount(Temp$)
  15.      IF Elements THEN
  16.         REDIM Directory$(1 TO Elements)
  17.         CALL GetDir(Temp$, Directory$())
  18.         FOR I = 1 TO Elements
  19.             PRINT Directory$(I)
  20.         NEXT
  21.      ELSE
  22.         PRINT "File spec not found."
  23.      END IF
  24.      END
  25.  
  26. FUNCTION FileCount (FileSpec$)
  27.  
  28.      DIM Regs AS RegTypeX
  29.  
  30.      Temp$ = FileSpec$ + CHR$(0)
  31.      Regs.ax = &H4E00                       'Find first matching file
  32.      Regs.cx = 0
  33.      Regs.ds = VARSEG(Temp$)
  34.      Regs.dx = SADD(Temp$)
  35.      CALL InterruptX(&H21, Regs, Regs)
  36.  
  37.      Count = 0
  38.      IF Regs.Flags AND 1 THEN               'File not found
  39.         EXIT FUNCTION
  40.      END IF
  41.  
  42.      DO
  43.        Count = Count + 1
  44.        Regs.ax = &H4F00                     'Find next until there
  45.        CALL InterruptX(&H21, Regs, Regs)    'ain't no more
  46.        IF Regs.ax = 18 THEN EXIT DO
  47.      LOOP
  48.  
  49.      FileCount = Count                      'Return number of files found
  50.  
  51. END FUNCTION
  52.  
  53. SUB GetDir (FileSpec$, Array$())
  54.  
  55.     DIM Regs AS RegTypeX
  56.  
  57.     Regs.ax = &H2F00                        'Get DTA
  58.     CALL InterruptX(&H21, Regs, Regs)
  59.     OldDTASeg = Regs.es                     'Save original address
  60.     OldDTAOfs = Regs.bx                     'so we can restore it later.
  61.  
  62.     DTA$ = STRING$(45, 0)                   'Initialize a DTA
  63.     Regs.ax = &H1A00                        'Set new DTA
  64.     Regs.ds = VARSEG(DTA$)
  65.     Regs.dx = SADD(DTA$)
  66.     CALL InterruptX(&H21, Regs, Regs)
  67.  
  68.     Temp$ = FileSpec$ + CHR$(0)
  69.     Regs.ax = &H4E00                        'Find first matching file
  70.     Regs.cx = 0
  71.     Regs.ds = VARSEG(Temp$)
  72.     Regs.dx = SADD(Temp$)
  73.     CALL InterruptX(&H21, Regs, Regs)
  74.  
  75.     IF (Regs.Flags AND 1) THEN              'Error
  76.        EXIT SUB
  77.     ELSE
  78.        Element = LBOUND(Array$)
  79.        Array$(Element) = MID$(DTA$, 31, INSTR(32, DTA$, CHR$(0)) - 31)
  80.     END IF
  81.  
  82.     DO
  83.        Element = Element + 1
  84.        Regs.ax = &H4F00                     'Find next until there
  85.        CALL InterruptX(&H21, Regs, Regs)    'ain't no more
  86.        IF Regs.ax = 18 THEN EXIT DO
  87.        IF Element <= UBOUND(Array$) THEN
  88.        Array$(Element) = MID$(DTA$, 31, INSTR(32, DTA$, CHR$(0)) - 31)
  89.        END IF
  90.     LOOP
  91.  
  92.     Regs.ax = &H1A00                        'Restore original DTA
  93.     Regs.ds = OldDTASeg
  94.     Regs.dx = OldDTAOfs
  95.     CALL InterruptX(&H21, Regs, Regs)
  96.  
  97. END SUB
  98.  
  99.