'===========================================================================
' Subject: FILE FUNCTIONS                     Date: 05-26-98 (17:00)       
'  Author: Leandro Pardini                    Code: QB, QBasic, PDS        
'  Origin: lpardini@cefex.com               Packet: DOS.ABC
'===========================================================================
'==========================================================================
'SetDta, FindFirst and FindNext routines for QBASIC             05-31-1998
'==========================================================================
'
'SUB SetDta    Sets the Disk Transfer Area address to the DiskTransferArea
'              shared variable. This  MUST be done BEFORE use FindFirst or
'              FindNext. Inputs: none.
'
'FUNCTION FindFirst  Searchs for specified file(s) using an attribute mask
'                    and returns standard error codes. Inputs: Filename to
'                    look for (wilcards allowed) and attribute mask.
'
'FUNCTION FindNext   Continues the previous search. Inputs: none.
'
'==========================================================================
'                                         | I like mail, so contact me for
'__________   ____---____                 | any  doubt or  suggestion  you
'\_________D /-/---_----'            LL&P | have for this/another program,
'       _H__/_/           Leandro Pardini | for  get my  last routines, to
'      '-_____|(       lpardini@cefex.com | chat  about  computers  and/or
'                                         | programming or to say "Hello".
'==========================================================================

'$STATIC
DEFINT A-Z

DECLARE SUB SetDTA ()
DECLARE FUNCTION FindFirst% (File AS STRING, Attr AS INTEGER)
DECLARE FUNCTION FindNext% ()

CONST Arc = 32 'Archive
CONST Dir = 16 'Directory
CONST Vol = 8  'Volume label
CONST Sys = 4  'System
CONST Hid = 2  'Hidden
CONST RO = 1   'Read Only

DIM SHARED DiskTransferArea AS STRING * 44

'***** DEMO CODE STARTS HERE *****

CLS

SetDTA
ErrNum% = FindFirst("*.*", Arc + Dir + Vol + Sys + Hid + RO)

PRINT "Filename      Size       Arc  Sys  Hid  R/O  Dir  Vol"
PRINT "------------  ---------  ---  ---  ---  ---  ---  ---";

WHILE ErrNum% = 0
   File$ = MID$(DiskTransferArea, 31)
   File$ = LEFT$(File$, INSTR(File$, CHR$(0)) - 1)
   Size& = CVL(MID$(DiskTransferArea, 27, 4))
   LOCATE , 1
   PRINT
   PRINT File$;
   LOCATE , 15
   PRINT USING "########,"; Size&;
   Attr% = ASC(MID$(DiskTransferArea, 22, 1))
   IF Attr% AND 32 THEN LOCATE , 26: PRINT "Arc";
   IF Attr% AND 4 THEN LOCATE , 31: PRINT "Sys";
   IF Attr% AND 2 THEN LOCATE , 36: PRINT "Hid";
   IF Attr% AND 1 THEN LOCATE , 41: PRINT "R/O";
   IF Attr% AND 16 THEN LOCATE , 46: PRINT "Dir";
   IF Attr% AND 8 THEN LOCATE , 51: PRINT "Vol";
   ErrNum% = FindNext
WEND

PRINT

'========================================================<lpardini@cefex.com>=
'Find First Matching File.
'=============================================================================
FUNCTION FindFirst% (File AS STRING, Attr AS INTEGER)

DIM AsmCode AS STRING * 28
DIM FileName AS STRING * 64
DIM ErrCode AS INTEGER

FileName = File + CHR$(0)

MID$(AsmCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(FileName))
MID$(AsmCode, 4, 1) = CHR$(&H1F)
MID$(AsmCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(FileName))
MID$(AsmCode, 8, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4E)
MID$(AsmCode, 11, 3) = CHR$(&HB9) + MKI$(Attr)
MID$(AsmCode, 14, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(AsmCode, 16, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(AsmCode, 19, 1) = CHR$(&H1F)
MID$(AsmCode, 20, 2) = CHR$(&H72) + CHR$(&H2)
MID$(AsmCode, 22, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(AsmCode, 24, 1) = CHR$(&H3E)
MID$(AsmCode, 25, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(AsmCode, 28, 1) = CHR$(&HCB)

DEF SEG = VARSEG(AsmCode): CALL ABSOLUTE(VARPTR(AsmCode)): DEF SEG

FindFirst% = ErrCode

END FUNCTION

'========================================================<lpardini@cefex.com>=
'Find Next Matching File.
'=============================================================================
FUNCTION FindNext%

DIM AsmCode AS STRING * 18
DIM ErrCode AS INTEGER

MID$(AsmCode, 1, 3) = CHR$(&HB8) + CHR$(&H0) + CHR$(&H4F)
MID$(AsmCode, 4, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(AsmCode, 6, 3) = CHR$(&H68) + MKI$(VARSEG(ErrCode))
MID$(AsmCode, 9, 1) = CHR$(&H1F)
MID$(AsmCode, 10, 2) = CHR$(&H72) + CHR$(&H2)
MID$(AsmCode, 12, 2) = CHR$(&H33) + CHR$(&HC0)
MID$(AsmCode, 14, 1) = CHR$(&H3E)
MID$(AsmCode, 15, 3) = CHR$(&HA3) + MKI$(VARPTR(ErrCode))
MID$(AsmCode, 18, 1) = CHR$(&HCB)

DEF SEG = VARSEG(AsmCode): CALL ABSOLUTE(VARPTR(AsmCode)): DEF SEG

FindNext% = ErrCode

END FUNCTION

'========================================================<lpardini@cefex.com>=
'Sets the Disk Transfer Area address to our shared DiskTransferArea variable.
'=============================================================================
SUB SetDTA

DIM AsmCode AS STRING * 12

MID$(AsmCode, 1, 3) = CHR$(&H68) + MKI$(VARSEG(DiskTransferArea))
MID$(AsmCode, 4, 1) = CHR$(&H1F)
MID$(AsmCode, 5, 3) = CHR$(&HBA) + MKI$(VARPTR(DiskTransferArea))
MID$(AsmCode, 8, 2) = CHR$(&HB4) + CHR$(&H1A)
MID$(AsmCode, 10, 2) = CHR$(&HCD) + CHR$(&H21)
MID$(AsmCode, 12, 1) = CHR$(&HCB)

DEF SEG = VARSEG(AsmCode): CALL ABSOLUTE(VARPTR(AsmCode)): DEF SEG

END SUB