home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 5.ddi / SYS.LIF / FRMBACK.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  15.5 KB  |  522 lines
  1. /***
  2. *   Frmback.prg
  3. *   Create a report array from a (.frm) file
  4. *   Copyright (c) 1990 Nantucket Corp.  All rights reserved.
  5. *
  6. *   Compile: /n/w/m
  7. */
  8.  
  9. #include "frmdef.ch"
  10. #include "error.ch"
  11.  
  12. // Definitions for buffer sizes
  13. #define  SIZE_FILE_BUFF             1990       // Size of report file
  14. #define  SIZE_LENGTHS_BUFF          110
  15. #define  SIZE_OFFSETS_BUFF          110
  16. #define  SIZE_EXPR_BUFF             1440
  17. #define  SIZE_FIELDS_BUFF           300
  18. #define  SIZE_PARAMS_BUFF           24
  19.  
  20. // Definitions for offsets into the FILE_BUFF string
  21. #define  LENGTHS_OFFSET             5          // Start of expression length array
  22. #define  OFFSETS_OFFSET             115        // Start of expression position array
  23. #define  EXPR_OFFSET                225        // Start of expression data area
  24. #define  FIELDS_OFFSET              1665       // Start of report columns (fields)
  25. #define  PARAMS_OFFSET              1965       // Start of report parameters block
  26.  
  27. // These are offsets into the FIELDS_BUFF string to actual values
  28. // Values are added to a block offset FLD_OFFSET that is moved in 
  29. // increments of 12 
  30. #define  FIELD_WIDTH_OFFSET         1
  31. #define  FIELD_TOTALS_OFFSET        6
  32. #define  FIELD_DECIMALS_OFFSET      7
  33.  
  34. // These are offsets into FIELDS_BUFF which are used to 'point' into
  35. // the EXPR_BUFF string which contains the textual data 
  36. #define  FIELD_CONTENT_EXPR_OFFSET  9
  37. #define  FIELD_HEADER_EXPR_OFFSET   11
  38.  
  39. // These are actual offsets into the PARAMS_BUFF string which
  40. // are used to 'point' into the EXPR_BUFF string 
  41. #define  PAGE_HDR_OFFSET            1
  42. #define  GRP_EXPR_OFFSET            3
  43. #define  SUB_EXPR_OFFSET            5
  44. #define  GRP_HDR_OFFSET             7
  45. #define  SUB_HDR_OFFSET             9
  46.  
  47. // These are actual offsets into the PARAMS_BUFF string to actual values
  48. #define  PAGE_WIDTH_OFFSET          11
  49. #define  LNS_PER_PAGE_OFFSET        13
  50. #define  LEFT_MRGN_OFFSET           15
  51. #define  RIGHT_MGRN_OFFSET          17
  52. #define  COL_COUNT_OFFSET           19
  53. #define  DBL_SPACE_OFFSET           21
  54. #define  SUMMARY_RPT_OFFSET         22
  55. #define  PE_OFFSET                  23
  56. #define  OPTION_OFFSET              24
  57.  
  58. // File error definitions
  59. #define  F_OK                       0          // No error
  60. #define  F_EMPTY                   -3          // File is empty
  61. #define  F_ERROR                   -1          // Some kind of error
  62. #define  F_NOEXIST                  2          // File does not exist
  63.  
  64. // Declare file-wide statics
  65. STATIC cExprBuff
  66. STATIC cOffsetsBuff
  67. STATIC cLengthsBuff
  68.  
  69. /***
  70. *
  71. *  __FrmLoad( cFrmFile ) --> aReport
  72. *  Reads a report (.frm) file and creates a report array
  73. *
  74. *  Notes:
  75. *
  76. *      1.   Report file name has extension.
  77. *      2.   File error number placed in nFileError
  78. *      3.   Offsets start at 1. Offsets are into a Clipper string, 1 to 1990
  79. *      4.   The offsets mentioned in these notes are actual DOS FILE offsets,
  80. *           not like the offsets declared in the body of FrmLoad()
  81. *           which are Clipper STRING offsets.
  82. *      5.   Report file length is 7C6h (1990d) bytes.
  83. *      6.   Expression length array starts at 04h (4d) and can
  84. *           contain upto 55 short (2 byte) numbers.
  85. *      7.   Expression offset index array starts at 72h (114d) and
  86. *           can contain upto 55 short (2 byte) numbers.
  87. *      8.   Expression area starts at offset E0h (224d).
  88. *      9.   Expression area length is 5A0h (1440d).
  89. *     10.   Expressions in expression area are null terminated.
  90. *     11.   Field expression area starts at offset 680h (1664d).
  91. *     12.   Field expressions (column definition) are null terminated.
  92. *     13.   Field expression area can contain upto 25 12-byte blocks.
  93. */
  94.  
  95. FUNCTION __FrmLoad( cFrmFile )
  96.   LOCAL cFieldsBuff                            
  97.     LOCAL cParamsBuff                            
  98.     LOCAL nFieldOffset    := 0                
  99.   LOCAL cFileBuff      := SPACE(SIZE_FILE_BUFF)
  100.     LOCAL cGroupExp        := SPACE(200)
  101.     LOCAL cSubGroupExp    := SPACE(200)
  102.     LOCAL nColCount        := 0               // Number of columns in report
  103.     LOCAL nCount
  104.     LOCAL nFrmHandle                            // (.frm) file handle
  105.     LOCAL nBytesRead                        // Read/write and content record counter
  106.   LOCAL nPointer         := 0           // Points to an offset into EXPR_BUFF string
  107.   LOCAL nFileError                            // Contains current file error
  108.   LOCAL cOptionByte                            // Contains option byte
  109.  
  110.   LOCAL aReport[ RP_COUNT ]                // Create report array
  111.    LOCAL err
  112.  
  113.   LOCAL s, paths
  114.   LOCAL i
  115.  
  116.   // Initialize STATIC buffer values
  117.   cLengthsBuff  := ""
  118.   cOffsetsBuff  := ""
  119.   cExprBuff     := ""
  120.  
  121.   // Default report values
  122.   aReport[ RP_HEADER ]    := {}             
  123.     aReport[ RP_WIDTH ]     := 80             
  124.     aReport[ RP_LMARGIN ]   := 8              
  125.     aReport[ RP_RMARGIN ]   := 0              
  126.     aReport[ RP_LINES ]     := 58             
  127.   aReport[ RP_SPACING ]   := 1              
  128.     aReport[ RP_BEJECT ]    := .T.            
  129.     aReport[ RP_AEJECT ]    := .F.            
  130.     aReport[ RP_PLAIN ]     := .F.            
  131.     aReport[ RP_SUMMARY ]   := .F.            
  132.     aReport[ RP_COLUMNS ]   := {}             
  133.     aReport[ RP_GROUPS ]    := {}             
  134.   aReport[ RP_HEADING ]   := ""             
  135.  
  136.     // Open the report file
  137.  
  138.     nFrmHandle = FOPEN( cFrmFile )
  139.     nFileError = FERROR()
  140.  
  141.     IF !( "\" $ cFrmFile .or. ":" $ cFrmFile )
  142.         // if not found and no path in name, go looking
  143.  
  144.         IF nFileError != F_OK
  145.  
  146.             s := SET( _SET_DEFAULT )
  147.  
  148.             IF !Empty( s )
  149.                 nFrmHandle := FOPEN( s + "\" + cFrmFile )
  150.                 nFileError := FERROR()
  151.             END
  152.         END
  153.  
  154.         IF nFileError != F_OK
  155.  
  156.             s := SET( _SET_PATH )
  157.             s := StrTran(s, ",", ";")   // convert any commas in path spec
  158.  
  159.             paths := ListAsArray( s )
  160.  
  161.             FOR i := 1 to Len(paths)
  162.                 nFrmHandle := FOPEN( paths[i] + "\" + cFrmFile )
  163.                 nFileError := FERROR()
  164.  
  165.                 IF nFileError == F_OK
  166.                     EXIT
  167.                 END
  168.             NEXT
  169.         END
  170.     END
  171.  
  172.     // File error
  173.     IF nFileError != F_OK
  174.       err := ErrorNew()
  175.       err:severity := 2
  176.       err:genCode := EG_OPEN
  177.       err:subSystem := "FRMLBL"
  178.       Eval(ErrorBlock(), err)
  179.     ENDIF
  180.  
  181.     // OPEN ok?
  182.     IF nFileError = F_OK
  183.  
  184.           // Go to START of report file
  185.        FSEEK(nFrmHandle, 0)
  186.  
  187.           // SEEK ok?
  188.        nFileError = FERROR()
  189.        IF nFileError = F_OK
  190.  
  191.           // Read entire file into process buffer
  192.           nBytesRead = FREAD(nFrmHandle, @cFileBuff, SIZE_FILE_BUFF)
  193.  
  194.           // READ ok?
  195.           IF nBytesRead = 0
  196.              nFileError = F_EMPTY        // file is empty
  197.           ELSE
  198.              nFileError = FERROR()       // check for DOS errors
  199.           ENDIF
  200.  
  201.           IF nFileError = F_OK
  202.  
  203.              // Is this a .FRM type file (2 at start and end of file)
  204.           IF BIN2W(SUBSTR(cFileBuff, 1, 2)) = 2 .AND.;
  205.               BIN2W(SUBSTR(cFileBuff, SIZE_FILE_BUFF - 1, 2)) = 2
  206.  
  207.                 nFileError = F_OK
  208.              ELSE
  209.                     nFileError = F_ERROR
  210.             ENDIF
  211.  
  212.         ENDIF
  213.  
  214.     ENDIF
  215.  
  216.    // Close file
  217.    IF !FCLOSE(nFrmHandle)
  218.       nFileError = FERROR()
  219.    ENDIF
  220.  
  221. ENDIF
  222.  
  223. // File existed, was opened and read ok and is a .FRM file
  224. IF nFileError = F_OK
  225.  
  226.    // Fill processing buffers
  227.    cLengthsBuff = SUBSTR(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF)
  228.    cOffsetsBuff = SUBSTR(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF)
  229.    cExprBuff    = SUBSTR(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF)
  230.    cFieldsBuff  = SUBSTR(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF)
  231.    cParamsBuff  = SUBSTR(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF)
  232.  
  233.  
  234.    // Process report attributes
  235.    // Report width
  236.    aReport[ RP_WIDTH ]   := BIN2W(SUBSTR(cParamsBuff, PAGE_WIDTH_OFFSET, 2))
  237.  
  238.    // Lines per page
  239.    aReport[ RP_LINES ]   := BIN2W(SUBSTR(cParamsBuff, LNS_PER_PAGE_OFFSET, 2))
  240.  
  241.    // Page offset (left margin)
  242.    aReport[ RP_LMARGIN ] := BIN2W(SUBSTR(cParamsBuff, LEFT_MRGN_OFFSET, 2))
  243.  
  244.    // Page right margin (not used)
  245.    aReport[ RP_RMARGIN ] := BIN2W(SUBSTR(cParamsBuff, RIGHT_MGRN_OFFSET, 2))
  246.  
  247.    nColCount  = BIN2W(SUBSTR(cParamsBuff, COL_COUNT_OFFSET, 2))
  248.  
  249.    // Line spacing
  250.    // Spacing is 1, 2, or 3
  251.    aReport[ RP_SPACING ] := IF(SUBSTR(cParamsBuff, DBL_SPACE_OFFSET, 1) $ "Yy", 2, 1)
  252.  
  253.    // Summary report flag
  254.    aReport[ RP_SUMMARY ] := IF(SUBSTR(cParamsBuff, SUMMARY_RPT_OFFSET, 1) $ "Yy", .T., .F.)
  255.  
  256.    // Process report eject and plain attributes option byte
  257.    cOptionByte = ASC(SUBSTR(cParamsBuff, OPTION_OFFSET, 1))
  258.  
  259.    IF INT(cOptionByte / 4) = 1
  260.       aReport[ RP_PLAIN ] := .T.          // Plain page
  261.       cOptionByte -= 4
  262.    ENDIF
  263.  
  264.    IF INT(cOptionByte / 2) = 1
  265.       aReport[ RP_AEJECT ] := .T.         // Page eject after report
  266.       cOptionByte -= 2
  267.    ENDIF
  268.  
  269.    IF INT(cOptionByte / 1) = 1
  270.       aReport[ RP_BEJECT ] := .F.         // Page eject before report
  271.       cOptionByte -= 1
  272.    ENDIF
  273.  
  274.    // Page heading, report title
  275.    nPointer = BIN2W(SUBSTR(cParamsBuff, PAGE_HDR_OFFSET, 2))
  276.  
  277.     aReport[ RP_HEADER ] := ;
  278.         ListAsArray(GetExpr( nPointer ), ;
  279.                     ";", ;
  280.                     aReport[ RP_WIDTH ] - aReport[ RP_RMARGIN ] )
  281.  
  282.  
  283.    // Process Groups
  284.    // Group
  285.    nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_EXPR_OFFSET, 2))
  286.  
  287.    IF !EMPTY(cGroupExp := GetExpr( nPointer ))
  288.  
  289.       // Add a new group array
  290.       AADD( aReport[ RP_GROUPS ], ARRAY( RG_COUNT ))
  291.  
  292.       // Group expression
  293.       aReport[ RP_GROUPS ][1][ RG_TEXT ] := cGroupExp
  294.       aReport[ RP_GROUPS ][1][ RG_EXP ] := &( "{ || " + cGroupExp + "}" )
  295.       IF USED()
  296.          aReport[ RP_GROUPS ][1][ RG_TYPE ] := ;
  297.                         VALTYPE( EVAL( aReport[ RP_GROUPS ][1][ RG_EXP ] ) )
  298.       ENDIF
  299.  
  300.       // Group header
  301.       nPointer = BIN2W(SUBSTR(cParamsBuff, GRP_HDR_OFFSET, 2))
  302.       aReport[ RP_GROUPS ][1][ RG_HEADER ] := GetExpr( nPointer )
  303.  
  304.       // Page eject after group
  305.       aReport[ RP_GROUPS ][1][ RG_AEJECT ] := IF(SUBSTR(cParamsBuff, PE_OFFSET, 1) $ "Yy", .T., .F.)
  306.       
  307.    ENDIF
  308.  
  309.    // Subgroup
  310.    nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_EXPR_OFFSET, 2))
  311.  
  312.    IF !EMPTY(cSubGroupExp := GetExpr( nPointer ))
  313.  
  314.       // Add new group array
  315.       AADD( aReport[ RP_GROUPS ], ARRAY( RG_COUNT ))
  316.  
  317.       // Subgroup expression
  318.       aReport[ RP_GROUPS ][2][ RG_TEXT ] := cSubGroupExp
  319.       aReport[ RP_GROUPS ][2][ RG_EXP ] := &( "{ || " + cSubGroupExp + "}" )
  320.       IF USED()
  321.          aReport[ RP_GROUPS ][2][ RG_TYPE ] := ;
  322.                         VALTYPE( EVAL( aReport[ RP_GROUPS ][2][ RG_EXP ] ) )
  323.       ENDIF
  324.  
  325.       // Subgroup header
  326.       nPointer = BIN2W(SUBSTR(cParamsBuff, SUB_HDR_OFFSET, 2))
  327.       aReport[ RP_GROUPS ][2][ RG_HEADER ] := GetExpr( nPointer )
  328.  
  329.       // Page eject after subgroup
  330.       aReport[ RP_GROUPS ][2][ RG_AEJECT ] := .F.
  331.  
  332.    ENDIF
  333.  
  334.    // Process columns
  335.      nFieldOffset := 12      // dBASE skips first 12 byte fields block.
  336.    FOR nCount := 1 to nColCount
  337.  
  338.       AADD( aReport[ RP_COLUMNS ], GetColumn( cFieldsBuff, @nFieldOffset ) )
  339.  
  340.    NEXT
  341.  
  342. ENDIF
  343.  
  344. RETURN aReport
  345.  
  346.  
  347. /***
  348. *  GetExpr( nPointer ) --> cString
  349. *
  350. *  Reads an expression from EXPR_BUFF via the OFFSETS_BUFF and returns
  351. *  a pointer to offset contained in OFFSETS_BUFF that in turn points
  352. *  to an expression located in the EXPR_BUFF string.
  353. *
  354. *  Notes:
  355. *
  356. *     1. The expression is empty if:
  357. *         a. Passed pointer is equal to 65535
  358. *         b. Character following character pointed to by pointer is CHR(0)
  359. *             
  360. */
  361. STATIC FUNCTION GetExpr( nPointer )
  362.    LOCAL nExprOffset   := 0
  363.    LOCAL nExprLength   := 0
  364.    LOCAL nOffsetOffset := 0
  365.    LOCAL cString := ""
  366.  
  367.    // Stuff for dBASE compatability.
  368.    IF nPointer != 65535
  369.  
  370.       // Convert DOS FILE offset to CLIPPER string offset
  371.       nPointer++
  372.  
  373.       // Calculate offset into OFFSETS_BUFF
  374.       IF nPointer > 1
  375.          nOffsetOffset = (nPointer * 2) - 1
  376.       ENDIF
  377.  
  378.       nExprOffset = BIN2W(SUBSTR(cOffsetsBuff, nOffsetOffset, 2))
  379.       nExprLength = BIN2W(SUBSTR(cLengthsBuff, nOffsetOffset, 2))
  380.  
  381.       // EXPR_OFFSET points to a NULL, so add one (+1) to get the string
  382.       // and subtract one (-1) from EXPR_LENGTH for correct length
  383.  
  384.       nExprOffset++
  385.       nExprLength--
  386.  
  387.       // Extract string
  388.       cString = SUBSTR(cExprBuff, nExprOffset, nExprLength)
  389.  
  390.       // dBASE does this so we must do it too
  391.       // Character following character pointed to by pointer is NULL
  392.       IF CHR(0) = SUBSTR(cString, 1, 1) .AND. LEN(SUBSTR(cString,1,1)) = 1
  393.          cString = ""
  394.       ENDIF
  395.    ENDIF
  396.  
  397.    RETURN (cString)
  398.  
  399.  
  400. /***
  401. *  GetColumn( <cFieldBuffer>, @<nOffset> ) --> aColumn
  402. *
  403. *  Get a COLUMN element from FIELDS_BUFF string using nOffset to point to
  404. *  the current FIELDS_OFFSET block.
  405. *
  406. *  Notes:
  407. *     1. The Header or Contents expressions are empty if:
  408. *        a. Passed pointer is equal to 65535
  409. *        b. Character following character pointed to by pointer is CHR(0)
  410. *
  411. */
  412. STATIC FUNCTION GetColumn( cFieldsBuffer, nOffset )
  413.    LOCAL nPointer := 0, nNumber := 0, aColumn[ RC_COUNT ], cType
  414.  
  415.    // Column width
  416.    aColumn[ RC_WIDTH ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + FIELD_WIDTH_OFFSET, 2))
  417.  
  418.    // Total column?
  419.    aColumn[ RC_TOTAL ] := IF(SUBSTR(cFieldsBuffer, nOffset + FIELD_TOTALS_OFFSET, 1) $ "Yy", .T., .F.)
  420.    
  421.    // Decimals width
  422.    aColumn[ RC_DECIMALS ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + FIELD_DECIMALS_OFFSET, 2))
  423.  
  424.    // Offset (relative to FIELDS_OFFSET), 'point' to
  425.    // expression area via array OFFSETS[]
  426.    
  427.    // Content expression
  428.    nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +;
  429.                FIELD_CONTENT_EXPR_OFFSET, 2))
  430.    aColumn[ RC_TEXT ] := GetExpr( nPointer )
  431.    aColumn[ RC_EXP ] := &( "{ || " + GetExpr( nPointer ) + "}" )
  432.    
  433.    // Header expression
  434.    nPointer = BIN2W(SUBSTR(cFieldsBuffer, nOffset +;
  435.                FIELD_HEADER_EXPR_OFFSET, 2))
  436.  
  437.    aColumn[ RC_HEADER ] := ListAsArray(GetExpr( nPointer ), ";")
  438.    
  439.    // Column picture
  440.    // Setup picture only if a database file is open
  441.    IF USED()
  442.       cType := VALTYPE( EVAL(aColumn[ RC_EXP ]) )
  443.       aColumn[ RC_TYPE ] := cType
  444.       DO CASE
  445.       CASE cType = "C" .OR. cType = "M"
  446.          aColumn[ RC_PICT ] := REPLICATE("X", aColumn[ RC_WIDTH ])
  447.       CASE cType = "D"
  448.          aColumn[ RC_PICT ] := "@D"
  449.       CASE cType = "N"
  450.          IF aColumn[ RC_DECIMALS ] != 0
  451.             aColumn[ RC_PICT ] := REPLICATE("9", aColumn[ RC_WIDTH ] - aColumn[ RC_DECIMALS ] -1) + "." + ;
  452.                                   REPLICATE("9", aColumn[ RC_DECIMALS ])
  453.          ELSE
  454.             aColumn[ RC_PICT ] := REPLICATE("9", aColumn[ RC_WIDTH ])
  455.          ENDIF
  456.       CASE cType = "L"
  457.          aColumn[ RC_PICT ] := "@L" + REPLICATE("X",aColumn[ RC_WIDTH ]-1)
  458.       ENDCASE
  459.    ENDIF
  460.  
  461.    // Update offset into ?_buffer
  462.    nOffset += 12
  463.  
  464.    RETURN ( aColumn )
  465.  
  466. /***
  467. *  ListAsArray( <cList>, <cDelimiter>, [<nWidth>] ) --> aList
  468. *  Convert a delimited string to an array
  469. *
  470. */
  471. STATIC FUNCTION ListAsArray( cList, cDelimiter, nWidth )
  472.  
  473. LOCAL nPos
  474. LOCAL aList := {}                          // Define an empty array
  475. LOCAL lDelimLast := .f.
  476.   
  477.     IF cDelimiter = NIL
  478.         cDelimiter := ","
  479.     ENDIF
  480.  
  481.     if nWidth == NIL
  482.         nWidth := Len(cList)
  483.     end
  484.  
  485.     DO WHILE ( Len(cList) <> 0 )
  486.  
  487.         nPos := AT(cDelimiter, cList)
  488.  
  489.         if ( nPos == 0 )
  490.             nPos := Len(cList)
  491.         end
  492.  
  493.         if ( nPos - 1 > nWidth )
  494.             nPos := nWidth
  495.  
  496.             while ( nPos > 0 .and. substr(cList, nPos, 1) <> " " )
  497.                 nPos --
  498.             end
  499.  
  500.             if ( nPos == 0 )
  501.                 nPos := nWidth
  502.             end
  503.         end
  504.  
  505.         if ( SUBSTR( cList, nPos, 1 ) == cDelimiter )
  506.             lDelimLast := .t.
  507.             AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element
  508.         else
  509.             lDelimLast := .f.
  510.             AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element
  511.         end
  512.  
  513.         cList := SUBSTR(cList, nPos + 1)
  514.  
  515.     ENDDO
  516.  
  517.     if ( lDelimLast )
  518.         AADD(aList, "")
  519.     end
  520.  
  521. RETURN aList                              // Return the array
  522.