home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / b / baswiz19.zip / BW$BAS.ZIP / FARSTRQ.BAS < prev    next >
BASIC Source File  |  1993-01-29  |  2KB  |  42 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE SUB FSDone0 ()
  10.    DECLARE SUB FSNewBlock (ErrCode%)
  11.    DECLARE SUB FSSet0 (Handle%, St$, Reallocate%, ErrCode%)
  12.  
  13.    DEFINT A-Z
  14.  
  15. SUB FSDone
  16.    FSDone0                                        ' deallocate string blocks
  17.    junk& = SETMEM(999999)                         ' return memory to QuickBASIC
  18. END SUB
  19.  
  20. SUB FSSet (Handle, St$)
  21.    Tmp$ = LEFT$(St$, 255)                         ' truncate string if need be
  22.    FSSet0 Handle, Tmp$, Reallocate, ErrCode       ' try to set string value
  23.    IF ErrCode THEN                                ' if error...
  24. '-----PRINT "Invalid handle in FSSet"             '   invalid handle, ignore it
  25.    ELSEIF Reallocate THEN                         ' if we need more room...
  26.       junk& = SETMEM(-16400)                      ' get it from QuickBASIC
  27.       FSNewBlock ErrCode                          ' make a new string block
  28.       junk& = SETMEM(16400)                       ' return it (in case of EMS)
  29.       IF ErrCode THEN                             ' if error...
  30. '--------PRINT "Out of far string space"
  31.          ERROR 7                                  '   "out of memory" error
  32.       ELSE
  33.          FSSet0 Handle, Tmp$, Reallocate, ErrCode ' set string value
  34. '--------IF Reallocate OR ErrCode THEN
  35. '-----------PRINT "Error in FSSet0 code"
  36. '-----------PRINT "Error code: "; ErrCode
  37. '-----------PRINT "Reallocate: "; Reallocate
  38. '--------END IF
  39.       END IF
  40.   END IF
  41. END SUB
  42.