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 >
Wrap
Text File
|
1991-07-01
|
3KB
|
99 lines
'Listing 3 - DIR.BAS
'Reads specified directory into string array.
DEFINT A-Z
'$INCLUDE: 'qb.bi'
DECLARE SUB GetDir (FileSpec$, Array$())
DECLARE FUNCTION FileCount (FileSpec$)
CLS
INPUT "Enter desired path & file spec: ", Temp$
PRINT
Elements = FileCount(Temp$)
IF Elements THEN
REDIM Directory$(1 TO Elements)
CALL GetDir(Temp$, Directory$())
FOR I = 1 TO Elements
PRINT Directory$(I)
NEXT
ELSE
PRINT "File spec not found."
END IF
END
FUNCTION FileCount (FileSpec$)
DIM Regs AS RegTypeX
Temp$ = FileSpec$ + CHR$(0)
Regs.ax = &H4E00 'Find first matching file
Regs.cx = 0
Regs.ds = VARSEG(Temp$)
Regs.dx = SADD(Temp$)
CALL InterruptX(&H21, Regs, Regs)
Count = 0
IF Regs.Flags AND 1 THEN 'File not found
EXIT FUNCTION
END IF
DO
Count = Count + 1
Regs.ax = &H4F00 'Find next until there
CALL InterruptX(&H21, Regs, Regs) 'ain't no more
IF Regs.ax = 18 THEN EXIT DO
LOOP
FileCount = Count 'Return number of files found
END FUNCTION
SUB GetDir (FileSpec$, Array$())
DIM Regs AS RegTypeX
Regs.ax = &H2F00 'Get DTA
CALL InterruptX(&H21, Regs, Regs)
OldDTASeg = Regs.es 'Save original address
OldDTAOfs = Regs.bx 'so we can restore it later.
DTA$ = STRING$(45, 0) 'Initialize a DTA
Regs.ax = &H1A00 'Set new DTA
Regs.ds = VARSEG(DTA$)
Regs.dx = SADD(DTA$)
CALL InterruptX(&H21, Regs, Regs)
Temp$ = FileSpec$ + CHR$(0)
Regs.ax = &H4E00 'Find first matching file
Regs.cx = 0
Regs.ds = VARSEG(Temp$)
Regs.dx = SADD(Temp$)
CALL InterruptX(&H21, Regs, Regs)
IF (Regs.Flags AND 1) THEN 'Error
EXIT SUB
ELSE
Element = LBOUND(Array$)
Array$(Element) = MID$(DTA$, 31, INSTR(32, DTA$, CHR$(0)) - 31)
END IF
DO
Element = Element + 1
Regs.ax = &H4F00 'Find next until there
CALL InterruptX(&H21, Regs, Regs) 'ain't no more
IF Regs.ax = 18 THEN EXIT DO
IF Element <= UBOUND(Array$) THEN
Array$(Element) = MID$(DTA$, 31, INSTR(32, DTA$, CHR$(0)) - 31)
END IF
LOOP
Regs.ax = &H1A00 'Restore original DTA
Regs.ds = OldDTASeg
Regs.dx = OldDTAOfs
CALL InterruptX(&H21, Regs, Regs)
END SUB