Power-Programmierung/CD1.mdf/basic/library/tb/dosstuff/dosstuff.bas

BASIC Source File | 1989-01-26 | 15.5 KB | 597 lines

'  Disclaimer:
'    Use these routines at your own risk.  I do not accept any liability
'  for ANY problems that may occur from using these routines.
'
'  Now that I have that out of the way....
'
'  These functions are provided to complement the functions of Turbo Basic.
'  While Turbo Basic provides many convenient functions, they seem to have
'  missed a few important ones.  You can, for example, use CHDIR to change
'  the current directory, but Turbo Basic gives you no way to determine or
'  return to the directory that was active when the program was run.
'
'  I also like knowing whether or not a given file exists before I begin
'  any file I/O on that file.  With the FindFirst and FindNext functions, you
'  can build a string containing the entire directory ... this is useful
'  in many applications.  These routines were written using Turbo Basic
'  keywords and functions instead of as inline assembler in order to give
'  you an example of how to use Turbo Basic more effectively.  Note that
'  similar routines written as inline assembler would run LOTS faster.
'
'  Brett Jones, 01/18/89
'
'  Turbo Basic is a registered trademark of Borland International.


Rem ++
Rem
Rem    Begin Module DOSSTUFF
Rem
Rem
Rem    Purpose:
Rem        Turbo Basic routines to allow more complete access to
Rem        Disk Directories, Paths and Files.
Rem
Rem    Routines:
Rem        FnExist%    - Verify that a file exists on a disk
Rem                  before attempting I/O.
Rem        FnCurrDrive$    - Return a single character describing
Rem                  the currently logged in disk drive.
Rem        FnFreeSpace    - Return the amount of free space available
Rem                  on any valid disk.
Rem        FnFindFirst$    - Returns the first file in a directory that
Rem                  matches a user defined mask.
Rem        FnFindNext$    - Returns subsequent files matching a user
Rem                  defined mask after using FnFindFirst$.
Rem        FnVol$        - Returns the volume label for a disk.
Rem        FnDosVer#    - Returns the current DOS version number.
Rem        FnCurrDir$    - Returns the current directory.
Rem
Rem    Environment:
Rem        Turbo Basic
Rem
Rem    Author:            Creation Date:
Rem        Brett Jones        01/15/89
Rem
Rem    Modified By:
Rem        1, Brett Jones, 01/15/89 - Original
Rem
Rem --


Def FnExist%(f$)
  local strseg,aseg,aptr,temp,a%,b%,a$


  rem  Written by Brett Jones
  rem  01/17/89 - Original
  rem
  rem  determine if file f$ exists
  rem  works by checking for file attributes
  rem  requires dos 2.0 and above

  def seg                    ' set default segment
  strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment

  a$ = ucase$(f$) + chr$(0)            ' make f$ asciiz

  aseg = varseg(a$)                ' segment for string pointer
  aptr = varptr(a$)                ' pointer to string descriptor

  def seg=aseg                    ' set segment
  temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename

  reg 1,&h4300                    ' ah = 43h (CHMOD function)
                        ' al = 00h (get attributes)
  reg 8,strseg                    ' ds = string segment
  reg 4,temp                      ' dx = string offset

  call interrupt &h21                ' perform dos call

  a% = reg(1)                    ' a% = ax
  b% = reg(3)                    ' b% = cx

  if a% = 2 or a% = 3 or a% = 5 then FnExist% = -1 else FnExist% = b%

  rem  2 = file not found
  rem  3 = path not found
  rem  5 = access denied

  def seg                    ' reset segment

End Def



Def FnCurrDrive$
  local ta$,ta%

  rem  Written by  Brett Jones
  rem  01/17/89 - Original
  rem
  rem  FnCurrDrive$ returns a single character drive identifier which
  rem  specifies the current drive in use.
  rem  This function can be used with any version of dos.

  reg 1,&h1900            ' ah = 19h (report current drive)
  call interrupt &h21        ' perform dos interrupt

  ta$ = mki$(reg(1))        ' ta$ = 2 character string of ax
  ta% = asc(left$(ta$,1))    ' ta% = al

  FnCurrDrive$ = chr$(ta% + 65)    ' return drive as a string {A..Z}

End Def



Def FnFreeSpace(drive%)
  local ra,rb,rc

  rem  Written by  Brett Jones
  rem  01/17/89 - Original
  rem
  rem  FnFreeSpace will return the number of free bytes available
  rem  on drive 'drive%'.  If 'drive%' does not exist, then this
  rem  function will return a -1.
  rem  FnFreeSpace requires dos 2.00 or above.

  reg 1,&h3600            ' ah = 36h (get free space)
  reg 4,drive%            ' dl = drive number (0 = default)
  call interrupt &h21        ' perform dos interrupt

  ra = reg(1)            ' ra = ax (sectors per cluster or error)

  if ra = &hffff then fnfreespace = -1 : exit def ' exit if error occurs

  rb = reg(2)            ' rb = number of available clusters
  rc = reg(3)            ' rc = bytes per sector
                  ' reg(4) {dx} contains total number of clusters

  FnFreeSpace = (ra * rb * rc)

End Def



Def FnFindFirst$(f$)
  local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,dtaatt,c$,c%,lp%

  rem  Written by  Brett Jones
  rem  01/17/89 - Original
  rem
  rem  FnFindFirst$ finds the first file that matches the mask
  rem  'f$'.  'f$' can contain wildcard characters {* and ?}.
  rem  'f$' is any valid path + filename.  If FnFindfirst$ does not
  rem  find a file, it will return a null string.
  rem  Requires dos 2.00 and above.


  rem  Format of the DTA after a file has been found:
  rem
  rem  Offset     Size(bytes)    Description
  rem       0        21          Used by DOS for find next
  rem      21         1          Attribute of file found
  rem      22         2          Time Stamp of file
  rem      24         2          Date Stamp of file
  rem      26         4          File size in bytes
  rem      30        13          Filename and extension (asciiz)
  rem
  rem  Attributes:
  rem    bit    0    - Read Only
  rem        1    - Hidden
  rem        2    - System
  rem        3    - Volume Label
  rem        4    - Subdirectory
  rem        5    - Archive
  rem        6    - Unused
  rem        7    - Unused
  rem
  rem  Time = Hour * 2048 + Minute * 32 + Second / 2
  rem  Date = (Year - 1980) * 512 + Month * 32 + Day
  rem
  rem  Filesize is a 4 byte unsigned integer


  def seg                    ' set default segment
  strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment

  if f$ = null$ then f$ = "*.*"            ' avoid trying to find nothing
  a$ = ucase$(f$) + chr$(0)            ' make f$ asciiz

  aseg = varseg(a$)                ' segment for string pointer
  aptr = varptr(a$)                ' pointer to string descriptor

  def seg=aseg                    ' set segment
  temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename

  reg 1,&h4E00                    ' ah = 4E (find first)
                        ' al = 00h
  reg 3,23                    ' cx = 23 (all but vol label)
  reg 8,strseg                    ' ds = string segment
  reg 4,temp                      ' dx = string offset

  call interrupt &h21                ' perform dos call

                        ' abort on errors
  if reg(1) = 2 or reg(1) = 18 then fnfindfirst$ = null$ : exit def

  reg 1,&h2F00                    ' ah = 2F (Get DTA)
  call interrupt &h21                ' perform dos call

  dtaseg = reg(9)                ' DTA segment = ES
  dtaatt = reg(2) + 21                ' offset of attributes
  dtaoff = reg(2) + 30                ' offset of filename

  c$ = null$                    ' prepare to retrieve filename

  def seg=dtaseg                ' set segment = DTA segment

  for lp% = 0 to 12                ' retrieve filename
    c% = peek(dtaoff + lp%)            ' from DTA
    if c% = 0 then exit for
    c$ = c$ + chr$(peek(dtaoff + lp%))
  next lp%

  if (peek(dtaatt) and 16) = 16 then c$ = "\"+c$ ' indicate subdirectories

  def seg                    ' reset segment to default

  fnfindfirst$ = c$

End Def


Def FnFindNext$
  local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,dtaatt,c$,c%,lp%

  rem  Written by  Brett Jones
  rem  01/17/89 - Original
  rem
  rem  FnFindNext$ finds the next file that matches the mask
  rem  used with FnFindFirst$.  FnFindFirst$ MUST have been called prior
  rem  to using FnFindNext$.  If FnFindNext$ does not find any matching
  rem  files, then a null string will be returned.
  rem  Repeat FnFindNext$ until a null string is returned to find ALL
  rem  files that match the mask.
  rem  Requires dos 2.00 and above.

  reg 1,&h4F00                    ' ah = 4E (find first)
                        ' al = 00h

  call interrupt &h21                ' perform dos call

                        ' return if error/no files
  if reg(1) = 18 then fnfindnext$ = null$ : exit def

  reg 1,&h2F00                    ' ah = 2F (Get DTA)
  call interrupt &h21                ' perform dos call

  dtaseg = reg(9)                ' DTA segment = ES
  dtaatt = reg(2) + 21                ' offset of attributes
  dtaoff = reg(2) + 30                ' filename offset

  c$ = null$                    ' prepare to transfer filename
  def seg=dtaseg                ' set segment to DTA segment

  for lp% = 0 to 12                ' retrieve filename
    c% = peek(dtaoff + lp%)            ' from DTA
    if c% = 0 then exit for
    c$ = c$ + chr$(peek(dtaoff + lp%))
  next lp%

  if (peek(dtaatt) and 16) = 16 then c$ = "\"+c$ ' indicate subdirectories

  def seg                    ' restore default segment

  fnfindnext$ = c$

End Def


Def FnVol$
  local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,c$,c%,lp%

  rem  Written by  Brett Jones
  rem  01/19/89 - Original
  rem
  rem  FnVol$ locates the volume label of a disk.
  rem  If FnVol$ does not find a file, it will return a null string.
  rem  Requires dos 2.00 and above.


  def seg                    ' set default segment
  strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment

  a$ = "*.*" + chr$(0)                ' make a$ asciiz

  aseg = varseg(a$)                ' segment for string pointer
  aptr = varptr(a$)                ' pointer to string descriptor

  def seg=aseg                    ' set segment
  temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename

  reg 1,&h4E00                    ' ah = 4E (find first)
  reg 3,8                    ' cx = 8 (find vol label)
  reg 8,strseg                    ' ds = string segment
  reg 4,temp                      ' dx = string offset

  call interrupt &h21                ' perform dos call

                        ' abort on errors
  if reg(1) = 2 or reg(1) = 18 then fnvol$ = null$ : exit def

  reg 1,&h2F00                    ' ah = 2F (Get DTA)
  call interrupt &h21                ' perform dos call

  dtaseg = reg(9)                ' DTA segment = ES
  dtaoff = reg(2) + 30                ' offset of filename

  c$ = null$                    ' prepare to retrieve filename

  def seg=dtaseg                ' set segment = DTA segment

  for lp% = 0 to 12                ' retrieve filename
    c% = peek(dtaoff + lp%)            ' from DTA
    if c% = 0 then exit for
    c$ = c$ + chr$(peek(dtaoff + lp%))
  next lp%

  def seg                    ' reset segment to default

  lp% = instr(1,c$,".")                         ' combine the filename
  c$ = left$(c$,lp%-1) + mid$(c$,lp%+1,255)    ' and extension

  fnvol$ = c$

End Def




Def FnDosVer#
  local tmp$,tmplow%,tmphi%

  rem  FnDosVer#
  rem  Written by  Brett Jones
  rem  01/18/89 - Original
  rem
  rem  return the current dos version {i.e. 3.3}
  rem  requires dos 2.00 or later.

  reg 1,&h3000
  call interrupt &h21

  tmp$    = mki$(reg(1))
  tmphi%  = cvi(left$(tmp$,1)+chr$(0))
  tmplow% = cvi(right$(tmp$,1)+chr$(0))

  FnDosVer# = tmphi% + (tmplow% / 100.0)

End Def


Def FnCurrDir$
  local f$,strseg,aseg,aptr,a%,ma%

  rem  FnCurrPath$
  rem
  rem  Written by  Brett Jones
  rem  01/18/89 - Original
  rem
  rem  Return a string containing the currently active directory.
  rem  FnCurrDir$ will return a null string if the drive is invalid.
  rem  Requires Dos 2.00 or later.

  f$ = string$(64,chr$(0))            ' create variable to hold path

  def seg                    ' set default segment
  strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment

  aseg = varseg(f$)                ' segment for string pointer
  aptr = varptr(f$)                ' pointer to string descriptor

  def seg=aseg                    ' set segment
  temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename

  reg 1,&h4700                    ' ah = 47h (Get current dir)
  reg 4,&h0000                    ' dx = 00h (current drive)
  reg 8,strseg                    ' ds = string segment
  reg 5,temp                      ' si = string offset

  call interrupt &h21                ' perform dos call

  a% = reg(1)                    ' a% = ax

  if a% = 15 then FnCurrDir$ = null$ : exit def ' no such drive

  def seg                    ' reset segment

  ma% = instr(1,f$,chr$(0))            ' asciiz is returned
  f$ = fncurrdrive$ + ":\"+left$(f$,ma% - 1)    ' truncate to displayable

  FnCurrDir$ = f$


End Def


Rem ++
Rem
Rem    End Module DOSSTUFF
Rem
Rem --




Rem ++
Rem
Rem    Begin Module ByteStuf
Rem
Rem
Rem    Purpose:
Rem        Routines to allow byte storage as integer values
Rem        These routines could be used to avoid Turbo Basic's
Rem        limitation of 64K of string space (although fixed
Rem        length strings would be required to do so easily).
Rem
Rem    Routines:
Rem        Byte2Int% - Build integer from 2 byte values
Rem        Int2Byte  - Return 2 bytes from integer value
Rem        Int2Str$  - Return 2 character string representation of
Rem                    Integer in hibyte%/lobyte% format
Rem        Str2Int%  - Convert 2 character string to integer
Rem
Rem    Environment:
Rem        Turbo Basic
Rem
Rem    Author:            Creation Date:
Rem        Brett Jones        01/15/89
Rem
Rem    Modified By:
Rem        1, Brett Jones, 01/15/89 - Original
Rem
Rem --


Rem ++
Rem
Rem    Note:
Rem        Byte values are in range [0..255]
Rem        Resulting integers are in range [-32767..+32767]
Rem        Validity checking is NOT performed.
Rem
Rem        The Hibyte%, Lobyte% format returns the leftmost and
Rem        rightmost values accordingly.  Reverse these for the
Rem        actual high and low byte values.
Rem
Rem --


Def FnByte2Int%(highbyte%,lowbyte%)
  Rem  Store 2 bytes in an integer

  FnByte2Int% = cvi(chr$(highbyte%)+chr$(lowbyte%))

End Def


Sub Int2Byte(integervalue%)
  shared hibyte%,lobyte%
  local  temp$

  Rem  Return 2 bytes (numeric) from integer

  Rem  This routine will return results in the global
  Rem  variables hibyte% and lobyte%

  Temp$   = FnInt2Str$(integervalue%)
  Hibyte% = asc(left$ (temp$,1))
  Lobyte% = asc(right$(temp$,1))
  Temp$   = null$

End Sub


Def FnInt2Str$(integervalue%)
  Rem  Retrieve 2 bytes from integer.  Return values in string

  FnInt2Str$ = mki$(integervalue%)

End Def


Def FnStr2Int%(inputstring$,start%)
  Rem  Convert 2 bytes of string to integer

  FnStr2Int% = cvi(mid$(inputstring$,start%,2))

End Def


Rem ++
Rem
Rem    End Module ByteStuf
Rem
Rem --




Rem ++
Rem    Sample program to demonstrate the directory/path/file
Rem    routines defined in DOSSTUFF.
Rem --

cls

' FnDosVer#
print "Current DOS Version is ";fndosver#

' fncurrdrive$
print "The current drive is: ";fncurrdrive$

' fnvol$
print "The volume label is : ";
  tvol$ = fnvol$
  if tvol$ = null$ then tvol$ = "{no volume label}
  print tvol$

' FnCurrDir$
print "Current Directory is : ";fncurrdir$

' fnfreespace
fr = fnfreespace(0)
print "Free space for drive ";fncurrdrive$;": is: ";fr;" Bytes, ";(fr/1024);"K."


print
print

'fnexist%
input "Enter a file name for FnExist: ";file$

ex% = fnexist%(file$)

if ex% = -1 then
  print file$ + " Does Not Exist "
else
  print file$ + " Exists - ";
  ' show attributes
  if (ex% and  1) =  1 then print "Read Only ";
  if (ex% and  2) =  2 then print "Hidden ";
  if (ex% and  4) =  4 then print "System ";
  if (ex% and  8) =  8 then print "Volume Label ";
  if (ex% and 16) = 16 then print "Subdirectory ";
  if (ex% and 32) = 32 then print "Archive";
  print
end if

print


' FnFindFirst$ and FnFindNext$

totalfiles% = 0
input "Enter the directory mask: ";mask$
print
print "Files matching "+mask$+" = "
print
tfil$ = fnfindfirst$(mask$)
if tfil$ = null$ then print "No Files!" : stop        ' no files matched

tfil$ = left$(tfil$ + "                    ",16)    ' format the entry
incr totalfiles%

a$ = " "
while a$ <> null$
  a$ = fnfindnext$
  if a$ <> null$ then a$ = left$(a$ + "                    ",16) :_
     tfil$ = tfil$ + a$ : incr totalfiles%        ' format the entry
wend

print tfil$
print using "#### Files Found_.";totalfiles%
End