'===========================================================================
' Subject: FILE/DIRECTORY ROUTINES            Date: 07-04-97 (12:23)       
'  Author: Hans Lunsing                       Code: QB, PDS                
'  Origin: FidoNet QUIK_BAS Echo            Packet: DOS.ABC
'===========================================================================
' >> I'm watching fuer a Source oder LIB to search for a file on
' >> the HD eg. TEST.BAS Have anybody already coded one ?!

'Here is something with which you can do it.

'With DirFirst you get the first file or directory with matching name and
'attributes, if there is one (remember, for directories bit 4 must be 1
'(...1....)). Afterwards you get the next files or directories by
'repeatedly calling DirNext. After each call you can get information
'about the file or directory by calling GetFileInfo. DirEntry is an added
'function to check if a certain directory entry (can be a file,
'directory, or a device as a printer port or com port) exists, and what
'type it is.

' Dir.Bas
' Freeware by Hans Lunsing
' e-mail jlunsing@doge.nl
'-----------------------------------------------------------------------
DEFINT A-Z
'$INCLUDE: 'QB.BI'

' DIR.BI,
' include file with DIR.BAS
' Freeware by Hans Lunsing
' e-mail jlunsing@doge.nl
'-----------------------------------------------------------------------

' DOS structure for file info
TYPE DOSFileInfo
  fiReserved            AS STRING * 21  'for DOS' internal use
  fiAttribute           AS STRING * 1   'file attribute code
  fiFileTime            AS INTEGER      'file time (in DOS format)
  fiFileDate            AS INTEGER      'file date (in DOS format)
  fiSize                AS LONG         'file size (in bytes)
  fiFileName            AS STRING * 13  'file name (without path)
END TYPE

' Type directory entry:
CONST IsNONE = 0                'directory entry doesn't exist
CONST IsFILE = 1                'is a file
CONST IsDIRECTORY = 2           'is a directory
CONST IsDEVICE = 3              'is a device
CONST IsVOLUME = 4              'is a volume label

' Maximum length of directory path in DOS
CONST MAXDOSPATH = 67

' Bit value of carry bit in flags register
CONST CARRY = 1

' Boolean values
CONST FALSE = 0, TRUE = -1

DECLARE FUNCTION DirEntry% (Entry AS STRING)
DECLARE FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER)
DECLARE FUNCTION DirNext$ ()
DECLARE SUB GetFileInfo (pFileInfo AS DOSFileInfo)
DECLARE SUB SetDTA (FileInfo AS DOSFileInfo)

' Named common block with DOS error code
COMMON SHARED /DOSError/ DOSError AS INTEGER

DIM SHARED FileInfo AS DOSFileInfo

FUNCTION DirEntry% (Entry AS STRING)
'----------------------------------------------------------------------
' Establishes if a directory entry exists and returns type of entry
' (file, subdirectory or device).
' Type of directory entry returned by the function is one of the
' following values:
' 0  (IsNONE     )
' 1  (IsFILE     )
' 2  (IsDIRECTORY)
' 3  (IsDEVICE   )

' Examples:
' FileExist = (DirEntry(FileName$) = IsFILE)
' DirExist = (DirEntry(FileName$) = IsDIRECTORY)
'----------------------------------------------------------------------
  DIM fiAttrib AS INTEGER
  DIM Temp AS STRING
  Temp$ = DirFirst$(Entry, &H77)   'attribute for everything except label
  IF LEN(Temp$) THEN
    fiAttrib = ASC(FileInfo.fiAttribute)
    IF fiAttrib AND &H40 THEN
      DirEntry% = IsDEVICE
    ELSEIF fiAttrib AND &H10 THEN
      DirEntry% = IsDIRECTORY
    ELSE
      DirEntry% = IsFILE
    END IF
  ELSE
    DirEntry% = IsNONE
  END IF
END FUNCTION

FUNCTION DirFirst$ (Mask AS STRING, Attrib AS INTEGER)
'----------------------------------------------------------------------
' Gets the first file name with matching mask and attributes
' If an error is encountered the function returns "" as its value.
'----------------------------------------------------------------------
  DIM MaskZ AS STRING
  DIM Reg   AS RegTypeX
  DIM Zero  AS INTEGER
  MaskZ = Mask + CHR$(0)
  SetDTA FileInfo                       ' Set up FileInfo as DTA
  FileInfo.fiFileName = STRING$(13, 0)  ' Clean the data structure
  Reg.ax = &H4E00
  ' search attributes including read-only files
  Reg.cx = Attrib OR 1
  Reg.ds = VARSEG(MaskZ)                ' address of file mask
  Reg.dx = SADD(MaskZ)
  CALL INTERRUPTX(&H21, Reg, Reg)
  IF (Reg.flags AND CARRY) THEN         ' if error
    DOSError = Reg.ax                   ' error number in DOSError
    DirFirst$ = ""
  ELSE
    DOSError = 0
    Zero = INSTR(FileInfo.fiFileName, CHR$(0))
    DirFirst$ = LEFT$(FileInfo.fiFileName, Zero - 1)  ' the file name
  END IF
END FUNCTION

FUNCTION DirNext$
'----------------------------------------------------------------------
' Gets the next file name with matching mask and attributes.
' If an error is encountered the function returns "" as its value.
'----------------------------------------------------------------------
  DIM Reg   AS RegTypeX
  DIM Zero  AS INTEGER
  FileInfo.fiFileName = STRING$(13, 0)  ' Clean the data structure
  Reg.ax = &H4F00
  CALL INTERRUPTX(&H21, Reg, Reg)
  IF (Reg.flags AND CARRY) THEN         ' if error
    DOSError = Reg.ax                   ' error number in DOSError
    DirNext$ = ""
  ELSE
    DOSError = 0
    Zero = INSTR(FileInfo.fiFileName, CHR$(0))
    DirNext$ = LEFT$(FileInfo.fiFileName, Zero - 1)  ' the file name
  END IF
END FUNCTION

SUB GetFileInfo (pFileInfo AS DOSFileInfo)
'----------------------------------------------------------------------
' Gets FileInfo about file which name was returned by DirFirst/DirNext
'----------------------------------------------------------------------
  pFileInfo = FileInfo
END SUB

SUB SetDTA (FileInfo AS DOSFileInfo)
'----------------------------------------------------------------------
' Sets up FileInfo as Disk Transfer Area
'----------------------------------------------------------------------
  DIM Reg AS RegTypeX
  Reg.ax = &H1A00
  Reg.ds = VARSEG(FileInfo)
  Reg.dx = VARPTR(FileInfo)
  CALL INTERRUPTX(&H21, Reg, Reg)
END SUB