Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How do I get a list of dir and files in a dir 1
- Thread starter musalk
- Start date
qbasicking
Programmer
Someone asked the exact same question in the BASIC:Microsoft forum, it should be one of the first threads of the first page. This will show you how to do it. I don't think you can get the size or any of that though. Try to find a way to read FAT, this would be the best way to make a brouse routine. Read the post in the BASIC:Microsoft forum though, it works great.
- Thread starter
- #3
- Thread starter
- #5
-
1
- #6
Getting the file information from the FAT might
not be the way to go. Versions of Windows more
advanced than Windows 98 object somewhat stenuously
to any attempt to access the disks directly, and
that is what you have to do in order to read the FAT.
If you insist on experimenting, here his a really
simple way to start reading the FAT (using QB45
or QB7). This only reads the very beginning of the
FAT (the root directory entries). It only prints
out the file names and it only works on the floppy
in drive A:
The file names are stored in the first 11 bytes of
each 32-byte entry. If you feel like decyphering
the remaning bytes and finding a way to chase the
FAT chain through the disk, feel free. But I think
the subject is beyond the scope of the Qbasic forum.
Copy some files to the floppy in A: and run this code:
(Requires Quick Basic started using the
load library parameter.)
'====================================================================
[tt]
' $DYNAMIC
DEFINT A-Z
TYPE RegTypeX
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
DIM inregs AS RegTypeX, outregs AS RegTypeX
' Create a buffer large enough to hold 14 disk sectors
' (The floppy root directory can hold 224 files or folders...
' 224 * 32 bytes per entry = 7168 bytes
' 7168 / 512 bytes per sector = 14 sectors)
RootBuffer$ = STRING$(7168, 0)
' get the root directory entries and place them in RootBuffer$
FOR Re = 1 TO 4
inregs.DX = 0: inregs.AX = 0
CALL INTERRUPTX(&H13, inregs, outregs)
inregs.DX = &H100 'side 1, drive 0
inregs.ES = VARSEG(RootBuffer$)
inregs.BX = SADD(RootBuffer$)
inregs.AX = &H20E 'function 2, read 14 sectors
inregs.CX = 2 'starting at sector #2
CALL INTERRUPTX(&H13, inregs, outregs)
NEXT
CLS
' Read the file names and print them.
' You'll notice that the first file listed
' is the disk volume label (if any).
FOR Fi = 1 TO 7134 STEP 32
FileName$ = MID$(RootBuffer$, Fi, 11)
IF ASC(LEFT$(FileName$, 1)) < 32 THEN EXIT FOR
Ftmp$ = RTRIM$(LEFT$(FileName$, 8))
Etmp$ = RTRIM$(LTRIM$(RIGHT$(FileName$, 3)))
IF Etmp$ = "" THEN
FileName$ = Ftmp$
ELSE
FileName$ = Ftmp$ + "." + Etmp$
END IF
PRINT FileName$
NEXT
[/tt]
'====================================================================
not be the way to go. Versions of Windows more
advanced than Windows 98 object somewhat stenuously
to any attempt to access the disks directly, and
that is what you have to do in order to read the FAT.
If you insist on experimenting, here his a really
simple way to start reading the FAT (using QB45
or QB7). This only reads the very beginning of the
FAT (the root directory entries). It only prints
out the file names and it only works on the floppy
in drive A:
The file names are stored in the first 11 bytes of
each 32-byte entry. If you feel like decyphering
the remaning bytes and finding a way to chase the
FAT chain through the disk, feel free. But I think
the subject is beyond the scope of the Qbasic forum.
Copy some files to the floppy in A: and run this code:
(Requires Quick Basic started using the
load library parameter.)
'====================================================================
[tt]
' $DYNAMIC
DEFINT A-Z
TYPE RegTypeX
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
DIM inregs AS RegTypeX, outregs AS RegTypeX
' Create a buffer large enough to hold 14 disk sectors
' (The floppy root directory can hold 224 files or folders...
' 224 * 32 bytes per entry = 7168 bytes
' 7168 / 512 bytes per sector = 14 sectors)
RootBuffer$ = STRING$(7168, 0)
' get the root directory entries and place them in RootBuffer$
FOR Re = 1 TO 4
inregs.DX = 0: inregs.AX = 0
CALL INTERRUPTX(&H13, inregs, outregs)
inregs.DX = &H100 'side 1, drive 0
inregs.ES = VARSEG(RootBuffer$)
inregs.BX = SADD(RootBuffer$)
inregs.AX = &H20E 'function 2, read 14 sectors
inregs.CX = 2 'starting at sector #2
CALL INTERRUPTX(&H13, inregs, outregs)
NEXT
CLS
' Read the file names and print them.
' You'll notice that the first file listed
' is the disk volume label (if any).
FOR Fi = 1 TO 7134 STEP 32
FileName$ = MID$(RootBuffer$, Fi, 11)
IF ASC(LEFT$(FileName$, 1)) < 32 THEN EXIT FOR
Ftmp$ = RTRIM$(LEFT$(FileName$, 8))
Etmp$ = RTRIM$(LTRIM$(RIGHT$(FileName$, 3)))
IF Etmp$ = "" THEN
FileName$ = Ftmp$
ELSE
FileName$ = Ftmp$ + "." + Etmp$
END IF
PRINT FileName$
NEXT
[/tt]
'====================================================================
Here's a way to store some file information
in an array, using some of the code mentioned
in the previous thread.
This will store the filename, filesize, and
creation date and time in a user-defined data
type array.
(Should work with practically any QB version.)
'======================================================
[tt]
' $STATIC
DEFINT A-Z
TYPE FileInfo
Fname AS STRING * 12
Fsize AS LONG
Fdate AS STRING * 8
Ftime AS STRING * 6
END TYPE
REDIM Fi(1 TO 1) AS FileInfo
Cmd$ = ENVIRON$("COMSPEC"
Cmd$ = Cmd$ + " /c dir"
' Set the switches:
' /o:n = sort by file name
Cmd$ = Cmd$ + " /o:n"
' If you use any other switches you
' will probably have to adjust the
' way this program parses the directory
' listing. For instance, you might include
' the /4 switch to show four-digit years
' or /V to show additional information,
' such as disk allocation, modification
' and access dates and file attributes.
' In either case, you would have to
' examine the format of the DIR output
' and adjust the program accordingly.
Cmd$ = Cmd$ + "> mydir.tmp"
SHELL Cmd$
ff = FREEFILE
OPEN "mydir.tmp" FOR BINARY AS #ff
' The following is unfortunate...
' but it's hard to see how many lines
' in a text file without it.
' You could use the program with
' larger directories but you would
' have to open in for input and then
' read each line twice... once to count
' the lines and a second time to read them.
IF LOF(ff) > 32767 THEN
G$ = STRING$(32767, 32)
ELSE
G$ = STRING$(LOF(ff), 32)
END IF
GET #ff, 1, G$
CLOSE #ff
CrLf$ = CHR$(13) + CHR$(10)
Start = 1
' Count the lines in the file...
DO
NextCrlf = INSTR(Start, G$, CrLf$)
IF NextCrlf < 1 THEN EXIT DO
Start = NextCrlf + 2
LineCnt = LineCnt + 1
LOOP
' ...and use the count to
' dimension the array.
REDIM Fi(1 TO LineCnt - 9) AS FileInfo
' Read the lines sequentially...
ff = FREEFILE
OPEN "mydir.tmp" FOR INPUT AS #ff
' ...but pay no attention to the header.
FOR Re = 1 TO 7
LINE INPUT #ff, Header$
NEXT
Fcnt = 1
DO WHILE NOT EOF(ff)
LINE INPUT #ff, L$
IF RIGHT$(L$, 6) = " bytes" THEN
IF INSTR(L$, " file(s)" > 0 THEN
EXIT DO
END IF
END IF
' Parse the file name
Tmp1$ = LEFT$(L$, 12)
Tmp2$ = RTRIM$(LTRIM$(LEFT$(Tmp1$, 8)))
Tmp3$ = RTRIM$(LTRIM$(RIGHT$(Tmp1$, 3)))
IF Tmp3$ = "" THEN
Fi(Fcnt).Fname = Tmp2$
ELSE
Fi(Fcnt).Fname = Tmp2$ + "." + Tmp3$
END IF
' Parse the file size
Tmp1$ = LTRIM$(MID$(L$, 13, 14))
TmpLoc = INSTR(Tmp1$, ","
IF INSTR(Tmp1$, "<DIR>" THEN
'Its a directory, mark it
' for later purposes.
Fi(Fcnt).Fsize = -1
ELSE
IF TmpLoc < 1 THEN
Fi(Fcnt).Fsize = VAL(LTRIM$(Tmp1$))
ELSE
Tmp2$ = LEFT$(Tmp1$, TmpLoc - 1)
Tmp3$ = RIGHT$(Tmp1$, LEN(Tmp1$) - TmpLoc)
Fi(Fcnt).Fsize = VAL(LTRIM$(Tmp2$ + Tmp3$))
END IF
END IF
' Get the file date
Fi(Fcnt).Fdate = LTRIM$(MID$(L$, 27, 10))
' Get the file time
Fi(Fcnt).Ftime = LTRIM$(MID$(L$, 37, 7))
Fcnt = Fcnt + 1
LOOP
CLOSE #ff
' Clean up the temporary file
KILL "mydir.tmp"
' Print out your UDT array.
FOR Re = 1 TO UBOUND(Fi)
IF Fi(Re).Fsize > -1 THEN
' It's an ordinary file
PRINT Fi(Re).Fname,
PRINT Fi(Re).Fsize,
PRINT Fi(Re).Fdate,
PRINT Fi(Re).Ftime
ELSE
' It's a directory
PRINT Fi(Re).Fname,
PRINT "<DIRECTORY>",
PRINT Fi(Re).Fdate,
PRINT Fi(Re).Ftime
END IF
NEXT
[/tt]
'======================================================
in an array, using some of the code mentioned
in the previous thread.
This will store the filename, filesize, and
creation date and time in a user-defined data
type array.
(Should work with practically any QB version.)
'======================================================
[tt]
' $STATIC
DEFINT A-Z
TYPE FileInfo
Fname AS STRING * 12
Fsize AS LONG
Fdate AS STRING * 8
Ftime AS STRING * 6
END TYPE
REDIM Fi(1 TO 1) AS FileInfo
Cmd$ = ENVIRON$("COMSPEC"
Cmd$ = Cmd$ + " /c dir"
' Set the switches:
' /o:n = sort by file name
Cmd$ = Cmd$ + " /o:n"
' If you use any other switches you
' will probably have to adjust the
' way this program parses the directory
' listing. For instance, you might include
' the /4 switch to show four-digit years
' or /V to show additional information,
' such as disk allocation, modification
' and access dates and file attributes.
' In either case, you would have to
' examine the format of the DIR output
' and adjust the program accordingly.
Cmd$ = Cmd$ + "> mydir.tmp"
SHELL Cmd$
ff = FREEFILE
OPEN "mydir.tmp" FOR BINARY AS #ff
' The following is unfortunate...
' but it's hard to see how many lines
' in a text file without it.
' You could use the program with
' larger directories but you would
' have to open in for input and then
' read each line twice... once to count
' the lines and a second time to read them.
IF LOF(ff) > 32767 THEN
G$ = STRING$(32767, 32)
ELSE
G$ = STRING$(LOF(ff), 32)
END IF
GET #ff, 1, G$
CLOSE #ff
CrLf$ = CHR$(13) + CHR$(10)
Start = 1
' Count the lines in the file...
DO
NextCrlf = INSTR(Start, G$, CrLf$)
IF NextCrlf < 1 THEN EXIT DO
Start = NextCrlf + 2
LineCnt = LineCnt + 1
LOOP
' ...and use the count to
' dimension the array.
REDIM Fi(1 TO LineCnt - 9) AS FileInfo
' Read the lines sequentially...
ff = FREEFILE
OPEN "mydir.tmp" FOR INPUT AS #ff
' ...but pay no attention to the header.
FOR Re = 1 TO 7
LINE INPUT #ff, Header$
NEXT
Fcnt = 1
DO WHILE NOT EOF(ff)
LINE INPUT #ff, L$
IF RIGHT$(L$, 6) = " bytes" THEN
IF INSTR(L$, " file(s)"
> 0 THENEXIT DO
END IF
END IF
' Parse the file name
Tmp1$ = LEFT$(L$, 12)
Tmp2$ = RTRIM$(LTRIM$(LEFT$(Tmp1$, 8)))
Tmp3$ = RTRIM$(LTRIM$(RIGHT$(Tmp1$, 3)))
IF Tmp3$ = "" THEN
Fi(Fcnt).Fname = Tmp2$
ELSE
Fi(Fcnt).Fname = Tmp2$ + "." + Tmp3$
END IF
' Parse the file size
Tmp1$ = LTRIM$(MID$(L$, 13, 14))
TmpLoc = INSTR(Tmp1$, ","
IF INSTR(Tmp1$, "<DIR>"
THEN'Its a directory, mark it
' for later purposes.
Fi(Fcnt).Fsize = -1
ELSE
IF TmpLoc < 1 THEN
Fi(Fcnt).Fsize = VAL(LTRIM$(Tmp1$))
ELSE
Tmp2$ = LEFT$(Tmp1$, TmpLoc - 1)
Tmp3$ = RIGHT$(Tmp1$, LEN(Tmp1$) - TmpLoc)
Fi(Fcnt).Fsize = VAL(LTRIM$(Tmp2$ + Tmp3$))
END IF
END IF
' Get the file date
Fi(Fcnt).Fdate = LTRIM$(MID$(L$, 27, 10))
' Get the file time
Fi(Fcnt).Ftime = LTRIM$(MID$(L$, 37, 7))
Fcnt = Fcnt + 1
LOOP
CLOSE #ff
' Clean up the temporary file
KILL "mydir.tmp"
' Print out your UDT array.
FOR Re = 1 TO UBOUND(Fi)
IF Fi(Re).Fsize > -1 THEN
' It's an ordinary file
PRINT Fi(Re).Fname,
PRINT Fi(Re).Fsize,
PRINT Fi(Re).Fdate,
PRINT Fi(Re).Ftime
ELSE
' It's a directory
PRINT Fi(Re).Fname,
PRINT "<DIRECTORY>",
PRINT Fi(Re).Fdate,
PRINT Fi(Re).Ftime
END IF
NEXT
[/tt]
'======================================================
The following retrieves the directory information
without much cheating... that is, it gets the info
using the same method as the DOS DIR command
(using the Disk Transfer Area).
Sorry about the lack of in-line documentation but
the code is lengthy as it is. If you compile this
into something like MyDir.exe it will create a basic
display similar to the DIR command but it will only
accept the /P parameter (pause).
I didn't set this up to store the file information
in an array... but that shouldn't require much
thought for you hardcore Qbasic enthusiasts.
(Requires Quick Basic started using the
load library parameter.)
'===========================================================
[tt]
DEFINT A-Z
TYPE RegTypeX
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
TYPE DTAInfo
FiName AS STRING * 13
FiSize AS STRING * 10
FiDate AS STRING * 10
FiTime AS STRING * 10
FiAttrib AS STRING * 7
AttribNo AS LONG
FirstOrNext AS STRING * 1 '"F"=FirstMatchingFile "N"=Next
END TYPE
TYPE DiskInfo
BytesFree AS LONG
BytesTotal AS LONG
SecPerCluster AS INTEGER
AvailClusters AS LONG
SectorSize AS INTEGER
END TYPE
TYPE LabelInformation
SerialNumber AS STRING * 9
VolumeLabel AS STRING * 11
FileSystem AS STRING * 5
END TYPE
COMMON SHARED /Disco/ Disk AS DiskInfo, LabelInfo AS LabelInformation, DRIVE$, TotalSpace&, TotalFree&, PercentUsed&, TotalUsed&
DECLARE FUNCTION CurrentDrive$ ()
DECLARE SUB ParseDTA (InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo)
DECLARE FUNCTION VolumeLabel$ ()
DIM SHARED InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo
DEF SEG
COLOR 14, 1
Cmd$ = COMMAND$
IF Cmd$ = "" OR (LEN(Cmd$) = 2 AND INSTR(Cmd$, "/" > 0) THEN
InFileInfo.FiName = "*.*"
ELSE
InFileInfo.FiName = LTRIM$(RTRIM$(Cmd$))
Sp = INSTR(InFileInfo.FiName, " "
IF Sp > 0 THEN
InFileInfo.FiName = LEFT$(InFileInfo.FiName, Sp - 1)
END IF
END IF
IF RTRIM$(InFileInfo.FiName) = "" THEN
InFileInfo.FiName = "*.*"
END IF
Colon = INSTR(InFileInfo.FiName, ":"
IF Colon > 1 THEN
DRIVE$ = MID$(InFileInfo.FiName, Colon - 1, 1)
IF RIGHT$(RTRIM$(InFileInfo.FiName), 1) = ":" OR RIGHT$(RTRIM$(InFileInfo.FiName), 1) = "\" THEN
InFileInfo.FiName = RTRIM$(InFileInfo.FiName) + "*.*"
END IF
ELSE
DRIVE$ = CurrentDrive$
InFileInfo.FiName = DRIVE$ + ":" + InFileInfo.FiName
END IF
Vl$ = VolumeLabel$
Buff$ = STRING$(80, " "
InFileInfo.FirstOrNext = "F"
GetVol = -1
CALL ParseDTA(InFileInfo, OutFileInfo)
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) <> "" THEN
V$ = "Volume in Drive " + DRIVE$ + " is " + OutFileInfo.FiName
ELSE
V$ = "Volume in Drive " + DRIVE$ + " is UNLABELED"
END IF
InFileInfo.FirstOrNext = "N"
CALL ParseDTA(InFileInfo, OutFileInfo)
GetVol = 0
COLOR 14, 1
Buff$ = V$ + " Serial# is " + LabelInfo.SerialNumber + " File System: " + LabelInfo.FileSystem
PRINT Buff$;
DEF SEG
DirCount = 0
FileCount = 0
Bytes# = 0
InFileInfo.FirstOrNext = "F"
CALL ParseDTA(InFileInfo, OutFileInfo)
Buff$ = STRING$(80, " "
MID$(Buff$, 1) = OutFileInfo.FiName
MID$(Buff$, 16) = OutFileInfo.FiSize
MID$(Buff$, 29) = OutFileInfo.FiDate
MID$(Buff$, 42) = OutFileInfo.FiTime
MID$(Buff$, 54) = OutFileInfo.FiAttrib
PRINT Buff$;
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) <> "" THEN
IF LEFT$(OutFileInfo.FiAttrib, 3) <> "DIR" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "VOL" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "WIN" THEN
FileCount = FileCount + 1
END IF
IF INSTR(OutFileInfo.FiAttrib, "DIR" > 0 OR LEFT$(OutFileInfo.FiAttrib, 6) = "WINCRAP" THEN
IF LEFT$(OutFileInfo.FiName, 1) <> "." THEN
DirCount = DirCount + 1
END IF
END IF
ELSE
DEF SEG
PRINT "File not found... "; Cmd$
SYSTEM
END IF
Bytes# = Bytes# + VAL(OutFileInfo.FiSize)
DO
InFileInfo.FirstOrNext = "N"
CALL ParseDTA(InFileInfo, OutFileInfo)
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) = "" THEN
EXIT DO
ELSE
IF LEFT$(OutFileInfo.FiAttrib, 3) <> "DIR" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "VOL" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "WIN" THEN
FileCount = FileCount + 1
END IF
IF INSTR(OutFileInfo.FiAttrib, "DIR" > 0 OR LEFT$(OutFileInfo.FiAttrib, 6) = "WINCRAP" THEN
IF LEFT$(OutFileInfo.FiName, 1) <> "." THEN
DirCount = DirCount + 1
END IF
END IF
Bytes# = Bytes# + VAL(OutFileInfo.FiSize)
END IF
Buff$ = STRING$(80, " "
MID$(Buff$, 1) = OutFileInfo.FiName
MID$(Buff$, 16) = OutFileInfo.FiSize
MID$(Buff$, 29) = OutFileInfo.FiDate
MID$(Buff$, 42) = OutFileInfo.FiTime
MID$(Buff$, 54) = OutFileInfo.FiAttrib
PRINT Buff$;
IF INSTR(Cmd$, "/P" > 0 THEN
IF (FileCount + DirCount) > 15 THEN
IF ((FileCount + DirCount) / 23 = (FileCount + DirCount) \ 23 AND (FileCount + DirCount) <> 23) OR (FileCount + DirCount) = 20 THEN
COLOR 14, 1
PRINT "Press any key to Continue... Escape to stop.";
Paused = CSRLIN
IK$ = ""
DO WHILE IK$ = ""
I$ = INKEY$
IF I$ = CHR$(27) THEN
DEF SEG
COLOR 14, 1
LOCATE Paused, 1
PRINT "Visit the Tek-Tips Qbasic forum!"; STRING$(20, 32)
SYSTEM
END IF
IK$ = I$
LOOP
LOCATE Paused, 1
END IF
END IF
END IF
LOOP
DEF SEG
FUNCTION CurrentDrive$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H1900
CALL interrupt(&H21, inRegs, Outregs)
drivenum% = Outregs.AX MOD 256
CurrentDrive$ = CHR$(65 + drivenum%)
END FUNCTION
SUB ParseDTA (InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo)
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
IF UCASE$(InFileInfo.FirstOrNext) = "N" THEN GOTO FindNextFile2
FindFirstFile2:
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA% = Outregs.ES
OffDTA% = Outregs.BX
IF GetVol = 0 THEN
NameFile$ = InFileInfo.FiName + CHR$(0)
ELSE
NameFile$ = "*.*" + CHR$(0)
END IF
inRegs.DS = VARSEG(NameFile$)
inRegs.DX = SADD(NameFile$)
IF GetVol = 0 THEN
inRegs.CX = &HFF
ELSE
inRegs.CX = 8
END IF
inRegs.AX = &H4E00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
OutFileInfo.FiName = ""
EXIT SUB
END IF
IF UCASE$(InFileInfo.FirstOrNext) = "F" THEN GOTO GetDirInfo2
FindNextFile2:
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA% = Outregs.ES
OffDTA% = Outregs.BX
inRegs.AX = &H4F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
OutFileInfo.FiName = ""
EXIT SUB
END IF
GetDirInfo2:
DEF SEG = SegDTA%
NAMEMatch% = OffDTA% + 29
Temp$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(NAMEMatch% + I))
IF c$ = CHR$(0) THEN EXIT FOR
Temp$ = Temp$ + c$
NEXT I
OutFileInfo.FiName = Temp$
T1& = (PEEK(OffDTA% + 26))
T2& = (PEEK(OffDTA% + 27)) * 256&
t3& = (PEEK(OffDTA% + 28)) * &H10000
t4& = (PEEK(OffDTA% + 29)) * &H1000
OutFileInfo.FiSize = STR$(T1& + T2& + t3& + t4&)
Td& = (PEEK(OffDTA% + 25) * 256&) + PEEK(OffDTA% + 24)
Dnum& = Td&
tempno& = tempno& + PEEK(OffDTA% + 24)
Yr% = INT(Td& / 512) + 1980
Yr$ = LTRIM$(STR$(Yr%))
yrREM! = Td& MOD 512
Mn! = yrREM! / 32
Mn$ = RIGHT$(STR$(INT(Mn!)), 2)
IF LEFT$(Mn$, 1) = " " THEN Mn$ = RIGHT$(Mn$, LEN(Mn$) - 1)
Mn$ = STRING$(2 - LEN(Mn$), "0" + Mn$
Dy! = (Mn! - INT(Mn!)) * 32
Dy$ = RIGHT$(STR$(INT(Dy!)), 2)
IF LEFT$(Dy$, 1) = " " THEN Dy$ = RIGHT$(Dy$, LEN(Dy$) - 1)
Dy$ = STRING$(2 - LEN(Dy$), "0" + Dy$
OutFileInfo.FiDate = Mn$ + "-" + Dy$ + "-" + Yr$
DateTemp$ = Mn$ + "-" + Dy$ + "-" + Yr$
tempno& = PEEK(OffDTA% + 23) * 256&
tempno& = tempno& + PEEK(OffDTA% + 22)
Hours% = INT(tempno& / 2048)
Hours$ = RIGHT$(STR$(Hours%), 2)
IF LEFT$(Hours$, 1) = " " THEN Hours$ = RIGHT$(Hours$, LEN(Hours$) - 1)
Hours$ = STRING$(2 - LEN(Hours$), "0" + Hours$
Mins! = ((tempno& MOD 2048) / 32)
Mins$ = RIGHT$(STR$(INT(Mins!)), 2)
IF LEFT$(Mins$, 1) = " " THEN Mins$ = RIGHT$(Mins$, LEN(Mins$) - 1)
Mins$ = STRING$(2 - LEN(Mins$), "0" + Mins$
Secs! = INT((Mins! - INT(Mins!)) * 60)
Secs$ = RIGHT$(STR$(Secs!), 2)
IF LEFT$(Secs$, 1) = " " THEN Secs$ = RIGHT$(Secs$, LEN(Secs$) - 1)
Secs$ = STRING$(2 - LEN(Secs$), "0" + Secs$
OutFileInfo.FiTime = Hours$ + ":" + Mins$ + ":" + Secs$
FlAttrib% = PEEK(OffDTA% + 21)
NAMECOUNT% = 1
OutFileInfo.AttribNo = FlAttrib%
SELECT CASE FlAttrib%
CASE 0
OutFileInfo.FiAttrib = "NONE"
COLOR 14, 1
CASE 1
OutFileInfo.FiAttrib = "R"
COLOR 12, 1
CASE 2
OutFileInfo.FiAttrib = "H"
COLOR 15, 0
CASE 3
OutFileInfo.FiAttrib = "RH"
COLOR 15, 0
CASE 4
OutFileInfo.FiAttrib = "S"
COLOR 12, 1
CASE 5
OutFileInfo.FiAttrib = "RS"
COLOR 12, 1
CASE 6
OutFileInfo.FiAttrib = "SH"
COLOR 15, 0
CASE 7
OutFileInfo.FiAttrib = "RSH"
COLOR 15, 0
CASE 8
OutFileInfo.FiAttrib = "VOL"
COLOR 14, 3
CASE 16
OutFileInfo.FiAttrib = "DIR"
COLOR 14, 6
CASE 17
OutFileInfo.FiAttrib = "R DIR"
COLOR 12, 1
CASE 18
OutFileInfo.FiAttrib = "H DIR"
COLOR 15, 0
CASE 19
OutFileInfo.FiAttrib = "HR DIR"
COLOR 15, 0
CASE 32
OutFileInfo.FiAttrib = "A"
COLOR 14, 1
CASE 33
OutFileInfo.FiAttrib = "RA"
COLOR 12, 1
CASE 34
OutFileInfo.FiAttrib = "HA"
COLOR 15, 0
CASE 35
OutFileInfo.FiAttrib = "HAR"
COLOR 15, 0
CASE 36
OutFileInfo.FiAttrib = "SA"
COLOR 12, 1
CASE 37
OutFileInfo.FiAttrib = "SAR"
COLOR 12, 1
CASE 38
OutFileInfo.FiAttrib = "ASH"
COLOR 15, 0
CASE 39
OutFileInfo.FiAttrib = "ASHR"
COLOR 15, 0
CASE 40
OutFileInfo.FiAttrib = "WIN VOL"
COLOR 14, 3
CASE 48
OutFileInfo.FiAttrib = "A DIR"
COLOR 14, 1
CASE 49
OutFileInfo.FiAttrib = "AR DIR"
COLOR 12, 1
CASE 50
OutFileInfo.FiAttrib = "AH DIR"
COLOR 15, 0
CASE 51
OutFileInfo.FiAttrib = "AHR DIR"
COLOR 15, 0
CASE ELSE
OutFileInfo.FiAttrib = "WINCRAP"
COLOR 15, 4
END SELECT
DEF SEG
IF INSTR(OutFileInfo.FiAttrib, "DIR" THEN OutFileInfo.FiSize = "DIRECTORY"
END SUB
FUNCTION VolumeLabel$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
DIM B$(1 TO 5)
IF DRIVE$ = "" THEN DRIVE$ = "C"
d = ASC(DRIVE$) - 64
InfoBuffer$ = STRING$(128, 0)
inRegs.AX = &H6900
inRegs.BX = d
inRegs.DS = VARSEG(InfoBuffer$)
inRegs.DX = SADD(InfoBuffer$)
CALL INTERRUPTX(&H21, inRegs, Outregs)
Vl$ = InfoBuffer$
B$(1) = HEX$(ASC(MID$(Vl$, 6, 1)))
B$(2) = HEX$(ASC(MID$(Vl$, 5, 1)))
B$(3) = ":"
B$(4) = HEX$(ASC(MID$(Vl$, 4, 1)))
B$(5) = HEX$(ASC(MID$(Vl$, 3, 1)))
Sn$ = ""
FOR Re = 1 TO 5
IF Re <> 3 THEN
IF LEN(B$(Re)) < 2 THEN B$(Re) = "0" + B$(Re)
END IF
Sn$ = Sn$ + B$(Re)
NEXT
LabelInfo.SerialNumber = Sn$
LabelInfo.FileSystem = MID$(InfoBuffer$, 18, 5)
LabelInfo.VolumeLabel = MID$(InfoBuffer$, 7, 11)
DEF SEG
VolumeLabel$ = InfoBuffer$
END FUNCTION
[/tt]
'===========================================================
without much cheating... that is, it gets the info
using the same method as the DOS DIR command
(using the Disk Transfer Area).
Sorry about the lack of in-line documentation but
the code is lengthy as it is. If you compile this
into something like MyDir.exe it will create a basic
display similar to the DIR command but it will only
accept the /P parameter (pause).
I didn't set this up to store the file information
in an array... but that shouldn't require much
thought for you hardcore Qbasic enthusiasts.
(Requires Quick Basic started using the
load library parameter.)
'===========================================================
[tt]
DEFINT A-Z
TYPE RegTypeX
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
TYPE DTAInfo
FiName AS STRING * 13
FiSize AS STRING * 10
FiDate AS STRING * 10
FiTime AS STRING * 10
FiAttrib AS STRING * 7
AttribNo AS LONG
FirstOrNext AS STRING * 1 '"F"=FirstMatchingFile "N"=Next
END TYPE
TYPE DiskInfo
BytesFree AS LONG
BytesTotal AS LONG
SecPerCluster AS INTEGER
AvailClusters AS LONG
SectorSize AS INTEGER
END TYPE
TYPE LabelInformation
SerialNumber AS STRING * 9
VolumeLabel AS STRING * 11
FileSystem AS STRING * 5
END TYPE
COMMON SHARED /Disco/ Disk AS DiskInfo, LabelInfo AS LabelInformation, DRIVE$, TotalSpace&, TotalFree&, PercentUsed&, TotalUsed&
DECLARE FUNCTION CurrentDrive$ ()
DECLARE SUB ParseDTA (InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo)
DECLARE FUNCTION VolumeLabel$ ()
DIM SHARED InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo
DEF SEG
COLOR 14, 1
Cmd$ = COMMAND$
IF Cmd$ = "" OR (LEN(Cmd$) = 2 AND INSTR(Cmd$, "/"
> 0) THENInFileInfo.FiName = "*.*"
ELSE
InFileInfo.FiName = LTRIM$(RTRIM$(Cmd$))
Sp = INSTR(InFileInfo.FiName, " "
IF Sp > 0 THEN
InFileInfo.FiName = LEFT$(InFileInfo.FiName, Sp - 1)
END IF
END IF
IF RTRIM$(InFileInfo.FiName) = "" THEN
InFileInfo.FiName = "*.*"
END IF
Colon = INSTR(InFileInfo.FiName, ":"
IF Colon > 1 THEN
DRIVE$ = MID$(InFileInfo.FiName, Colon - 1, 1)
IF RIGHT$(RTRIM$(InFileInfo.FiName), 1) = ":" OR RIGHT$(RTRIM$(InFileInfo.FiName), 1) = "\" THEN
InFileInfo.FiName = RTRIM$(InFileInfo.FiName) + "*.*"
END IF
ELSE
DRIVE$ = CurrentDrive$
InFileInfo.FiName = DRIVE$ + ":" + InFileInfo.FiName
END IF
Vl$ = VolumeLabel$
Buff$ = STRING$(80, " "
InFileInfo.FirstOrNext = "F"
GetVol = -1
CALL ParseDTA(InFileInfo, OutFileInfo)
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) <> "" THEN
V$ = "Volume in Drive " + DRIVE$ + " is " + OutFileInfo.FiName
ELSE
V$ = "Volume in Drive " + DRIVE$ + " is UNLABELED"
END IF
InFileInfo.FirstOrNext = "N"
CALL ParseDTA(InFileInfo, OutFileInfo)
GetVol = 0
COLOR 14, 1
Buff$ = V$ + " Serial# is " + LabelInfo.SerialNumber + " File System: " + LabelInfo.FileSystem
PRINT Buff$;
DEF SEG
DirCount = 0
FileCount = 0
Bytes# = 0
InFileInfo.FirstOrNext = "F"
CALL ParseDTA(InFileInfo, OutFileInfo)
Buff$ = STRING$(80, " "
MID$(Buff$, 1) = OutFileInfo.FiName
MID$(Buff$, 16) = OutFileInfo.FiSize
MID$(Buff$, 29) = OutFileInfo.FiDate
MID$(Buff$, 42) = OutFileInfo.FiTime
MID$(Buff$, 54) = OutFileInfo.FiAttrib
PRINT Buff$;
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) <> "" THEN
IF LEFT$(OutFileInfo.FiAttrib, 3) <> "DIR" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "VOL" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "WIN" THEN
FileCount = FileCount + 1
END IF
IF INSTR(OutFileInfo.FiAttrib, "DIR"
> 0 OR LEFT$(OutFileInfo.FiAttrib, 6) = "WINCRAP" THENIF LEFT$(OutFileInfo.FiName, 1) <> "." THEN
DirCount = DirCount + 1
END IF
END IF
ELSE
DEF SEG
PRINT "File not found... "; Cmd$
SYSTEM
END IF
Bytes# = Bytes# + VAL(OutFileInfo.FiSize)
DO
InFileInfo.FirstOrNext = "N"
CALL ParseDTA(InFileInfo, OutFileInfo)
IF RTRIM$(LTRIM$(OutFileInfo.FiName)) = "" THEN
EXIT DO
ELSE
IF LEFT$(OutFileInfo.FiAttrib, 3) <> "DIR" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "VOL" AND LEFT$(OutFileInfo.FiAttrib, 3) <> "WIN" THEN
FileCount = FileCount + 1
END IF
IF INSTR(OutFileInfo.FiAttrib, "DIR"
> 0 OR LEFT$(OutFileInfo.FiAttrib, 6) = "WINCRAP" THENIF LEFT$(OutFileInfo.FiName, 1) <> "." THEN
DirCount = DirCount + 1
END IF
END IF
Bytes# = Bytes# + VAL(OutFileInfo.FiSize)
END IF
Buff$ = STRING$(80, " "
MID$(Buff$, 1) = OutFileInfo.FiName
MID$(Buff$, 16) = OutFileInfo.FiSize
MID$(Buff$, 29) = OutFileInfo.FiDate
MID$(Buff$, 42) = OutFileInfo.FiTime
MID$(Buff$, 54) = OutFileInfo.FiAttrib
PRINT Buff$;
IF INSTR(Cmd$, "/P"
> 0 THENIF (FileCount + DirCount) > 15 THEN
IF ((FileCount + DirCount) / 23 = (FileCount + DirCount) \ 23 AND (FileCount + DirCount) <> 23) OR (FileCount + DirCount) = 20 THEN
COLOR 14, 1
PRINT "Press any key to Continue... Escape to stop.";
Paused = CSRLIN
IK$ = ""
DO WHILE IK$ = ""
I$ = INKEY$
IF I$ = CHR$(27) THEN
DEF SEG
COLOR 14, 1
LOCATE Paused, 1
PRINT "Visit the Tek-Tips Qbasic forum!"; STRING$(20, 32)
SYSTEM
END IF
IK$ = I$
LOOP
LOCATE Paused, 1
END IF
END IF
END IF
LOOP
DEF SEG
FUNCTION CurrentDrive$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H1900
CALL interrupt(&H21, inRegs, Outregs)
drivenum% = Outregs.AX MOD 256
CurrentDrive$ = CHR$(65 + drivenum%)
END FUNCTION
SUB ParseDTA (InFileInfo AS DTAInfo, OutFileInfo AS DTAInfo)
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
IF UCASE$(InFileInfo.FirstOrNext) = "N" THEN GOTO FindNextFile2
FindFirstFile2:
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA% = Outregs.ES
OffDTA% = Outregs.BX
IF GetVol = 0 THEN
NameFile$ = InFileInfo.FiName + CHR$(0)
ELSE
NameFile$ = "*.*" + CHR$(0)
END IF
inRegs.DS = VARSEG(NameFile$)
inRegs.DX = SADD(NameFile$)
IF GetVol = 0 THEN
inRegs.CX = &HFF
ELSE
inRegs.CX = 8
END IF
inRegs.AX = &H4E00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
OutFileInfo.FiName = ""
EXIT SUB
END IF
IF UCASE$(InFileInfo.FirstOrNext) = "F" THEN GOTO GetDirInfo2
FindNextFile2:
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA% = Outregs.ES
OffDTA% = Outregs.BX
inRegs.AX = &H4F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
OutFileInfo.FiName = ""
EXIT SUB
END IF
GetDirInfo2:
DEF SEG = SegDTA%
NAMEMatch% = OffDTA% + 29
Temp$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(NAMEMatch% + I))
IF c$ = CHR$(0) THEN EXIT FOR
Temp$ = Temp$ + c$
NEXT I
OutFileInfo.FiName = Temp$
T1& = (PEEK(OffDTA% + 26))
T2& = (PEEK(OffDTA% + 27)) * 256&
t3& = (PEEK(OffDTA% + 28)) * &H10000
t4& = (PEEK(OffDTA% + 29)) * &H1000
OutFileInfo.FiSize = STR$(T1& + T2& + t3& + t4&)
Td& = (PEEK(OffDTA% + 25) * 256&) + PEEK(OffDTA% + 24)
Dnum& = Td&
tempno& = tempno& + PEEK(OffDTA% + 24)
Yr% = INT(Td& / 512) + 1980
Yr$ = LTRIM$(STR$(Yr%))
yrREM! = Td& MOD 512
Mn! = yrREM! / 32
Mn$ = RIGHT$(STR$(INT(Mn!)), 2)
IF LEFT$(Mn$, 1) = " " THEN Mn$ = RIGHT$(Mn$, LEN(Mn$) - 1)
Mn$ = STRING$(2 - LEN(Mn$), "0"
+ Mn$Dy! = (Mn! - INT(Mn!)) * 32
Dy$ = RIGHT$(STR$(INT(Dy!)), 2)
IF LEFT$(Dy$, 1) = " " THEN Dy$ = RIGHT$(Dy$, LEN(Dy$) - 1)
Dy$ = STRING$(2 - LEN(Dy$), "0"
+ Dy$OutFileInfo.FiDate = Mn$ + "-" + Dy$ + "-" + Yr$
DateTemp$ = Mn$ + "-" + Dy$ + "-" + Yr$
tempno& = PEEK(OffDTA% + 23) * 256&
tempno& = tempno& + PEEK(OffDTA% + 22)
Hours% = INT(tempno& / 2048)
Hours$ = RIGHT$(STR$(Hours%), 2)
IF LEFT$(Hours$, 1) = " " THEN Hours$ = RIGHT$(Hours$, LEN(Hours$) - 1)
Hours$ = STRING$(2 - LEN(Hours$), "0"
+ Hours$Mins! = ((tempno& MOD 2048) / 32)
Mins$ = RIGHT$(STR$(INT(Mins!)), 2)
IF LEFT$(Mins$, 1) = " " THEN Mins$ = RIGHT$(Mins$, LEN(Mins$) - 1)
Mins$ = STRING$(2 - LEN(Mins$), "0"
+ Mins$Secs! = INT((Mins! - INT(Mins!)) * 60)
Secs$ = RIGHT$(STR$(Secs!), 2)
IF LEFT$(Secs$, 1) = " " THEN Secs$ = RIGHT$(Secs$, LEN(Secs$) - 1)
Secs$ = STRING$(2 - LEN(Secs$), "0"
+ Secs$OutFileInfo.FiTime = Hours$ + ":" + Mins$ + ":" + Secs$
FlAttrib% = PEEK(OffDTA% + 21)
NAMECOUNT% = 1
OutFileInfo.AttribNo = FlAttrib%
SELECT CASE FlAttrib%
CASE 0
OutFileInfo.FiAttrib = "NONE"
COLOR 14, 1
CASE 1
OutFileInfo.FiAttrib = "R"
COLOR 12, 1
CASE 2
OutFileInfo.FiAttrib = "H"
COLOR 15, 0
CASE 3
OutFileInfo.FiAttrib = "RH"
COLOR 15, 0
CASE 4
OutFileInfo.FiAttrib = "S"
COLOR 12, 1
CASE 5
OutFileInfo.FiAttrib = "RS"
COLOR 12, 1
CASE 6
OutFileInfo.FiAttrib = "SH"
COLOR 15, 0
CASE 7
OutFileInfo.FiAttrib = "RSH"
COLOR 15, 0
CASE 8
OutFileInfo.FiAttrib = "VOL"
COLOR 14, 3
CASE 16
OutFileInfo.FiAttrib = "DIR"
COLOR 14, 6
CASE 17
OutFileInfo.FiAttrib = "R DIR"
COLOR 12, 1
CASE 18
OutFileInfo.FiAttrib = "H DIR"
COLOR 15, 0
CASE 19
OutFileInfo.FiAttrib = "HR DIR"
COLOR 15, 0
CASE 32
OutFileInfo.FiAttrib = "A"
COLOR 14, 1
CASE 33
OutFileInfo.FiAttrib = "RA"
COLOR 12, 1
CASE 34
OutFileInfo.FiAttrib = "HA"
COLOR 15, 0
CASE 35
OutFileInfo.FiAttrib = "HAR"
COLOR 15, 0
CASE 36
OutFileInfo.FiAttrib = "SA"
COLOR 12, 1
CASE 37
OutFileInfo.FiAttrib = "SAR"
COLOR 12, 1
CASE 38
OutFileInfo.FiAttrib = "ASH"
COLOR 15, 0
CASE 39
OutFileInfo.FiAttrib = "ASHR"
COLOR 15, 0
CASE 40
OutFileInfo.FiAttrib = "WIN VOL"
COLOR 14, 3
CASE 48
OutFileInfo.FiAttrib = "A DIR"
COLOR 14, 1
CASE 49
OutFileInfo.FiAttrib = "AR DIR"
COLOR 12, 1
CASE 50
OutFileInfo.FiAttrib = "AH DIR"
COLOR 15, 0
CASE 51
OutFileInfo.FiAttrib = "AHR DIR"
COLOR 15, 0
CASE ELSE
OutFileInfo.FiAttrib = "WINCRAP"
COLOR 15, 4
END SELECT
DEF SEG
IF INSTR(OutFileInfo.FiAttrib, "DIR"
THEN OutFileInfo.FiSize = "DIRECTORY"END SUB
FUNCTION VolumeLabel$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
DIM B$(1 TO 5)
IF DRIVE$ = "" THEN DRIVE$ = "C"
d = ASC(DRIVE$) - 64
InfoBuffer$ = STRING$(128, 0)
inRegs.AX = &H6900
inRegs.BX = d
inRegs.DS = VARSEG(InfoBuffer$)
inRegs.DX = SADD(InfoBuffer$)
CALL INTERRUPTX(&H21, inRegs, Outregs)
Vl$ = InfoBuffer$
B$(1) = HEX$(ASC(MID$(Vl$, 6, 1)))
B$(2) = HEX$(ASC(MID$(Vl$, 5, 1)))
B$(3) = ":"
B$(4) = HEX$(ASC(MID$(Vl$, 4, 1)))
B$(5) = HEX$(ASC(MID$(Vl$, 3, 1)))
Sn$ = ""
FOR Re = 1 TO 5
IF Re <> 3 THEN
IF LEN(B$(Re)) < 2 THEN B$(Re) = "0" + B$(Re)
END IF
Sn$ = Sn$ + B$(Re)
NEXT
LabelInfo.SerialNumber = Sn$
LabelInfo.FileSystem = MID$(InfoBuffer$, 18, 5)
LabelInfo.VolumeLabel = MID$(InfoBuffer$, 7, 11)
DEF SEG
VolumeLabel$ = InfoBuffer$
END FUNCTION
[/tt]
'===========================================================
The following is a good way to simply list
the file names according to a file
specification. It only returns the names
but, more often than not, that is all
that's required
(Requires Quick Basic started using the
load library parameter.)
'=========================================================
[tt]
DEFINT A-Z
TYPE RegTypeX
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
DECLARE FUNCTION GetFirstMatchingFile$ (FileSpec$, Attrib)
DECLARE FUNCTION GetNextMatchingFile$ ()
CLS
FileSpec$ = "*.bas"
Attrib = 0
' Get the first file that matches the FileSpec$
Fi$ = GetFirstMatchingFile$(FileSpec$, Attrib)
IF Fi$ <> "" THEN
' Get the rest of them.
DO WHILE Fi$ <> ""
PRINT Fi$
Cnt = Cnt + 1
Fi$ = GetNextMatchingFile$
LOOP
END IF
PRINT Cnt; "files"
FUNCTION GetFirstMatchingFile$ (FileSpec$, Attrib)
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA = Outregs.ES
OffDTA = Outregs.BX
NameFile$ = FileSpec$ + CHR$(0)
inRegs.DS = VARSEG(NameFile$)
inRegs.DX = SADD(NameFile$)
inRegs.CX = Attrib
inRegs.AX = &H4E00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
GetFirstMatchingFile$ = ""
EXIT FUNCTION
END IF
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT I
DEF SEG
GetFirstMatchingFile$ = Match$
END FUNCTION
FUNCTION GetNextMatchingFile$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA = Outregs.ES
OffDTA = Outregs.BX
inRegs.AX = &H4F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
GetNextMatchingFile$ = ""
EXIT FUNCTION
END IF
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT I
DEF SEG
GetNextMatchingFile$ = Match$
END FUNCTION
'=========================================================
[/tt]
the file names according to a file
specification. It only returns the names
but, more often than not, that is all
that's required
(Requires Quick Basic started using the
load library parameter.)
'=========================================================
[tt]
DEFINT A-Z
TYPE RegTypeX
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
DECLARE FUNCTION GetFirstMatchingFile$ (FileSpec$, Attrib)
DECLARE FUNCTION GetNextMatchingFile$ ()
CLS
FileSpec$ = "*.bas"
Attrib = 0
' Get the first file that matches the FileSpec$
Fi$ = GetFirstMatchingFile$(FileSpec$, Attrib)
IF Fi$ <> "" THEN
' Get the rest of them.
DO WHILE Fi$ <> ""
PRINT Fi$
Cnt = Cnt + 1
Fi$ = GetNextMatchingFile$
LOOP
END IF
PRINT Cnt; "files"
FUNCTION GetFirstMatchingFile$ (FileSpec$, Attrib)
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA = Outregs.ES
OffDTA = Outregs.BX
NameFile$ = FileSpec$ + CHR$(0)
inRegs.DS = VARSEG(NameFile$)
inRegs.DX = SADD(NameFile$)
inRegs.CX = Attrib
inRegs.AX = &H4E00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
GetFirstMatchingFile$ = ""
EXIT FUNCTION
END IF
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT I
DEF SEG
GetFirstMatchingFile$ = Match$
END FUNCTION
FUNCTION GetNextMatchingFile$
DIM inRegs AS RegTypeX, Outregs AS RegTypeX
inRegs.AX = &H2F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
SegDTA = Outregs.ES
OffDTA = Outregs.BX
inRegs.AX = &H4F00
CALL INTERRUPTX(&H21, inRegs, Outregs)
IF Outregs.Flags AND 1 THEN
GetNextMatchingFile$ = ""
EXIT FUNCTION
END IF
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT I
DEF SEG
GetNextMatchingFile$ = Match$
END FUNCTION
'=========================================================
[/tt]
Guest_imported
New member
- Jan 1, 1970
- 0
- 0
- 0
On the other hand - if you are using QBasic version 4.5 -then just look up the DIR$ command.
- Thread starter
- #13
Alt255:
I have verified that DIR$ is INFACT in QBx (or "QB 7.x" or "QuickBASIC PDS" or whatever is the current terminology).
--MiggyD It's better to have two heads to solve a problem from different angles than to have tunnel vision to a dead end.
I have verified that DIR$ is INFACT in QBx (or "QB 7.x" or "QuickBASIC PDS" or whatever is the current terminology).
--MiggyD It's better to have two heads to solve a problem from different angles than to have tunnel vision to a dead end.
- Status
