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

Frm_load()     Reads (.frm) into (.mem) and (.dbf) files    Rlback.prg


Syntax:        Frm_load(<frm_file>, <dbf_file>, <mem_file>)

Argument:      <frm_file> is the REPORT FORM file to load.

               <dbf_file> is the database file for column
               expressions.

               <mem_file> is the memory file for the report
               specifications.


Returns:       True (.T.) if the load operation is successful.

Calls:         Get_expr(), Get_field(), Create_dbf(), Word_2_num()

Notes:         . Report file name has extension
               . File error number placed in file_error
               . Offsets start at 1
               . Offsets are into a CLIPPER STRING, 1 to 1990
               . Offsets mentioned in these notes are actual DOS FILE
                 offsets. NOT like the offsets declared in the body of
                 FRM_LOAD() which are CLIPPER STRING offsets

               . Report file length is 7C6h (1990d) bytes
               . Expression length array starts at 04h (4d) and can
                 contain up to 55 short (2 byte) numbers

               . Expression offset index array starts at 72h (114d) and
                 can contain up to 55 short (2 byte) numbers
               . Expression area starts at offset E0h (224d)
               . Expression area length is 5A0h (1440d)
               . Expressions in expression area are null terminated
               . Field expression area starts at offset 680h (1664d)
               . Field expressions (column definition) are null
                 terminated
               . Field expression area can contain up to 25 12-byte
                 blocks


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

   FUNCTION FRM_LOAD

   PARAMETERS report_file, dbf_file, mem_file

   ** Shared by FRM_LOAD() and its ancillary functions **
   PRIVATE lengths_buff, offsets_buff, expr_buff, fields_buff,;
      field_width_offset, field_totals_offset, field_decimals_offset,;
      field_content_expr_offset, field_header_expr_offset

   PRIVATE i,  handle, read_count, status, pointer, fcount, fld_offset,;
     file_buff, params_buff, size_file_buff, size_lengths_buff,;
     size_offsets_buff, size_expr_buff, size_fields_buff,;
     size_params_buff, expr_offset, offsets_offset, lengths_offset,;
     fields_offset, page_hdr_offset, grp_expr_offset, sub_expr_offset,;
     grp_hdr_offset, sub_hdr_offset, page_width_offset,;
     lns_per_page_offset, left_mrgn_offset, right_mgrn_offset,;
     col_count_offset, dbl_space_offset, summary_rpt_offset, pe_offset,;
     plnpg_peap_pebp_offset, plus_byte, frm_pagehdr, frm_grpexpr,;
     frm_subexpr, frm_grphdr, frm_subhdr, frm_pagewidth, frm_linespage,;
     frm_leftmarg, frm_rightmarg, frm_colcount, frm_dblspaced,;
     frm_summary, frm_pe, frm_pebp, frm_peap, frm_plainpage

   i          = 0
   handle     = 0
   read_count = 0           && read/write and content record counter.
   pointer    = 0           && points to an offset into EXPR_BUFF string.
   status     = .F.

   size_file_buff = 1990           && size of report file.
   file_buff = SPACE(size_file_buff)

   size_lengths_buff = 110
   size_offsets_buff = 110
   size_expr_buff    = 1440
   size_fields_buff  = 300
   size_params_buff  = 24

   lengths_buff = ""
   offsets_buff = ""
   expr_buff    = ""
   fields_buff  = ""
   params_buff  = ""

   ** There are offsets into the FILE_BUFF string **
   lengths_offset = 5        && start of expression length array.
   offsets_offset = 115      && start of expression position array.
   expr_offset    = 225      && start of expression data area.
   fields_offset  = 1665     && start of report columns (fields).
   params_offset  = 1965     && start of report parameters block.

   ** These are offsets into the FIELDS_BUFF string to actual values **
   ** Values are added to a block offset FLD_OFFSET that is moved in **
   ** increments of 12 **
   fld_offset            = 0
   field_width_offset    = 1
   field_totals_offset   = 6
   field_decimals_offset = 7

   ** These are offsets into FIELDS_BUFF which are used to **
   ** 'point' into the EXPR_BUFF string which contains the **
   ** textual data **
   field_content_expr_offset = 9
   field_header_expr_offset  = 11

   ** These are actual offsets into the PARAMS_BUFF string which **
   ** are used to 'point' into the EXPR_BUFF string **
   page_hdr_offset = 1
   grp_expr_offset = 3
   sub_expr_offset = 5
   grp_hdr_offset  = 7
   sub_hdr_offset  = 9

   ** These are actual offsets into the PARAMS_BUFF string to **
   ** actual values **
   page_width_offset      = 11
   lns_per_page_offset    = 13
   left_mrgn_offset       = 15
   right_mgrn_offset      = 17
   col_count_offset       = 19
   dbl_space_offset       = 21
   summary_rpt_offset     = 22
   pe_offset              = 23
   plnpg_peap_pebp_offset = 24


   ** Default report values **
   frm_pagehdr   = SPACE(240)
   frm_grpexpr   = SPACE(200)
   frm_subexpr   = SPACE(200)
   frm_grphdr    = SPACE(50)
   frm_subhdr    = SPACE(50)
   frm_pagewidth = 80
   frm_linespage = 58
   frm_leftmarg  = 8
   frm_rightmarg = 0
   frm_colcount  = 0
   frm_dblspaced = "N"
   frm_summary   = "N"
   frm_pe        = "N"
   frm_pebp      = "Y"
   frm_peap      = "N"
   frm_plainpage = "N"


   ** Initialize transfer dbf creation arrays **
   fcount = 5
   DECLARE ffield[fcount]
   DECLARE ftype[fcount]
   DECLARE flength[fcount]
   DECLARE fdecimal[fcount]

   ffield[1]   = "WIDTH"
   ftype[1]    = "N"
   flength[1]  = 2
   fdecimal[1] = 0

   ffield[2]   = "TOTALS"
   ftype[2]    = "C"
   flength[2]  = 1
   fdecimal[2] = 0

   ffield[3]   = "DECIMALS"
   ftype[3]    = "N"
   flength[3]  = 2
   fdecimal[3] = 0

   ffield[4]   = "CONTENTS"
   ftype[4]    = "C"
   flength[4]  = 254
   fdecimal[4] = 0

   ffield[5]   = "HEADER"
   ftype[5]    = "C"
   flength[5]  = 260
   fdecimal[5] = 0

   ** CREATE the Report FIELDS record transfer file. **
   IF CREATE_DBF(dbf_file, fcount, ffield, ftype, flength, fdecimal)

      ** Open the report file **
      handle = FOPEN(report_file)

      ** File does not exist **
      file_error = FERROR()
      IF file_error = 2

         ** Save default report variables as initialize above **
         SAVE ALL LIKE frm_* TO &mem_file

         ** Load at least one FIELDS (column) record **
         USE &dbf_file
         APPEND BLANK

         REPLACE width WITH 10
         REPLACE totals WITH "N"
         REPLACE decimals WITH 0
         REPLACE contents WITH SPACE(254)
         REPLACE header WITH SPACE(260)

         CLOSE DATABASES

         status = .T.

      ENDIF

      ** OPEN ok? **
      IF file_error = 0

         ** Go to START of report file **
         FSEEK(handle, 0)

         ** SEEK ok? **
         file_error = FERROR()
         IF file_error = 0

            ** Read entire file into process buffer **
            read_count = FREAD(handle, @file_buff, size_file_buff)

            ** READ ok? **
            IF read_count = 0
               file_error = -3         && file is empty.
            ELSE
               file_error = FERROR()   && check for DOS errors
            ENDIF

            IF file_error = 0

               ** Is this a .FRM type file (2 at start and end of file) **
               IF WORD_2_NUM(SUBSTR(file_buff, 1, 2)) = 2 .AND.;
                  WORD_2_NUM(SUBSTR(file_buff, size_file_buff - 1, 2)) = 2

                  file_error = 0
               ELSE
                  file_error = -1
               ENDIF
            ENDIF
         ENDIF

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

      ** File existed, was opened and read ok and is a .FRM file **
      IF file_error = 0

      ** Fill processing buffers **
      lengths_buff = SUBSTR(file_buff, lengths_offset, size_lengths_buff)
      offsets_buff = SUBSTR(file_buff, offsets_offset, size_offsets_buff)
      expr_buff    = SUBSTR(file_buff, expr_offset, size_expr_buff)
      fields_buff  = SUBSTR(file_buff, fields_offset, size_fields_buff)
      params_buff  = SUBSTR(file_buff, params_offset, size_params_buff)

      ** Extract Numerics **
      frm_pagewidth = WORD_2_NUM(SUBSTR(params_buff,page_width_offset,2))
      frm_linespage = WORD_2_NUM(SUBSTR(params_buff,lns_per_page_offset,2))
      frm_leftmarg  = WORD_2_NUM(SUBSTR(params_buff,left_mrgn_offset,2))
      frm_rightmarg = WORD_2_NUM(SUBSTR(params_buff,right_mgrn_offset,2))
      frm_colcount  = WORD_2_NUM(SUBSTR(params_buff,col_count_offset,2))

      ** Extract characters **
      frm_dblspaced = SUBSTR(params_buff, dbl_space_offset, 1)
      frm_summary   = SUBSTR(params_buff, summary_rpt_offset, 1)
      frm_pe        = SUBSTR(params_buff, pe_offset, 1)

      ** Process packed 'plus byte' **
      plus_byte = ASC(SUBSTR(params_buff, plnpg_peap_pebp_offset, 1))
      IF plus_byte / 4 = 1
         frm_plainpage = "Y"
         plus_byte = plus_byte - 4
      ENDIF
      IF plus_byte / 2 = 1
         frm_peap = "Y"
         plus_byte = plus_byte - 2
      ENDIF
      IF plus_byte / 1 = 1
         frm_pebp = "N"
         plus_byte = plus_byte - 1
      ENDIF

      ** Extract expression (strings) pointed to by pointers **

      ** Page Heading, Report Title **
      pointer = WORD_2_NUM(SUBSTR(params_buff, page_hdr_offset, 2))
      frm_pagehdr = GET_EXPR(pointer)

      ** Grouping expression **
      pointer = WORD_2_NUM(SUBSTR(params_buff, grp_expr_offset, 2))
      frm_grpexpr = GET_EXPR(pointer)

      ** Sub-grouping expression **
      pointer = WORD_2_NUM(SUBSTR(params_buff, sub_expr_offset, 2))
      frm_subexpr = GET_EXPR(pointer)

      ** Group header **
      pointer = WORD_2_NUM(SUBSTR(params_buff, grp_hdr_offset, 2))
      frm_grphdr = GET_EXPR(pointer)

      ** Sub-group header **
      pointer = WORD_2_NUM(SUBSTR(params_buff, sub_hdr_offset, 2))
      frm_subhdr = GET_EXPR(pointer)

      SAVE ALL LIKE frm_* TO &mem_file

      ** EXTRACT FIELDS (columns) **

      fld_offset = 12      && dBASE skips first 12 byte fields block.
      USE &dbf_file
      FOR i = 1 to frm_colcount

         ** APPEND and REPLACEs happen in GET_FIELD() **
         fld_offset = GET_FIELD(fld_offset)

      NEXT
      CLOSE DATABASES

      ** If we have gotten this far assume that the file is ok **
      status = (file_error = 0)

      ENDIF
   ENDIF

   RETURN (status)