Click above to get retro games delivered to your door ever month!

Write_expr()   Write an exp to report expression area      Rlback.prg


Syntax:        Write_expr(<expC>, <expL>)

Argument:      <expC> is string containing the expression to write
               to expression area.

               <expL> is a test for dBASE like blank expression
               handling and return a 65535 if expression to write is
               blank.

Returns:       A numeric value that represents the expression count (0
               to 55 inclusive) or  65535 (if blank = .T. and
               EMPTY(string) = .T.) or -1 (if WRITE/SEEK error).

Calls:         Num_2_word()

Notes:         . Called by the Frm_save().
               . Updates lengths_offset, offsets_offset, last_expr, and
                 expr_count.
               . Special dBASE test - string is EMPTY() and = CHR(0).
               . File error number placed in file_error.
               . DISK FULL error, file_error = -2.


--------------------------------- Source Code ------------------------------

   FUNCTION WRITE_EXPR

   PARAMETERS string, blank

   PRIVATE status, write_item, write_len, write_count, return_count

   status       = .F.
   write_item   = ""
   write_len    = 0
   write_count  = 0
   return_count = 0        && expression count/65535 if empty/-1 error.

   ** For dBASE compatibility **
   IF blank .AND. LEN(string) = 0
      status = .T.
   ELSE

      write_item = string + CHR(0)
      write_len = LEN(write_item)

      ** Move to the next free area **
      FSEEK(handle, expr_offset + last_expr)
      file_error = FERROR()
      IF file_error = 0

         ** Write the expression **
         write_count = FWRITE(handle, write_item, write_len)

         ** WRITE error? **
         IF write_count = 0
            file_error = -2
         ELSE
            file_error = FERROR()
         ENDIF

         IF file_error = 0
            FSEEK(handle, offsets_offset)

            file_error = FERROR()
            IF file_error = 0

               ** Add an offset to the offsets array. **
               write_count = FWRITE(handle, NUM_2_WORD(last_expr), 2)

               ** WRITE error? **
               IF write_count = 0
                  file_error = -2
               ELSE
                  file_error = FERROR()
               ENDIF

               IF file_error = 0
                  FSEEK(handle, lengths_offset)

                  file_error = FERROR()
                  IF file_error = 0

                     ** Add the expression length to the lengths array **
                     write_count = FWRITE(handle, NUM_2_WORD(write_len), 2)

                     ** WRITE error? **
                     IF write_count = 0
                        file_error = -2
                     ELSE
                        file_error = FERROR()
                     ENDIF

                     ** Move offsets to next position **
                     IF file_error = 0
                        last_expr = last_expr + write_len
                        lengths_offset = lengths_offset + 2
                        offsets_offset = offsets_offset + 2

                        ** Write was performed ok **
                        status = .T.

                     ENDIF
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
      ENDIF
   ENDIF

   ** If the write ok, bump the expression count. **
   IF status
      IF blank .and. LEN(string) = 0
         return_count = 65535              && if the expression was empty.
      ELSE
         expr_count = expr_count + 1       && global increment.
         return_count = expr_count         && local return.
      ENDIF
   ELSE
      return_count = -1                    && WRITE/SEEK ops error.
   ENDIF

   RETURN (return_count)