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

Create_dbf()   Create a (.dbf) file                    Rlback.prg


Syntax:        Create_dbf(file, size, field, ftype, flength, fdecimal)

Argument:      <expC> is the name of the database file to create.

               <expN> is the number of fields (for speed).

               <field> is an array of field names (character).

               <ftype> is an array of field types (character).

               <flength> is an array of field lengths (numeric).

               <fdecimal> is an array of field decimal lengths
               (numeric).

Returns:       True (.T.) if the write operation succeeded.

Calls:         Num_2_word()


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

   FUNCTION CREATE_DBF

   PARAMETERS file, size, field, ftype, flength, fdecimal

   PRIVATE header_image, field_image, tail_image, block_size, handle,;
      i, write_count, field_count, data_offset, record_size, status

   ** DBF file creation variables **
   i           = 0                  && array subscript.
   handle      = 0
   block_size  = 32                 && header and field block size.
   data_offset = block_size         && field records start are offset 32d.
   record_size = 0
   write_count = 0                  && bytes written.
   field_count = 0                  && fields to create.
   status = .T.

   ** NO extension **
   IF AT(".", file) = 0
      file = TRIM(file) + ".DBF"
   ENDIF

   ** Calculate record_size, field_count and data_offset **
   FOR i = 1 to size
      record_size = record_size + flength[i]
      data_offset = data_offset + block_size
   NEXT

   field_count = i - 1
   record_size = record_size + 1       && + one byte of pad.
   data_offset = data_offset + 2       && + 2 for CR and NULL.

   header_image = CHR(3) +;                        && dbf id.      (byte)
                     replicate(CHR(0), 3) +;       && last update. (byte)
                     replicate(CHR(0), 4) +;       && last record. (long)
                     NUM_2_WORD(data_offset) +;    && data offset. (word)
                     NUM_2_WORD(record_size) +;    && record size. (word)
                     replicate(CHR(0), 20)         && 20 byte pad.

   field_image = ""                                && filled in later.
   tail_image = CHR(13) + CHR(0) + CHR(26)         && CR, pad, EOF

   ** Create label content dbf file **
   handle = FCREATE(file)

   ** CREATEd ok? **
   file_error = FERROR()
   status = (file_error = 0)

   IF status

      ** Write dbf header image **
      write_count = FWRITE(handle, header_image, block_size)

      ** Header WRITE ok? **
      IF write_count = 0
         file_error = -2
      ELSE
         file_error = FERROR()
      ENDIF
      status = (file_error = 0)

      IF status

         ** Make a FIELD header block **
         FOR i = 1 to field_count

            ** Build it **
            field_image = field[i] +;            && field name + pad
                     replicate(CHR(0), 11 - LEN(field[i])) +;
                     ftype[i] +;                 && field type   (byte)
                     replicate(CHR(0), 4) +;     && 4 byte pad
                     CHR(flength[i] % 256) +;    && field length (byte)
                     IF(ftype[i] = "C",;         && for "C" type > 256
                        CHR(flength[i] / 256),;  && low + high bytes
                        CHR(fdecimal[i])) +;     && decimals     (byte)
                     replicate(CHR(0), 14)       && 14 byte pad

            ** Write it **
            write_count = FWRITE(handle, field_image, block_size)

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

            IF !status
               i = field_count + 1        && breakout of FOR loop.
            ENDIF
         NEXT

      ENDIF

      ** If file created ok so far... **
      IF status
         ** Write Tail CR + NULL + EOF (0Dh + 00h + 1Ah) **
         write_count = FWRITE(handle, tail_image, 3)

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

         status = (file_error = 0)

      ENDIF

      ** Close file **
      status = FCLOSE(handle)
      IF !status
         file_error = FERROR()
      ENDIF
   ENDIF

   RETURN (status)