'===========================================================================
' Subject: GET DIRECTORY SCAN Date: 02-07-96 (20:00)
' Author: Mark K. Kim Code: QB, QBasic, PDS
' Origin: MarkKKim@aol.com Packet: DOS.ABC
'===========================================================================
'BASDir version 1.0a -- directory scan
'Copyright (c)1995-6 Mark K. Kim
'E-mail: MarkKKim@aol.com
'http://users.aol.com/markkkim/
'* Freely distributed. May be used in other programs with proper notice of
' credit.
'* This program is provided "as-is".
'* Not compatible with PowerBASIC.
'* In QuickBASIC 4.5, run QB.EXE with /L option. If including QB.BI, then
' replace the ABSOLUTE SUB declaration statement in QB.BI with the ABSOLUTE
' SUB declaration within this program. Make other proper revisions.
'* CREDIT: Ralf Brown's interrupt list was used to get interrupt for the
' function. Microsoft DOS's Debug was used to convert Assembly code to
' machine code. Microsoft is a Registered Trademark of Microsoft Corp.
' Thanks to beta testers, rt911@aol.com and wildgamer@aol.com
'Read the header of each function to find out the usage of those functions.
'These functions are designed to work with most other routines as it does
'not interfere with any other routines. It is especially designed to work
'with other functions in this BASxx series.
DECLARE SUB absolute (var1%, var2%, var3%, var4%, var5%, var6%, offset%)
'== BEGIN HEADER ==
TYPE FileStruct
attrib AS INTEGER
filedate AS STRING * 10
filetime AS STRING * 8
filesize AS DOUBLE
END TYPE
CONST F.NOR = &H200 'constant for "normal" files (*files* displayed with DIR)
CONST F.NON = &H100 'constant for files without any attribute
CONST F.ARC = &H20 'constant for archive file attribute
CONST F.DIR = &H10 'constant for directory file attribute
CONST F.VOL = &H8 'constant for volume file attribute
CONST F.SYS = &H4 'constant for system file attribute
CONST F.HID = &H2 'constant for hidden file attribute (may return directory)
CONST F.RDO = &H1 'constant for read-only file attribute
CONST F.ANY = &H0 'constant for any of the above
DECLARE SUB dir.init (path$, attrib%) 'call first to initialize
DECLARE FUNCTION dir.find$ () 'call next to get filenames
DECLARE SUB dir.fileinfo (file AS FileStruct) 'call to get file information
'== END HEADER ==
'== START ==
CLS
INPUT "drive and/or directory to scan (ie - C:\DOS\): ", dir$
IF dir$ = "" THEN dir$ = "."
IF RIGHT$(dir$, 1) <> "\" THEN dir$ = dir$ + "\"
dir$ = dir$ + "*.*"
dir.init dir$, F.ANY
DIM info AS FileStruct
DO
i% = i% + 1
filename$ = dir.find$
dir.fileinfo info
IF filename$ <> "" THEN
PRINT USING "\ \"; filename$;
PRINT USING " #########"; info.filesize;
PRINT " " + info.filedate$ + " " + info.filetime$;
PRINT " ";
ELSE EXIT DO
END IF
IF info.attrib AND F.ARC THEN PRINT "A";
IF info.attrib AND F.DIR THEN PRINT "D";
IF info.attrib AND F.VOL THEN PRINT "V";
IF info.attrib AND F.SYS THEN PRINT "S";
IF info.attrib AND F.HID THEN PRINT "H";
IF info.attrib AND F.RDO THEN PRINT "R";
PRINT
LOOP
'Finds the detailed information about the most recently obtained file by
'the
function.
'INPUT & RETURN:
'* file is a FileTruct TYPE to store the information in, where the following
' are returned:
' * file.attrib holds the attribute of the file, or the error code if any
' error has occured during the last FUNCTION operation, where
' the error codes are:
' * &h02 = file not found
' * &h03 = path not found
' * &h12 = no more files
' Whether an error has occured or not can be determined by checking the
' name of the file returned -- if the name has no length (""), then an
' error has occured (or no more files were to be found.)
' * file.filedate$ holds the date of the file creation/revision.
' * file.filetime$ holds the time of the file creation/revision.
' * file.filesize$ holds the size of the file.
' Size of a file may be a negative number of the file is several hundred
' megabytes long, but a chance of that happening is miniscuously small.
'EXAMPLE:
' 'Make a place to store detailed information about the file.
' DIM fileinfo AS FileStruct
' 'initialize and set pattern for the file search
' dir.init "C:\DOS\*.*", F.ANY
' 'get the file name and store information in SUB
' filename$ = dir.find$
' 'get the detailed information from SUB
' dir.fileinfo fileinfo
' 'print the information to the screen
' PRINT "File name: "; dir.find$
' PRINT "File date: "; fileinfo.filedate$
' PRINT "File time: "; fileinfo.filetime$
' PRINT "File size: "; fileinfo.filesize
' PRINT "File attributes:"
' IF fileinfo.attrib AND F.DIR THEN PRINT "Directory"
' IF fileinfo.attrib AND F.HID THEN PRINT "Hidden"
' IF fileinfo.attrib AND F.VOL THEN PRINT "Volume Label"
' IF fileinfo.attrib AND F.ARC THEN PRINT "Archive"
' IF fileinfo.attrib AND F.SYS THEN PRINT "System"
' IF fileinfo.attrib AND F.RDO THEN PRINT "Read-Only"
' END
SUB dir.fileinfo (file AS FileStruct)
'== SHARED VARIABLE ==
SHARED dirfileinfo AS FileStruct
file = dirfileinfo
END SUB
'Scans for files in a directory
'RETURN:
'* Name of the file/directory is returned.
'* A string with nothing in it ("") will be returned upon error. Error codes
' are obtainable through SUB's attribute.
'* Returned error codes (returned by SUB):
' * &h02 = file not found
' * &h03 = path not found
' * &h12 = no more files
'COMMENT:
'* If dir.find$ is called again, the name of the next file is returned. The
' user can look for files in a different directory or attributes can restart
' the search by calling on function again.
'* Details of the found file can be obtained by calling on SUB
' right after finding the file.
'EXAMPLE:
'* There is an example on top of in commented form.
FUNCTION dir.find$
'== SHARED VARIABLES ==
'general
SHARED dirfileinfo AS FileStruct
SHARED dircount AS INTEGER
'control variables
SHARED dir.attrib AS INTEGER
SHARED dir.path AS STRING
'machine language routines
SHARED DTAseg AS INTEGER, DTAoff AS INTEGER
SHARED findfirst$
SHARED findnext$
IF dircount = -1 THEN
pathseg% = VARSEG(dir.path)
pathoff% = SADD(dir.path)
asmseg% = VARSEG(findfirst$)
asmoff% = SADD(findfirst$)
DEF SEG = asmseg%
CALL absolute(dummy%, dummy%, dummy%, pathseg%, pathoff%, &HFF, asmoff%)
DEF SEG
dircount = 0
ELSEIF dircount = 0 THEN pathseg% = 1 'simulate error
ELSE
pathseg% = VARSEG(dir.path)
pathoff% = SADD(dir.path)
asmseg% = VARSEG(findnext$)
asmoff% = SADD(findnext$)
DEF SEG = asmseg%
CALL absolute(dummy%, dummy%, dummy%, dummy%, pathseg%, pathoff%, asmoff%)
DEF SEG
END IF
'check for errors
IF pathseg% THEN 'error existance is returned through pathseg%
dir.find$ = ""
dirfileinfo.attrib = pathoff% 'error code is stored in pathoff%
dirfileinfo.filedate = "00-00-0000"
dirfileinfo.filetime = "00:00:00"
ELSE
DO
'get attribute of the file found
DEF SEG = DTAseg
attrib% = PEEK(DTAoff + &H15)
DEF SEG
'exit conditions:
IF ((dir.attrib AND &H200) = &H200) AND ((attrib% AND &H21) = (attrib% AND &H3F)) THEN EXIT DO
IF ((dir.attrib AND &H100) = &H100) AND ((attrib% AND &H3F) = 0) THEN EXIT DO
IF (dir.attrib AND &H3F) AND (attrib% AND &H3F) THEN EXIT DO
IF (dir.attrib AND &H3F) = 0 THEN EXIT DO
'find next until right attributes are found
pathseg% = VARSEG(dir.path)
pathoff% = SADD(dir.path)
asmseg% = VARSEG(findnext$)
asmoff% = SADD(findnext$)
DEF SEG = asmseg%
CALL absolute(dummy%, dummy%, dummy%, dummy%, pathseg%, pathoff%, asmoff%)
DEF SEG
IF pathseg% THEN 'error existance is returned through pathseg%
dir.find$ = ""
dirfileinfo.attrib = pathoff% 'error code is stored in pathoff%
dirfileinfo.filedate = "00-00-000"
dirfileinfo.filetime = "00:00:00"
EXIT FUNCTION
END IF
LOOP
'get name of the file found
filename$ = SPACE$(13)
FOR i% = 0 TO 12
DEF SEG = DTAseg
ch% = PEEK(DTAoff + &H1E + i%)
DEF SEG = VARSEG(filename$)
POKE SADD(filename$) + i%, ch%
DEF SEG
NEXT i%
'find location of CHR$(0) and get only up to that point
dir.find$ = LEFT$(filename$, INSTR(filename$, CHR$(0)))
'get attribute of the file found
DEF SEG = DTAseg
dirfileinfo.attrib = PEEK(DTAoff + &H15)
DEF SEG
'get the file's date
DEF SEG = DTAseg
filedate& = (PEEK(DTAoff + &H19) AND &H7F) * &H100 + PEEK(DTAoff + &H18)
IF (PEEK(DTAoff + &H19) AND &H80) THEN filedate& = filedate& OR &H8000
fileyear$ = LTRIM$(STR$((filedate& AND &HFE00) / &H200 + 1980))
filemonth$ = LTRIM$(STR$((filedate& AND &H1E0) / &H20))
IF LEN(filemonth$) < 2 THEN filemonth$ = "0" + filemonth$ 'align
fileday$ = LTRIM$(STR$(filedate& AND &H1F))
IF LEN(fileday$) < 2 THEN fileday$ = "0" + fileday$ 'align
DEF SEG
dirfileinfo.filedate$ = filemonth$ + "-" + fileday$ + "-" + fileyear$
'get the file's time
DEF SEG = DTAseg
filetime& = (PEEK(DTAoff + &H17) AND &H7F) * &H100 + PEEK(DTAoff + &H16)
IF (PEEK(DTAoff + &H17) AND &H80) THEN filetime& = filetime& OR &H8000
filehour& = (filetime& AND &H7800) / &H800
IF (filetime& AND &H8000) THEN filehour& = filehour& OR &H10
filehour$ = LTRIM$(STR$(filehour&))
IF LEN(filehour$) < 2 THEN filehour$ = "0" + filehour$ 'align
filemin$ = LTRIM$(STR$((filetime& AND &H7E0) / &H20))
IF LEN(filemin$) < 2 THEN filemin$ = "0" + filemin$ 'align
filesec$ = LTRIM$(STR$((filetime& AND &H1F) * 2))
IF LEN(filesec$) < 2 THEN filesec$ = "0" + filesec$ 'align
DEF SEG
dirfileinfo.filetime$ = filehour$ + ":" + filemin$ + ":" + filesec$
'get filesize
DEF SEG = DTAseg
filesize& = (PEEK(DTAoff + &H1D) AND &H7F) * &H1000000
filesize& = filesize& + PEEK(DTAoff + &H1C) * &H10000
filesize& = filesize& + PEEK(DTAoff + &H1B) * &H100&
filesize& = filesize& + PEEK(DTAoff + &H1A) * &H1
IF (PEEK(DTAoff + &H1D) AND &H80) THEN filesize& = filesize& OR &H8000
dirfileinfo.filesize = filesize&
DEF SEG
END IF
dircount = dircount + 1
END FUNCTION
'Initializes the "dir" family functions (dir.init, dir.find$, dir.fileinfo)
'COMMENT:
'* This function is also used to "reset" the search "patterns" used by
' .
'INPUT:
'* path.o$ is the file parameter to scan for. Wildcards okay.
'* attrib.o% is the attribute to look for, where:
' * &h200 is for "normal" files that are displayed from DOS by simple "DIR"
' command. This call is handled through the function.
' * &h100 is for files without any attributes. This call is also handled
' through the function.
' * &h20 is for archive files. This is handled by DOS (sort of).
' * &h10 if for directories. This is also handled by DOS (once again, sort
' of).
' * &h8 is for file that stands for the volume label. This could be used on
' the root directory of each drive to find out the name of the drive, but
' the information may not always be accurate in that there is a second
' copy of volume label in the boot sector which is the "real thing". The
' file with the volume attribute is sort of like "shadow" of the real
' thing. However, any major or proper program will modify both volume
' labels.
' * &h4 is for files with system attribute. Handled by DOS. System files
' also appear to be hidden.
' * &h2 is for files with hidden attribute. Handled by DOS.
' * &h1 is for read-only files. Handled by DOS.
' * &h0 is for any of the above files. Handled by the function.
' Combination of these attributes can be made (ie - &h06 for hidden system
' files.)
' When a file name is returned through function, file with ANY
' of the above specs will be returned. For instance, if the user specifies
' a hidden file, a file with hidden attribute AND any other ones will be
' returned. (That's why I made the "normal" attribute)
'EXAMPLE:
'* There is an example on top of in commented form.
SUB dir.init (path.o$, attrib.o%)
'== SHARED VARIABLES ==
'general
SHARED dirfileinfo AS FileStruct
SHARED dircount AS INTEGER
'control variables
SHARED dir.attrib AS INTEGER
SHARED dir.path AS STRING
'machine language routines
SHARED DTAseg AS INTEGER, DTAoff AS INTEGER
SHARED findfirst$
SHARED findnext$
'== INITIALIZATION ==
dircount = -1
dir.attrib = attrib.o%
dir.path = path.o$ + CHR$(0)
'== get DTA address ==
'initialize machine language code to get DTA address
asm$ = ""
asm$ = asm$ + CHR$(&H55) 'push bp DTA
asm$ = asm$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, sp DTA
asm$ = asm$ + CHR$(&HB4) + CHR$(&H2F) 'mov ah, 2f DTA
asm$ = asm$ + CHR$(&HCD) + CHR$(&H21) 'int 21 DTA
asm$ = asm$ + CHR$(&H89) + CHR$(&HD8) 'mov ax, bx DTA
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] DTA
asm$ = asm$ + CHR$(&H8C) + CHR$(&H7) 'mov [bx], es DTA
asm$ = asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06] DTA
asm$ = asm$ + CHR$(&H89) + CHR$(&H7) 'mov [bx], ax DTA
asm$ = asm$ + CHR$(&H5D) 'pop bp DTA
asm$ = asm$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0) 'retf 0004 DTA
'get segment and offsets
asmseg% = VARSEG(asm$)
asmoff% = SADD(asm$)
'execute
DEF SEG = asmseg%
CALL absolute(dummy%, dummy%, dummy%, dummy%, DTAseg, DTAoff, asmoff%)
DEF SEG
'== FIND FIRST ==
'initialize machine language code
findfirst$ = ""
findfirst$ = findfirst$ + CHR$(&H55) 'push bp F1st
findfirst$ = findfirst$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, sp F1st
findfirst$ = findfirst$ + CHR$(&HB4) + CHR$(&H4E) 'mov ah, 4e F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] F1st
findfirst$ = findfirst$ + CHR$(&H8E) + CHR$(&H1F) 'mov ds, [bx] F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx] F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06] F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx] F1st
findfirst$ = findfirst$ + CHR$(&HCD) + CHR$(&H21) 'int 21 F1st
findfirst$ = findfirst$ + CHR$(&HB9) + CHR$(&H0) + CHR$(&H0) 'mov cx, 0000 F1st
findfirst$ = findfirst$ + CHR$(&H80) + CHR$(&HD1) + CHR$(&H0) 'adc cl, 00 F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a] F1st
findfirst$ = findfirst$ + CHR$(&H89) + CHR$(&HF) 'mov [bx], cx F1st
findfirst$ = findfirst$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] F1st
findfirst$ = findfirst$ + CHR$(&H89) + CHR$(&H7) 'mov [bx], ax F1st
findfirst$ = findfirst$ + CHR$(&H5D) 'pop bp F1st
findfirst$ = findfirst$ + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'retf 0006 F1st
'== FIND NEXT ==
'initialize machine language code
findnext$ = ""
findnext$ = findnext$ + CHR$(&H55) 'push bp FNxt
findnext$ = findnext$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, sp FNxt
findnext$ = findnext$ + CHR$(&HB4) + CHR$(&H4F) 'mov ah, 4f FNxt
findnext$ = findnext$ + CHR$(&HCD) + CHR$(&H21) 'int 21 FNxt
findnext$ = findnext$ + CHR$(&HB9) + CHR$(&H0) + CHR$(&H0) 'mov cx, 0000 FNxt
findnext$ = findnext$ + CHR$(&H80) + CHR$(&HD1) + CHR$(&H0) 'adc cl, 00 FNxt
findnext$ = findnext$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08] FNxt
findnext$ = findnext$ + CHR$(&H89) + CHR$(&HF) 'mov [bx], cx FNxt
findnext$ = findnext$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06] FNxt
findnext$ = findnext$ + CHR$(&H89) + CHR$(&H7) 'mov [bx], ax FNxt
findnext$ = findnext$ + CHR$(&H5D) 'pop bp FNxt
findnext$ = findnext$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0) 'retf 0004 FNxt
END SUB