Category : BASIC Source Code
Archive   : QBFAQR01.ZIP
Filename : DIR2ARRY.BAS

'FULLDIR.BAS by Gaylon Hill
'
'CALL FullDir(Dir$(), DirNum, FileDir, Path$, WildCard$)
'Dir$() - is filled with the directory file names, size, date, & time.
'Dirnum - returns the number of Dir$() (arrays).
'FileDir - if FileDir = 1 then sub-directories names are returned, also.
'Path$ - if Path$= "" then the default path is used. Please note,
' if the Path$ is given then the wildcard will have to be
' given with the path name.
' Ex: Path$ = "\MAIN\QB\*.BAS" or Path$ = "A:\*.*"
'WildCard$ - the WildCard$ selects the type of file needed. Use ? or *
' to narrow the file selection. If WildCard$ = "" then the
' default is "*.*". This entry has NO EFFECT when the Path$
' is given.

TYPE FileFindBuf
DOS AS STRING * 19
CreateTime AS STRING * 1
Attributes AS INTEGER
AccessTime AS INTEGER
AccessDate AS INTEGER
FileSize AS LONG
FileName AS STRING * 13
END TYPE

TYPE Register
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

DEFINT A-Z
'
SUB FullDir (Dir$(), DirNum, FileDir, path$, WildCard$)

DIM inreg AS Register, outreg AS Register
DIM Buffer AS FileFindBuf

DirNum = 0

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

IF path$ = "" THEN
' Get Current Drive

inreg.ax = &H1900
CALL Interrupt(&H21, inreg, inreg)
Drive$ = CHR$(65 + inreg.ax MOD 256)
' Get Current Path
DIM PathSize AS STRING * 64
inreg.ax = &H4700
inreg.dx = ASC(Drive$) - 64
inreg.ds = VARSEG(PathSize)
inreg.si = VARPTR(PathSize)
CALL InterruptX(&H21, inreg, inreg)
path$ = LEFT$(PathSize, INSTR(PathSize, CHR$(0)) - 1)
path$ = Drive$ + ":\" + path$ + "\" + WildCard$
END IF
'Set the area where the file information will be stored
inreg.ax = &H1A00
inreg.ds = VARSEG(Buffer)
inreg.dx = VARPTR(Buffer)
CALL Interrupt(&H21, inreg, outreg)
' Find the first file, if FirstFM=0 then continue.
inreg.ax = &H4E00
inreg.cx = 62
NPath$ = path$ + CHR$(0)
inreg.dx = SADD(NPath$)
CALL Interrupt(&H21, inreg, outreg)
FirstFM = (outreg.ax AND &HF)
'Find the next file(s), if NextFM<>0 then exit.
IF FirstFM = 0 THEN
GOSUB MakeFile
DO
inreg.ax = &H4F00
inreg.dx = SADD(NPath$)
CALL Interrupt(&H21, inreg, outreg)
NextFM = outreg.ax AND &HF
IF NextFM = 0 THEN
GOSUB MakeFile
END IF
LOOP WHILE NextFM = 0
END IF
EXIT SUB
MakeFile:
IF LEFT$(Buffer.FileName, 1) = "." THEN
RETURN
END IF

FSize$ = RIGHT$(SPACE$(8) + STR$(Buffer.FileSize), 8)

BitT = Buffer.AccessTime
ahr = 0
IF BitT < 0 THEN BitT = 32767 + BitT: ahr = 16
hr = (BitT \ 2048)
mm = (BitT - (hr * 2048)) \ 32
hr = ahr + hr
FTime$ = RIGHT$("00" + LTRIM$(STR$(hr)), 2) + ":" + RIGHT$("00"+ LTRIM$(STR$(mm)), 2)

BitD = Buffer.AccessDate
yr = BitD \ 512
mo = (BitD - (yr * 512)) \ 32
da = BitD - (yr * 512) - (mo * 32)
FDate$ = RIGHT$("0" + LTRIM$(STR$(mo)), 2) + "-" + RIGHT$("0" +LTRIM$(STR$(da)), 2) + "-" + LTRIM$(STR$(80 + yr))

x = INSTR(Buffer.FileName, ".")
IF x = 0 THEN
FileTemp$ = LEFT$(Buffer.FileName + STRING$(12, 32), 12)
ELSE
FileTemp$ = LEFT$(LEFT$(Buffer.FileName, x - 1) +SPACE$(12), 8) + MID$(Buffer.FileName, x, 4)
END IF

IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
FileTemp$ = MID$(Buffer.FileName, 1, 12)
END IF

DirNum = DirNum + 1
Dir$(DirNum) = FileTemp$ + FSize$ + " " + FDate$ + " " +FTime$

IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
MID$(Dir$(DirNum), 13, 9) = " "
END IF

Buffer.Attributes = 0
Buffer.AccessTime = 0
Buffer.AccessDate = 0
Buffer.FileSize = 0
Buffer.FileName = STRING$(13, 32)
RETURN
END SUB