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

DEFINT A-Z
'$INCLUDE: 'DIR.BI' '***DirSubs header file***

FUNCTION FreeSpace& (FCurrentDrive AS INTEGER)
'*** Return free disk space of drive as pointed to by FCurrentDrive ***
'*** Where 0 = default, 1=A, 2=B, 3=C etc. ***

Dregs.AX = &H3600
Dregs.DX = FCurrentDrive
CALL InterruptX(&H21, Dregs, Dregs) '***Get bytes free***
FreeSpace& = CLNG(Dregs.AX) * Dregs.BX * Dregs.CX

END FUNCTION

FUNCTION GetCurrentDrive%
'*** Returns default drive number ***

Dregs.AX = &H1900
CALL InterruptX(&H21, Dregs, Dregs)
GetCurrentDrive% = (Dregs.AX AND 255) + 1 '***A=1, B=2. C=3 etc.***

END FUNCTION

FUNCTION GetNumberOfDrives
'***Returns number of drives or LASTDRIVE whichever is greater***

CurrentDrive = GetCurrentDrive% '*** Save current logged drive ***
Dregs.AX = &HE00
Dregs.DX = 0 '*** Set to drive A (all pc's should have) ***
CALL InterruptX(&H21, Dregs, Dregs)
GetNumberOfDrives = (Dregs.AX AND 15)
Dregs.AX = &HE00
Dregs.DX = CurrentDrive - 1 '*** Restore drive to default ***
CALL InterruptX(&H21, Dregs, Dregs)

END FUNCTION

FUNCTION GetVolumeName$ (VDir$)
'***Returns volume name of disk referenced by VDir$)

DIM FileSpec AS STRING * 60
FileSpec = VDir$ + "*.*" + CHR$(0)

Dregs.DS = VARSEG(DInfo) '*** Set Pointers to temporary storage array ***
Dregs.DX = VARPTR(DInfo)
Dregs.AX = &H1A00 '*** Interrupt $21, Function $1A ***
CALL InterruptX(&H21, Dregs, Dregs) '*** Set disk xfer address ***
Dregs.AX = &H4E00 '*** Find First entry ***
Dregs.CX = 8 '*** Only Volume Name returned ***
VSEG% = VARSEG(FileSpec) '*** Set pointers to FileSpec ***
VPTR% = VARPTR(FileSpec)

DoneFlag = FALSE
DO
Dregs.DS = VSEG%
Dregs.DX = VPTR%
CALL InterruptX(&H21, Dregs, Dregs) '***1st time AX=$4E (find 1st entry) ***
IF (Dregs.FLAGS AND 1) = FALSE THEN '***Entry is found***
IF (ASC(DInfo.ATT) AND 8) = 8 THEN
VolumeName$ = DInfo.FName
Period = INSTR(DInfo.FName, ".")
IF Period <> 0 THEN
VolumeName$ = LEFT$(DInfo.FName, Period - 1) + MID$(DInfo.FName, Period + 1, LEN(DInfo.FName))
ELSE
VolumeName$ = DInfo.FName
END IF
GetVolumeName$ = LEFT$(VolumeName$, INSTR(VolumeName$, CHR$(0)) - 1)
DoneFlag = True '***If found then quit looking ***
END IF
Dregs.AX = &H4F00 '***Read next entry***
ELSE
DoneFlag = True '***No more entries***
END IF
LOOP UNTIL DoneFlag = True

END FUNCTION

DEFSNG A-Z
FUNCTION ReadDir& (RDIR$, RFTYPE$)

'*** READS DIRECTORY INTO TD.Info() ARRAY ***
'*** Returns the number of files found ***
'*** RDIR$=directory path..must end with \ or left blank for current***
'*** RFTYPE$=parameters such as *.* ***

DIM FileSpec AS STRING * 60
FileSpec = RDIR$ + RFTYPE$ + CHR$(0)

FI = 0

Dregs.DS = VARSEG(DInfo) '*** Set Pointers to temporary storage array ***
Dregs.DX = VARPTR(DInfo)
Dregs.AX = &H1A00 '*** Interrupt $21, Function $1A ***
CALL InterruptX(&H21, Dregs, Dregs) '***Set disk xfer address ***
Dregs.AX = &H4E00 '*** Find First entry ***
Dregs.CX = 55 '*** Set to 0 to not include directories ***
VSEG% = VARSEG(FileSpec) '*** Set pointers to FileSpec ***
VPTR% = VARPTR(FileSpec)

DoneFlag = FALSE
DO
Dregs.DS = VSEG%
Dregs.DX = VPTR%
CALL InterruptX(&H21, Dregs, Dregs) '***1st time AX=$4E (find 1st entry) ***
IF (Dregs.FLAGS AND 1) = FALSE THEN '***Entry is found***
FI = FI + 1
'***Get filename***
F$ = DInfo.FName
TDInfo(FI).FName = LEFT$(F$, INSTR(F$, CHR$(0)) - 1)
TDInfo(FI).Date = " - - "
TDInfo(FI).Time = " : : "
'***Assemble date***
MID$(TDInfo(FI).Date, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 480) \ 32)), 2)
MID$(TDInfo(FI).Date, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Date AND 31))), 2)
MID$(TDInfo(FI).Date, 7, 4) = LTRIM$(STR$((DInfo.Date AND 65024) \ 512 + 1980))
'***Assemble Time***
MID$(TDInfo(FI).Time, 1, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 63488) \ 2048)), 2)
MID$(TDInfo(FI).Time, 4, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 2016) \ 32)), 2)
MID$(TDInfo(FI).Time, 7, 2) = RIGHT$("0" + LTRIM$(STR$((DInfo.Time AND 31))), 2)
'***Get filesize***'
TDInfo(FI).Size = DInfo.Size
'***Set attributes***
TDInfo(FI).D = (ASC(DInfo.ATT) AND 16) = 16
TDInfo(FI).R = (ASC(DInfo.ATT) AND 1) = 1
TDInfo(FI).A = (ASC(DInfo.ATT) AND 32) = 32
TDInfo(FI).S = (ASC(DInfo.ATT) AND 4) = 4
TDInfo(FI).H = (ASC(DInfo.ATT) AND 2) = 2
IF TDInfo(FI).S = True OR TDInfo(FI).H = True THEN
'***Make System or Hidden files lower case***
TDInfo(FI).FName = LCASE$(TDInfo(FI).FName)
'FI = FI - 1 '***Remove REM to not display System/Hidden files***
END IF
Dregs.AX = &H4F00 '***Read next entry***
ELSE
DoneFlag = True '***No more entries***
END IF
LOOP UNTIL DoneFlag = True
ReadDir = FI '***Return number of entries found***
END FUNCTION

SUB SortDir (SNumberOfFiles AS INTEGER)
'***SORT DIRECTORY BY FILENAME (SHELL SORT)***
'***Sorts in ascending order***

'***Set number of passes required to sort array***
IF SNumberOfFiles = 0 THEN
TPASS = 0
ELSE
TPASS = INT(LOG(SNumberOfFiles) / LOG(2))
END IF

MidPoint = SNumberOfFiles

'***SORT DIRECTORY***
FOR L = 1 TO TPASS
MidPoint = MidPoint \ 2
FOR I = MidPoint TO SNumberOfFiles - 1
FOR J = (I - MidPoint + 1) TO 1 STEP -MidPoint
IF (UCASE$(TDInfo(J).FName) > UCASE$(TDInfo(J + MidPoint).FName)) THEN
'***Put directories at top of listing***
IF TDInfo(J).D = True AND TDInfo(J + MidPoint).D = FALSE THEN
EXIT FOR
ELSE
SWAP TDInfo(J), TDInfo(J + MidPoint)
END IF
ELSE
IF TDInfo(J).D = FALSE AND TDInfo(J + MidPoint).D = True THEN
SWAP TDInfo(J), TDInfo(J + MidPoint)
ELSE
EXIT FOR
END IF
END IF
NEXT J
NEXT I
NEXT L
'*********************

END SUB