home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / tb / dosstuff / dosstuff.bas
BASIC Source File  |  1989-01-25  |  16KB  |  597 lines
  1. '  Disclaimer:
  2. '    Use these routines at your own risk.  I do not accept any liability
  3. '  for ANY problems that may occur from using these routines.
  4. '
  5. '  Now that I have that out of the way....
  6. '
  7. '  These functions are provided to complement the functions of Turbo Basic.
  8. '  While Turbo Basic provides many convenient functions, they seem to have
  9. '  missed a few important ones.  You can, for example, use CHDIR to change
  10. '  the current directory, but Turbo Basic gives you no way to determine or
  11. '  return to the directory that was active when the program was run.
  12. '
  13. '  I also like knowing whether or not a given file exists before I begin
  14. '  any file I/O on that file.  With the FindFirst and FindNext functions, you
  15. '  can build a string containing the entire directory ... this is useful
  16. '  in many applications.  These routines were written using Turbo Basic
  17. '  keywords and functions instead of as inline assembler in order to give
  18. '  you an example of how to use Turbo Basic more effectively.  Note that
  19. '  similar routines written as inline assembler would run LOTS faster.
  20. '
  21. '  Brett Jones, 01/18/89
  22. '
  23. '  Turbo Basic is a registered trademark of Borland International.
  24.  
  25.  
  26. Rem ++
  27. Rem
  28. Rem    Begin Module DOSSTUFF
  29. Rem
  30. Rem
  31. Rem    Purpose:
  32. Rem        Turbo Basic routines to allow more complete access to
  33. Rem        Disk Directories, Paths and Files.
  34. Rem
  35. Rem    Routines:
  36. Rem        FnExist%    - Verify that a file exists on a disk
  37. Rem                  before attempting I/O.
  38. Rem        FnCurrDrive$    - Return a single character describing
  39. Rem                  the currently logged in disk drive.
  40. Rem        FnFreeSpace    - Return the amount of free space available
  41. Rem                  on any valid disk.
  42. Rem        FnFindFirst$    - Returns the first file in a directory that
  43. Rem                  matches a user defined mask.
  44. Rem        FnFindNext$    - Returns subsequent files matching a user
  45. Rem                  defined mask after using FnFindFirst$.
  46. Rem        FnVol$        - Returns the volume label for a disk.
  47. Rem        FnDosVer#    - Returns the current DOS version number.
  48. Rem        FnCurrDir$    - Returns the current directory.
  49. Rem
  50. Rem    Environment:
  51. Rem        Turbo Basic
  52. Rem
  53. Rem    Author:            Creation Date:
  54. Rem        Brett Jones        01/15/89
  55. Rem
  56. Rem    Modified By:
  57. Rem        1, Brett Jones, 01/15/89 - Original
  58. Rem
  59. Rem --
  60.  
  61.  
  62. Def FnExist%(f$)
  63.   local strseg,aseg,aptr,temp,a%,b%,a$
  64.  
  65.  
  66.   rem  Written by Brett Jones
  67.   rem  01/17/89 - Original
  68.   rem
  69.   rem  determine if file f$ exists
  70.   rem  works by checking for file attributes
  71.   rem  requires dos 2.0 and above
  72.  
  73.   def seg                    ' set default segment
  74.   strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment
  75.  
  76.   a$ = ucase$(f$) + chr$(0)            ' make f$ asciiz
  77.  
  78.   aseg = varseg(a$)                ' segment for string pointer
  79.   aptr = varptr(a$)                ' pointer to string descriptor
  80.  
  81.   def seg=aseg                    ' set segment
  82.   temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename
  83.  
  84.   reg 1,&h4300                    ' ah = 43h (CHMOD function)
  85.                         ' al = 00h (get attributes)
  86.   reg 8,strseg                    ' ds = string segment
  87.   reg 4,temp                      ' dx = string offset
  88.  
  89.   call interrupt &h21                ' perform dos call
  90.  
  91.   a% = reg(1)                    ' a% = ax
  92.   b% = reg(3)                    ' b% = cx
  93.  
  94.   if a% = 2 or a% = 3 or a% = 5 then FnExist% = -1 else FnExist% = b%
  95.  
  96.   rem  2 = file not found
  97.   rem  3 = path not found
  98.   rem  5 = access denied
  99.  
  100.   def seg                    ' reset segment
  101.  
  102. End Def
  103.  
  104.  
  105.  
  106. Def FnCurrDrive$
  107.   local ta$,ta%
  108.  
  109.   rem  Written by  Brett Jones
  110.   rem  01/17/89 - Original
  111.   rem
  112.   rem  FnCurrDrive$ returns a single character drive identifier which
  113.   rem  specifies the current drive in use.
  114.   rem  This function can be used with any version of dos.
  115.  
  116.   reg 1,&h1900            ' ah = 19h (report current drive)
  117.   call interrupt &h21        ' perform dos interrupt
  118.  
  119.   ta$ = mki$(reg(1))        ' ta$ = 2 character string of ax
  120.   ta% = asc(left$(ta$,1))    ' ta% = al
  121.  
  122.   FnCurrDrive$ = chr$(ta% + 65)    ' return drive as a string {A..Z}
  123.  
  124. End Def
  125.  
  126.  
  127.  
  128. Def FnFreeSpace(drive%)
  129.   local ra,rb,rc
  130.  
  131.   rem  Written by  Brett Jones
  132.   rem  01/17/89 - Original
  133.   rem
  134.   rem  FnFreeSpace will return the number of free bytes available
  135.   rem  on drive 'drive%'.  If 'drive%' does not exist, then this
  136.   rem  function will return a -1.
  137.   rem  FnFreeSpace requires dos 2.00 or above.
  138.  
  139.   reg 1,&h3600            ' ah = 36h (get free space)
  140.   reg 4,drive%            ' dl = drive number (0 = default)
  141.   call interrupt &h21        ' perform dos interrupt
  142.  
  143.   ra = reg(1)            ' ra = ax (sectors per cluster or error)
  144.  
  145.   if ra = &hffff then fnfreespace = -1 : exit def ' exit if error occurs
  146.  
  147.   rb = reg(2)            ' rb = number of available clusters
  148.   rc = reg(3)            ' rc = bytes per sector
  149.                   ' reg(4) {dx} contains total number of clusters
  150.  
  151.   FnFreeSpace = (ra * rb * rc)
  152.  
  153. End Def
  154.  
  155.  
  156.  
  157. Def FnFindFirst$(f$)
  158.   local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,dtaatt,c$,c%,lp%
  159.  
  160.   rem  Written by  Brett Jones
  161.   rem  01/17/89 - Original
  162.   rem
  163.   rem  FnFindFirst$ finds the first file that matches the mask
  164.   rem  'f$'.  'f$' can contain wildcard characters {* and ?}.
  165.   rem  'f$' is any valid path + filename.  If FnFindfirst$ does not
  166.   rem  find a file, it will return a null string.
  167.   rem  Requires dos 2.00 and above.
  168.  
  169.  
  170.   rem  Format of the DTA after a file has been found:
  171.   rem
  172.   rem  Offset     Size(bytes)    Description
  173.   rem       0        21          Used by DOS for find next
  174.   rem      21         1          Attribute of file found
  175.   rem      22         2          Time Stamp of file
  176.   rem      24         2          Date Stamp of file
  177.   rem      26         4          File size in bytes
  178.   rem      30        13          Filename and extension (asciiz)
  179.   rem
  180.   rem  Attributes:
  181.   rem    bit    0    - Read Only
  182.   rem        1    - Hidden
  183.   rem        2    - System
  184.   rem        3    - Volume Label
  185.   rem        4    - Subdirectory
  186.   rem        5    - Archive
  187.   rem        6    - Unused
  188.   rem        7    - Unused
  189.   rem
  190.   rem  Time = Hour * 2048 + Minute * 32 + Second / 2
  191.   rem  Date = (Year - 1980) * 512 + Month * 32 + Day
  192.   rem
  193.   rem  Filesize is a 4 byte unsigned integer
  194.  
  195.  
  196.   def seg                    ' set default segment
  197.   strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment
  198.  
  199.   if f$ = null$ then f$ = "*.*"            ' avoid trying to find nothing
  200.   a$ = ucase$(f$) + chr$(0)            ' make f$ asciiz
  201.  
  202.   aseg = varseg(a$)                ' segment for string pointer
  203.   aptr = varptr(a$)                ' pointer to string descriptor
  204.  
  205.   def seg=aseg                    ' set segment
  206.   temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename
  207.  
  208.   reg 1,&h4E00                    ' ah = 4E (find first)
  209.                         ' al = 00h
  210.   reg 3,23                    ' cx = 23 (all but vol label)
  211.   reg 8,strseg                    ' ds = string segment
  212.   reg 4,temp                      ' dx = string offset
  213.  
  214.   call interrupt &h21                ' perform dos call
  215.  
  216.                         ' abort on errors
  217.   if reg(1) = 2 or reg(1) = 18 then fnfindfirst$ = null$ : exit def
  218.  
  219.   reg 1,&h2F00                    ' ah = 2F (Get DTA)
  220.   call interrupt &h21                ' perform dos call
  221.  
  222.   dtaseg = reg(9)                ' DTA segment = ES
  223.   dtaatt = reg(2) + 21                ' offset of attributes
  224.   dtaoff = reg(2) + 30                ' offset of filename
  225.  
  226.   c$ = null$                    ' prepare to retrieve filename
  227.  
  228.   def seg=dtaseg                ' set segment = DTA segment
  229.  
  230.   for lp% = 0 to 12                ' retrieve filename
  231.     c% = peek(dtaoff + lp%)            ' from DTA
  232.     if c% = 0 then exit for
  233.     c$ = c$ + chr$(peek(dtaoff + lp%))
  234.   next lp%
  235.  
  236.   if (peek(dtaatt) and 16) = 16 then c$ = "\"+c$ ' indicate subdirectories
  237.  
  238.   def seg                    ' reset segment to default
  239.  
  240.   fnfindfirst$ = c$            
  241.  
  242. End Def
  243.  
  244.  
  245. Def FnFindNext$
  246.   local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,dtaatt,c$,c%,lp%
  247.  
  248.   rem  Written by  Brett Jones
  249.   rem  01/17/89 - Original
  250.   rem
  251.   rem  FnFindNext$ finds the next file that matches the mask
  252.   rem  used with FnFindFirst$.  FnFindFirst$ MUST have been called prior
  253.   rem  to using FnFindNext$.  If FnFindNext$ does not find any matching
  254.   rem  files, then a null string will be returned.
  255.   rem  Repeat FnFindNext$ until a null string is returned to find ALL
  256.   rem  files that match the mask.
  257.   rem  Requires dos 2.00 and above.
  258.  
  259.   reg 1,&h4F00                    ' ah = 4E (find first)
  260.                         ' al = 00h
  261.  
  262.   call interrupt &h21                ' perform dos call
  263.  
  264.                         ' return if error/no files
  265.   if reg(1) = 18 then fnfindnext$ = null$ : exit def
  266.  
  267.   reg 1,&h2F00                    ' ah = 2F (Get DTA)
  268.   call interrupt &h21                ' perform dos call
  269.  
  270.   dtaseg = reg(9)                ' DTA segment = ES
  271.   dtaatt = reg(2) + 21                ' offset of attributes
  272.   dtaoff = reg(2) + 30                ' filename offset
  273.  
  274.   c$ = null$                    ' prepare to transfer filename
  275.   def seg=dtaseg                ' set segment to DTA segment
  276.  
  277.   for lp% = 0 to 12                ' retrieve filename
  278.     c% = peek(dtaoff + lp%)            ' from DTA
  279.     if c% = 0 then exit for
  280.     c$ = c$ + chr$(peek(dtaoff + lp%))
  281.   next lp%
  282.  
  283.   if (peek(dtaatt) and 16) = 16 then c$ = "\"+c$ ' indicate subdirectories
  284.  
  285.   def seg                    ' restore default segment
  286.  
  287.   fnfindnext$ = c$
  288.  
  289. End Def
  290.  
  291.  
  292. Def FnVol$
  293.   local strseg,a$,aseg,aptr,temp,dtaseg,dtaoff,c$,c%,lp%
  294.  
  295.   rem  Written by  Brett Jones
  296.   rem  01/19/89 - Original
  297.   rem
  298.   rem  FnVol$ locates the volume label of a disk.
  299.   rem  If FnVol$ does not find a file, it will return a null string.
  300.   rem  Requires dos 2.00 and above.
  301.  
  302.  
  303.   def seg                    ' set default segment
  304.   strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment
  305.  
  306.   a$ = "*.*" + chr$(0)                ' make a$ asciiz
  307.  
  308.   aseg = varseg(a$)                ' segment for string pointer
  309.   aptr = varptr(a$)                ' pointer to string descriptor
  310.  
  311.   def seg=aseg                    ' set segment
  312.   temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename
  313.  
  314.   reg 1,&h4E00                    ' ah = 4E (find first)
  315.   reg 3,8                    ' cx = 8 (find vol label)
  316.   reg 8,strseg                    ' ds = string segment
  317.   reg 4,temp                      ' dx = string offset
  318.  
  319.   call interrupt &h21                ' perform dos call
  320.  
  321.                         ' abort on errors
  322.   if reg(1) = 2 or reg(1) = 18 then fnvol$ = null$ : exit def
  323.  
  324.   reg 1,&h2F00                    ' ah = 2F (Get DTA)
  325.   call interrupt &h21                ' perform dos call
  326.  
  327.   dtaseg = reg(9)                ' DTA segment = ES
  328.   dtaoff = reg(2) + 30                ' offset of filename
  329.  
  330.   c$ = null$                    ' prepare to retrieve filename
  331.  
  332.   def seg=dtaseg                ' set segment = DTA segment
  333.  
  334.   for lp% = 0 to 12                ' retrieve filename
  335.     c% = peek(dtaoff + lp%)            ' from DTA
  336.     if c% = 0 then exit for
  337.     c$ = c$ + chr$(peek(dtaoff + lp%))
  338.   next lp%
  339.  
  340.   def seg                    ' reset segment to default
  341.  
  342.   lp% = instr(1,c$,".")                         ' combine the filename
  343.   c$ = left$(c$,lp%-1) + mid$(c$,lp%+1,255)    ' and extension
  344.  
  345.   fnvol$ = c$            
  346.  
  347. End Def
  348.  
  349.  
  350.  
  351.  
  352. Def FnDosVer#
  353.   local tmp$,tmplow%,tmphi%
  354.  
  355.   rem  FnDosVer#
  356.   rem  Written by  Brett Jones
  357.   rem  01/18/89 - Original
  358.   rem
  359.   rem  return the current dos version {i.e. 3.3}
  360.   rem  requires dos 2.00 or later.
  361.  
  362.   reg 1,&h3000
  363.   call interrupt &h21
  364.  
  365.   tmp$    = mki$(reg(1))
  366.   tmphi%  = cvi(left$(tmp$,1)+chr$(0))
  367.   tmplow% = cvi(right$(tmp$,1)+chr$(0))
  368.  
  369.   FnDosVer# = tmphi% + (tmplow% / 100.0)
  370.  
  371. End Def
  372.  
  373.  
  374. Def FnCurrDir$
  375.   local f$,strseg,aseg,aptr,a%,ma%
  376.  
  377.   rem  FnCurrPath$
  378.   rem
  379.   rem  Written by  Brett Jones
  380.   rem  01/18/89 - Original
  381.   rem
  382.   rem  Return a string containing the currently active directory.
  383.   rem  FnCurrDir$ will return a null string if the drive is invalid.
  384.   rem  Requires Dos 2.00 or later.
  385.  
  386.   f$ = string$(64,chr$(0))            ' create variable to hold path
  387.  
  388.   def seg                    ' set default segment
  389.   strseg = cvi(chr$(peek(0)) + chr$(peek(1)))    ' get string segment
  390.  
  391.   aseg = varseg(f$)                ' segment for string pointer
  392.   aptr = varptr(f$)                ' pointer to string descriptor
  393.  
  394.   def seg=aseg                    ' set segment
  395.   temp = cvi(chr$(peek(aptr + 2)) + chr$(peek(aptr + 3))) ' pointer to filename
  396.  
  397.   reg 1,&h4700                    ' ah = 47h (Get current dir)
  398.   reg 4,&h0000                    ' dx = 00h (current drive)
  399.   reg 8,strseg                    ' ds = string segment
  400.   reg 5,temp                      ' si = string offset
  401.  
  402.   call interrupt &h21                ' perform dos call
  403.  
  404.   a% = reg(1)                    ' a% = ax
  405.  
  406.   if a% = 15 then FnCurrDir$ = null$ : exit def ' no such drive
  407.  
  408.   def seg                    ' reset segment
  409.  
  410.   ma% = instr(1,f$,chr$(0))            ' asciiz is returned
  411.   f$ = fncurrdrive$ + ":\"+left$(f$,ma% - 1)    ' truncate to displayable
  412.  
  413.   FnCurrDir$ = f$
  414.  
  415.  
  416. End Def
  417.  
  418.  
  419. Rem ++
  420. Rem
  421. Rem    End Module DOSSTUFF
  422. Rem
  423. Rem --
  424.  
  425.  
  426.  
  427.  
  428. Rem ++
  429. Rem
  430. Rem    Begin Module ByteStuf
  431. Rem
  432. Rem
  433. Rem    Purpose:
  434. Rem        Routines to allow byte storage as integer values
  435. Rem        These routines could be used to avoid Turbo Basic's
  436. Rem        limitation of 64K of string space (although fixed
  437. Rem        length strings would be required to do so easily).
  438. Rem
  439. Rem    Routines:
  440. Rem        Byte2Int% - Build integer from 2 byte values
  441. Rem        Int2Byte  - Return 2 bytes from integer value
  442. Rem        Int2Str$  - Return 2 character string representation of
  443. Rem                    Integer in hibyte%/lobyte% format
  444. Rem        Str2Int%  - Convert 2 character string to integer
  445. Rem
  446. Rem    Environment:
  447. Rem        Turbo Basic
  448. Rem
  449. Rem    Author:            Creation Date:
  450. Rem        Brett Jones        01/15/89
  451. Rem
  452. Rem    Modified By:
  453. Rem        1, Brett Jones, 01/15/89 - Original
  454. Rem
  455. Rem --
  456.  
  457.  
  458. Rem ++
  459. Rem
  460. Rem    Note:
  461. Rem        Byte values are in range [0..255]
  462. Rem        Resulting integers are in range [-32767..+32767]
  463. Rem        Validity checking is NOT performed.
  464. Rem
  465. Rem        The Hibyte%, Lobyte% format returns the leftmost and
  466. Rem        rightmost values accordingly.  Reverse these for the
  467. Rem        actual high and low byte values.
  468. Rem
  469. Rem --
  470.  
  471.  
  472. Def FnByte2Int%(highbyte%,lowbyte%)
  473.   Rem  Store 2 bytes in an integer
  474.  
  475.   FnByte2Int% = cvi(chr$(highbyte%)+chr$(lowbyte%))
  476.  
  477. End Def
  478.  
  479.  
  480. Sub Int2Byte(integervalue%)
  481.   shared hibyte%,lobyte%
  482.   local  temp$
  483.  
  484.   Rem  Return 2 bytes (numeric) from integer
  485.  
  486.   Rem  This routine will return results in the global
  487.   Rem  variables hibyte% and lobyte%
  488.  
  489.   Temp$   = FnInt2Str$(integervalue%)
  490.   Hibyte% = asc(left$ (temp$,1))
  491.   Lobyte% = asc(right$(temp$,1))
  492.   Temp$   = null$
  493.  
  494. End Sub
  495.  
  496.  
  497. Def FnInt2Str$(integervalue%)
  498.   Rem  Retrieve 2 bytes from integer.  Return values in string
  499.  
  500.   FnInt2Str$ = mki$(integervalue%)
  501.  
  502. End Def
  503.  
  504.  
  505. Def FnStr2Int%(inputstring$,start%)
  506.   Rem  Convert 2 bytes of string to integer
  507.  
  508.   FnStr2Int% = cvi(mid$(inputstring$,start%,2))
  509.  
  510. End Def
  511.  
  512.  
  513. Rem ++
  514. Rem
  515. Rem    End Module ByteStuf
  516. Rem
  517. Rem --
  518.  
  519.  
  520.  
  521.  
  522. Rem ++
  523. Rem    Sample program to demonstrate the directory/path/file
  524. Rem    routines defined in DOSSTUFF.
  525. Rem --
  526.  
  527. cls
  528.  
  529. ' FnDosVer#
  530. print "Current DOS Version is ";fndosver#
  531.  
  532. ' fncurrdrive$
  533. print "The current drive is: ";fncurrdrive$
  534.  
  535. ' fnvol$
  536. print "The volume label is : ";
  537.   tvol$ = fnvol$
  538.   if tvol$ = null$ then tvol$ = "{no volume label}
  539.   print tvol$
  540.  
  541. ' FnCurrDir$
  542. print "Current Directory is : ";fncurrdir$
  543.  
  544. ' fnfreespace
  545. fr = fnfreespace(0)
  546. print "Free space for drive ";fncurrdrive$;": is: ";fr;" Bytes, ";(fr/1024);"K."
  547.  
  548.  
  549. print
  550. print
  551.  
  552. 'fnexist%
  553. input "Enter a file name for FnExist: ";file$
  554.  
  555. ex% = fnexist%(file$)
  556.  
  557. if ex% = -1 then
  558.   print file$ + " Does Not Exist "
  559. else
  560.   print file$ + " Exists - ";
  561.   ' show attributes
  562.   if (ex% and  1) =  1 then print "Read Only ";
  563.   if (ex% and  2) =  2 then print "Hidden ";
  564.   if (ex% and  4) =  4 then print "System ";
  565.   if (ex% and  8) =  8 then print "Volume Label ";
  566.   if (ex% and 16) = 16 then print "Subdirectory ";
  567.   if (ex% and 32) = 32 then print "Archive";
  568.   print
  569. end if
  570.  
  571. print
  572.  
  573.  
  574. ' FnFindFirst$ and FnFindNext$
  575.  
  576. totalfiles% = 0
  577. input "Enter the directory mask: ";mask$
  578. print
  579. print "Files matching "+mask$+" = "
  580. print
  581. tfil$ = fnfindfirst$(mask$)
  582. if tfil$ = null$ then print "No Files!" : stop        ' no files matched
  583.  
  584. tfil$ = left$(tfil$ + "                    ",16)    ' format the entry
  585. incr totalfiles%
  586.  
  587. a$ = " "
  588. while a$ <> null$
  589.   a$ = fnfindnext$
  590.   if a$ <> null$ then a$ = left$(a$ + "                    ",16) :_
  591.      tfil$ = tfil$ + a$ : incr totalfiles%        ' format the entry
  592. wend
  593.  
  594. print tfil$
  595. print using "#### Files Found_.";totalfiles%
  596. End
  597.