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