home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / bcklib2.zip / BVASST.PRG < prev    next >
Text File  |  1993-05-19  |  37KB  |  1,451 lines
  1. /*
  2.     The source code contained within this file is protected under the
  3.     laws of the United States of America and by International Treaty.
  4.     Unless otherwise noted, the source contained herein is:
  5.  
  6.     Copyright (c)1990, 1991, 1992 BecknerVision Inc - All Rights Reserved
  7.  
  8.     Written by John Wm Beckner        THIS NOTICE MUST NOT BE REMOVED
  9.     BecknerVision Inc
  10.     PO Box 11945                      DISTRIBUTE ONLY WITH SHAREWARE
  11.     Winston-Salem NC 27116            VERSION OF THIS PRODUCT.
  12.     Fax: 919/760-1003
  13.  
  14. */
  15.  
  16. /* THIS PROGRAM HAS NOT BEEN SET TO BECKNERVISION'S CLIPPER 5 STANDARD */
  17.  
  18. #include "beckner.inc"
  19.  
  20. *BecknerVision dBase On-Site Assistant
  21.  
  22. EXTERNAL NetName
  23.  
  24. FUNCTION bvAssist(cFileName, cIndices)
  25.    PRIVATE cFilter := "", cVersion := '5.3', lUseColor, nWRow, nWCol
  26.    PRIVATE nStartRec, nEndRec, cScreen, lChanged := .n., lAbort := .n.
  27.    PRIVATE cDBFName, cNTXStr
  28.    SET EXCLUSIVE OFF
  29.    iShare(.y.)
  30.    cScreen := vSave()
  31.    SET CURSOR on
  32.    SET KEY -6 to red_alert
  33.    SET KEY -8 to ctrl_w
  34.    STORE 0 to nWRow, nWCol, nStartRec, nEndRec
  35.    SET TYPEAHEAD to 200
  36.    cDBFName := space(20)
  37.    IF cFileName!=NIL
  38.       KEYBOARD chr(13)
  39.       cDBFName := sSetLength(cFileName,20)
  40.    ENDIF
  41.    IF iscolor()
  42.       lUseColor := .y.
  43.       SET COLOR to bg,b/w
  44.    ELSE
  45.       lUseColor := .n.
  46.       SET COLOR to
  47.    ENDIF
  48.    cNTXStr := space(50)
  49.    IF cIndices!=NIL
  50.       cNTXStr := cIndices
  51.       KEYBOARD chr(13)
  52.    ENDIF
  53.    WHILE LOOPING
  54.       iif(file('\bvdbase.dbf'), fKill('\bvdbase.db?'), NIL)
  55.       new_dbf := .n.
  56.       CLS
  57.       @ 1,0 say 'BecknerVision dBase On-Site Assistant '+cVersion
  58.       @ 2,0 say 'Copyright (c)1989, 1991 John Wm Beckner - All Rights Reserved'
  59.       @ 3,0 to 23,79 double
  60.       IF '.'$cDBFName
  61.          cDBFName := left(cDBFName,at('.',cDBFName)-1)
  62.       ENDIF
  63.       IF len(cDBFName)<20
  64.          cDBFName := cDBFName+left(space(20),20-len(cDBFName))
  65.       ENDIF
  66.       IF len(cNTXStr)<50
  67.          cNTXStr := sSetLength(cNTXStr,50)
  68.       ENDIF
  69.       @ 4,1 say 'Filename:' get cDBFName picture '@!K'
  70.       @ 4,col()+3 say '(<F7> Emergency/<F8> Abort/<F9> ctrl-W)'
  71.       @ 5,1 say 'Indices: ' get cNTXStr picture '@!K'
  72.       READ
  73.       cDBFName := trim(cDBFName)
  74.       IF empty(cDBFName)
  75.          yes := .y.
  76.          @ 24,0 say chr(7)+'Quit (Y/N)? ' get yes picture 'Y'
  77.          READ
  78.          IF yes
  79.             vRestore(cScreen)
  80.             QUIT
  81.          ELSE
  82.             LOOP
  83.          ENDIF
  84.       ENDIF
  85.       IF '?'$cDBFName.or.'*'$cDBFName
  86.          dirchk(cDBFName)
  87.          LOOP
  88.       ENDIF
  89.       IF !'.'$cDBFName
  90.          cDBFName := trim(cDBFName)+'.DBF'
  91.       ENDIF
  92.       IF !file(cDBFName)
  93.          yes := .n.
  94.          @ 24,0 say chr(7)+'Create empty database (Y/N)?' get yes picture 'Y'
  95.          READ
  96.          @ 24,0
  97.          IF yes
  98.             new_dbf := .y.
  99.          ELSE
  100.             @ 24,0 say chr(7)+'File not found!  Press any key to continue...'
  101.             inkey(30)
  102.             @ 24,0
  103.             LOOP
  104.          ENDIF
  105.       ENDIF
  106.       IF new_dbf
  107.          yes := .y.
  108.          @ 24,0 say chr(7)+'Use STRUCT.DBF' GET YES PICT 'y'
  109.          READ
  110.          @ 24,0
  111.          IF yes
  112.             COPY FILE \struct.dbf to \bvdbase.dbf
  113.             CREATE (cDBFName) from \struct
  114.             USE \bvdbase exclusive
  115.             new_dbf := .n.
  116.          ELSE
  117.             CREATE \bvdbase
  118.          ENDIF
  119.       ELSE
  120.          fShare(cDBFName)
  121.          cNTXStr := trim(cNTXStr)
  122.          IF !empty(cNTXStr)
  123.             ntemp := cNTXStr
  124.             WHILE !empty(ntemp)
  125.                nt := sParse(@ntemp,',')
  126.                nt += iif('.'$nt,'','.ntx')
  127.                IF !file(nt)
  128.                   cr_ntx := .n.
  129.                   @ 24,0 say chr(7)+'Create new index (Y/N)?' get cr_ntx picture 'Y'
  130.                   READ
  131.                   @ 24,0
  132.                   IF !cr_ntx
  133.                      LOOP
  134.                   ENDIF
  135.                   ke := space(50)
  136.                   @ 24,0 say chr(7)+'Key expression:' get ke
  137.                   READ
  138.                   @ 24,0
  139.                   ke := trim(ke)
  140.                   @ 24,0 say chr(7)+'Indexing...'
  141.                   inde on &(ke) to (cNTXStr)
  142.                   @ 24,0
  143.                   SET INDEX to
  144.                ENDIF
  145.             ENDWHILE
  146.          ENDIF
  147.          COPY STRUCTURE EXTENDED to \bvdbase
  148.          USE \bvdbase excl
  149.       ENDIF
  150.       SET MESSAGE to 24
  151.       lChanged := .n.
  152.       WHILE LOOPING
  153.          lAbort := .n.
  154.          IF lUseColor
  155.             SET COLOR to bg,b/w
  156.          ELSE
  157.             SET COLOR to
  158.          ENDIF
  159.          @ 24,0
  160.          IF new_dbf
  161.             DO dbf_a
  162.             LOOP
  163.          ENDIF
  164.          SET KEY -7 to
  165.          @ 6,1 clear to 22,78
  166.          IF lChanged
  167.             SET COLOR to i*
  168.             @ 3,0 to 23,79 double
  169.             IF lUseColor
  170.                SET COLOR to bg,b/w
  171.             ELSE
  172.                SET COLOR to
  173.             ENDIF
  174.          ENDIF
  175.          GO TOP
  176.          IF !empty(cFilter)
  177.             @ 22,70 say 'FILTER'
  178.          ENDIF
  179.          @ 6,1 prompt 'A. Add    ' message 'Adds a new field to the exisiting database'
  180.          @ 7,1 prompt 'B. Delete ' message 'Removes an existing field from the current database'
  181.          @ 8,1 prompt 'C. Change ' message [Lets you change a field's parameters]
  182.          @ 9,1 prompt 'D. Display' message 'Displays the structure of the current database'
  183.          @ 10,1 prompt 'E. Print  ' message 'Prints the database structure on the printer'
  184.          @ 11,1 prompt 'F. Ed/Add ' message 'Edit an actual record from the database or Add a new record'
  185.          @ 12,1 prompt 'G. Rep/Del' message 'Replace or delete DATA in actual database records'
  186.          @ 13,1 prompt 'H. Struct ' message 'Create Structure file'
  187.          @ 14,1 prompt 'I. ZapAll ' message 'ZAP ALL DATA!!!'
  188.          @ 15,1 prompt 'J. Browse ' message 'dBase style record browse'
  189.          @ 16,1 prompt 'K. Pack   ' message 'Actually pack all data'
  190.          @ 17,1 prompt 'L. Append ' message 'Adds records to the current database from another file'
  191.          @ 18,1 prompt 'M. Sets   ' message 'Toggle logical Set values'
  192.          @ 19,1 prompt 'N. Stat/++' message 'Statistics about the file, Expression evaluation'
  193.          @ 20,1 prompt 'Q. Quit   ' message 'Quits this database file'
  194.          opt := 4
  195.          MENU to opt
  196.          @ 24,0
  197.          @ 6,1 clear to 22,78
  198.          IF opt=15
  199.             DO chk_chg
  200.             EXIT
  201.          ENDIF
  202.          IF opt=0
  203.             LOOP
  204.          ENDIF
  205.          a := chr(64+opt)
  206.          SET KEY -7 to reg_abt
  207.          DO CASE
  208.          CASE a='A'
  209.             DO dbf_a
  210.          CASE a='B'
  211.             DO dbf_b
  212.          CASE a='C'
  213.             DO dbf_c
  214.          CASE a='D'
  215.             DO dbf_d
  216.          CASE a='E'
  217.             DO dbf_e
  218.          CASE a='F'
  219.             DO dbf_f
  220.          CASE a='G'
  221.             DO dbf_g
  222.          CASE a='H'
  223.             DO dbf_h
  224.          CASE a='I'
  225.             DO dbf_i
  226.          CASE a='J'
  227.             DO dbf_j
  228.          CASE a='K'
  229.             DO dbf_k
  230.          CASE a='L'
  231.             DO dbf_l
  232.          CASE a='M'
  233.             DO dbf_m
  234.          CASE a='N'
  235.             DO dbf_n
  236.          ENDCASE
  237.       ENDWHILE
  238.    ENDWHILE
  239. ENDFUNCTION
  240.  
  241. ***** Add field
  242. PROCEDURE dbf_a
  243.    WHILE LOOPING
  244.       WHILE LOOPING
  245.          @ 6,1 clear to 14,70
  246.          @ 6,1 say 'Adding a field'
  247.          fld_name := '          '
  248.          GO BOTTOM
  249.          @ 8,1 say 'Last field:'
  250.          @ 8,col()+1 say field_name
  251.          @ 8,col()+1 say field_type
  252.          @ 8,col()+1 say field_len
  253.          @ 8,col()+1 say field_dec
  254.          @ 10,1 say 'Enter field name .......' get fld_name picture '@! AXXXXXXXXX'
  255.          @ 10,col()+2 say '(<F6> to change last)'
  256.          fld_type := 'C'
  257.          @ 11,1 say 'Field type (C/N/L/M/D) .' get fld_type picture '@! A' valid fld_type$'CNLMDR'
  258.          @ 11,col()+2 say '(R/epeat last)'
  259.          SET KEY -5 to modlast
  260.          READ
  261.          SET KEY -5 to
  262.          IF lAbort .or. empty(fld_name)
  263.             RETURN
  264.          ENDIF
  265.          LOCATE FOR fld_name==field_name
  266.          IF found()
  267.             @ 24,0 say chr(7)+'Field name already exists as field #'+str(recno(),3)+'.  Press any key...'
  268.             inkey(30)
  269.             @ 24,0
  270.             LOOP
  271.          ENDIF
  272.          fld_dec := 0
  273.          IF fld_type='M'
  274.             fld_len := 10
  275.          ELSEIF fld_type='D'
  276.             fld_len := 8
  277.          ELSEIF fld_type='L'
  278.             fld_len := 1
  279.          ELSEIF fld_type='R'
  280.             GO BOTTOM
  281.             fld_type := field_type
  282.             fld_len := field_len
  283.             fld_dec := field_dec
  284.             @ 12,1 say 'REPEATING:'
  285.             @ 12,col()+2 say fld_type
  286.             @ 12,col()+1 say fld_len
  287.             @ 12,col()+1 say fld_dec
  288.          ELSE
  289.             fld_len := 0
  290.             @ 12,1 say 'Field length ...........' get fld_len picture '999'
  291.             IF fld_type='N'
  292.                @ 13,1 say 'Field decimals .........' get fld_dec picture '999'
  293.             ENDIF
  294.             READ
  295.             IF lAbort
  296.                RETURN
  297.             ENDIF
  298.          ENDIF
  299.          yes := .y.
  300.          @ 14,1 say 'Accept (Y/N)?' get yes picture 'Y'
  301.          READ
  302.          IF yes
  303.             EXIT
  304.          ENDIF
  305.       ENDWHILE
  306.       APPEND BLANK
  307.       REPLACE field_name with fld_name,field_type with fld_type,field_len with fld_len,field_dec with fld_dec
  308.       lChanged := .y.
  309.       IF new_dbf
  310.          USE
  311.          CREATE (cDBFName) from \bvdbase
  312.          USE
  313.          USE \bvdbase excl
  314.          EXIT
  315.       ENDIF
  316.    ENDWHILE
  317.    new_dbf := .n.
  318. ENDPROCEDURE
  319.  
  320. ***** Check FOR changes and make 'em
  321. PROCEDURE chk_chg
  322.    IF !lChanged
  323.       RETURN
  324.    ENDIF
  325.    lChanged := .n.
  326.    @ 3,0 to 23,79 double
  327.    SET COLOR to i*
  328.    @ 11,11 say '* * *   C H A N G E   I M P L E M E N T A T I O N   * * *'
  329.    IF lUseColor
  330.       SET COLOR to bg,b/w
  331.    ELSE
  332.       SET COLOR to
  333.    ENDIF
  334.    USE
  335.    CREATE bvtemp from \bvdbase
  336.    APPEND FROM (cDBFName)
  337.    USE
  338.    ERASE (cDBFName)
  339.    RENAME bvtemp.dbf to (cDBFName)
  340.    IF file('bvtemp.dbt')
  341.       b := substr(cDBFName,1,len(cDBFName)-1)+'t'
  342.       ERASE (b)
  343.       RENAME bvtemp.dbt to (b)
  344.    ENDIF
  345.    fShare(cDBFName)
  346.    ERASE \bvdbase.dbf
  347.    COPY stru exte to \bvdbase
  348.    USE \bvdbase excl
  349.    @ 11,11 say space(64)
  350. ENDPROCEDURE
  351.  
  352. *****DELETE A FIELD
  353. PROCEDURE dbf_b
  354.    rec := 0
  355.    @ 6,1 say 'Field # to delete ...' get rec picture '999'
  356.    READ
  357.    IF lAbort
  358.       RETURN
  359.    ENDIF
  360.    IF rec<1 .or. rec>reccount()
  361.       @ 24,0 say chr(7)+'Invalid field #.  Press any key to continue...'
  362.       inkey(30)
  363.       @ 24,0
  364.       RETURN
  365.    ENDIF
  366.    GO rec
  367.    @ 8,1 say field_name
  368.    @ 8,col()+2 say field_type
  369.    @ 8,col()+2 say field_len
  370.    @ 8,col()+2 say field_dec
  371.    yes := .n.
  372.    @ 10,1 say 'Delete this field (Y/N)?' get yes picture 'Y'
  373.    READ
  374.    IF yes .and. !lAbort
  375.       DELETE
  376.       @ 24,0 say chr(7)+'Packing...'
  377.       PACK
  378.       @ 24,0
  379.       lChanged := .y.
  380.    ENDIF
  381. ENDPROCEDURE
  382.  
  383. ***** CHANGE FIELDS
  384. PROCEDURE dbf_c
  385.    rec := 0
  386.    @ 6,1 say 'Starting field #' get rec picture '999'
  387.    READ
  388.    IF lAbort
  389.       RETURN
  390.    ENDIF
  391.    @ 6,1 clear to 6,70
  392.    IF rec<1 .or. rec>reccount()
  393.       @ 24,0 say chr(7)+'Field # out of range.  Press any key to continue...'
  394.       inkey(30)
  395.       @ 24,0
  396.       RETURN
  397.    ENDIF
  398.    GO rec
  399.    WHILE LOOPING
  400.       @ 6,1 say 'Field name ........' get field_name picture '@!'
  401.       @ 7,1 say 'Type (C/L/N/D/M) ..' get field_type picture '@! A' valid field_type$'CLNDM'
  402.       @ 8,1 say 'Length ............' get field_len valid (field_type='L'.and.field_len=1).or.(field_type='M'.and.field_len=10).or.(field_type='D'.and.field_len=8).or.field_type$'NC'
  403.       @ 9,1 say 'Decimals ..........' get field_dec
  404.       READ
  405.       IF recno()<reccount() .and. !lAbort
  406.          nxt := .y.
  407.          @ 11,1 say 'Next field (Y/N)?' get nxt picture 'Y'
  408.          READ
  409.          IF nxt
  410.             SKIP
  411.             LOOP
  412.          ENDIF
  413.       ENDIF
  414.       lChanged := .y.
  415.       RETURN
  416.    ENDWHILE
  417. ENDPROCEDURE
  418.  
  419. ***** DISPLAY STRUCTURE
  420. PROCEDURE dbf_d
  421.    nLineCtr := 6
  422.    start_no := 1
  423.    @ 24,0 say 'Starting field # to display:' get start_no picture '999'
  424.    @ 24,col()+1 say '(0=reverse display)'
  425.    READ
  426.    @ 24,0
  427.    IF start_no<0 .or. start_no>reccount()
  428.       @ 24,0 say 'Invalid field #.'
  429.       inkey(5)
  430.       @ 24,0
  431.       RETURN
  432.    ENDIF
  433.    IF start_no=0
  434.       rev_order := .y.
  435.       GO BOTTOM
  436.    ELSE
  437.       rev_order := .n.
  438.       GO start_no
  439.    ENDIF
  440.    WHILE !(eof() .or. (bof() .and. rev_order))
  441.       @ 6,1 clear to 22,78
  442.       WHILE !(eof() .or. (rev_order .and. bof())) .and. nLineCtr<=20
  443.          IF rev_order .and. nLineCtr=6 .and. reccount()=recno()
  444.             @ nLineCtr,3 say '**end**'
  445.             nLineCtr++
  446.             LOOP
  447.          ENDIF
  448.          @ nLineCtr,1 say recno() picture '999'
  449.          @ nLineCtr,col()+2 say field_name
  450.          @ nLineCtr,col()+2 say field_type
  451.          @ nLineCtr,col()+2 say field_len
  452.          @ nLineCtr,col()+2 say field_dec
  453.          nLineCtr++
  454.          IF rev_order
  455.             SKIP -1
  456.          ELSE
  457.             SKIP
  458.          ENDIF
  459.       ENDWHILE
  460.       IF eof() .or. (bof() .and. rev_order)
  461.          @ row()+1,3 say '**end**'
  462.       ENDIF
  463.       nLineCtr := 6
  464.       @ 22,1 say 'PRESS ANY KEY TO CONTINUE...'
  465.       x_x := inkey(0)
  466.       IF lAbort .or. x_x=-7
  467.          EXIT
  468.       ENDIF
  469.    ENDWHILE
  470. ENDPROCEDURE
  471.  
  472. *****PRINT STRUCTURE
  473. PROCEDURE dbf_e
  474.    GO TOP
  475.    SET PRINT on
  476.    SET CONSOLE off
  477.    @ 24,0 say chr(7)+'Printing...'
  478.    ? 'Structure FOR',cDBFName
  479.    ?
  480.    WHILE !eof()
  481.       ? transform(recno(),'999'),field_name,''
  482.       DO CASE
  483.       CASE field_type='C'
  484.          ?? 'Character',field_len
  485.       CASE field_type='D'
  486.          ?? 'Date'
  487.       CASE field_type='M'
  488.          ?? 'Memo'
  489.       CASE field_type='N'
  490.          ?? 'Numeric  ',field_len,iif(field_dec=0,'',field_dec)
  491.       CASE field_type='L'
  492.          ?? 'Logical'
  493.       ENDCASE
  494.       SKIP
  495.    ENDWHILE
  496.    ?
  497.    @ 24,0
  498.    SET PRINT off
  499.    SET CONSOLE on
  500. ENDPROCEDURE
  501.  
  502.  
  503. ***** EDIT/ADD A RECORD
  504. PROCEDURE dbf_f
  505.    MEMVAR cFilter
  506.    DO chk_chg
  507.    ae := 'A'
  508.    @ 24,0 say chr(7)+'A/dd or E/dit ...' get ae picture '@! A' valid ae$'AE'
  509.    READ
  510.    IF lAbort
  511.       RETURN
  512.    ENDIF
  513.    @ 24,0
  514.    IF ae='E'
  515.       rec := 0
  516.       @ 24,0 say chr(7)+'Record #' get rec picture '99999'
  517.       READ
  518.       IF lAbort
  519.          RETURN
  520.       ENDIF
  521.       @ 24,0
  522.       SELECT b
  523.       fShare(cDBFName)
  524.       IF !empty(cFilter)
  525.          SET FILTER to &(cFilter)
  526.       ENDIF
  527.       IF rec<1 .or. rec>reccount()
  528.          @ 24,0 say chr(7)+'Max rec is #'+str(reccount(),5)+'.   Press any key to continue...'
  529.          inkey(30)
  530.          @ 24,0
  531.          USE
  532.          SELECT a
  533.          RETURN
  534.       ENDIF
  535.       IF !empty(cNTXStr)
  536.          o_indices()
  537.       ENDIF
  538.       GO rec
  539.       fLockRec()
  540.    ELSE
  541.       SELECT b
  542.       fShare(cDBFName)
  543.       IF !empty(cFilter)
  544.          SET FILTER to &(cFilter)
  545.       ENDIF
  546.       IF !empty(cNTXStr)
  547.          o_indices()
  548.       ENDIF
  549.       fAddRecord()
  550.       rec := recno()
  551.    ENDIF
  552.    nLineCtr := 6
  553.    SELECT a
  554.    WHILE !eof()
  555.       @ 6,1 clear to 20,77
  556.       WHILE !eof() .and. nLineCtr<=20
  557.          a := trim(field_name)
  558.          IF field_len>65
  559.             @ nLineCtr,1 say field_name get b->&a. picture '@S65'
  560.          ELSE
  561.             @ nLineCtr,1 say field_name get b->&a.
  562.          ENDIF
  563.          nLineCtr++
  564.          SKIP
  565.       ENDWHILE
  566.       READ
  567.       IF lAbort
  568.          EXIT
  569.       ENDIF
  570.       nLineCtr := 6
  571.    ENDWHILE
  572.    SELECT b
  573.    UNLOCK
  574.    USE
  575.    SELECT a
  576. ENDPROCEDURE
  577.  
  578.  
  579. ***** PRESS <CTRL-W>
  580. PROCEDURE ctrl_w
  581.    KEYBOARD chr(23)
  582. ENDPROCEDURE
  583.  
  584.  
  585. ***** REGULAR ABORT
  586. PROCEDURE reg_abt
  587.    KEYBOARD chr(23)
  588.    lAbort := .y.
  589. ENDPROCEDURE
  590.  
  591.  
  592. ***** RED ALERT, ABORT NOW
  593. PROCEDURE red_alert
  594.    IF lChanged
  595.       yes := .n.
  596.       SET COLOR to i*
  597.       @ 11,11 say 'WARNING!  Changes have been made.  Abandon changes (Y/N)?' get yes picture 'Y'
  598.       READ
  599.       IF lUseColor
  600.          SET COLOR to bg,b/w
  601.       ELSE
  602.          SET COLOR to
  603.       ENDIF
  604.       IF !yes
  605.          DO chk_chg
  606.       ENDIF
  607.    ENDIF
  608.    vRestore(cScreen)
  609.    pQuit()
  610. ENDPROCEDURE
  611.  
  612. ***** REPLACING DATA
  613. PROCEDURE dbf_g
  614.    MEMVAR cFilter
  615.    DO chk_chg
  616.    @ 6,1 say 'REPLACING DATA'
  617.    no_flds := 1
  618.    rtype := 'C'
  619.    @ 8,1 say '# of fields to replace (99=delete) .............' get no_flds picture '99' rang 0,99
  620.    @ 9,1 say 'Replace C/urrent, A/ll or by F/ilter (C/A/F) ...' get rtype picture '@! A' valid rtype$'CAF'
  621.    READ
  622.    IF lAbort
  623.       RETURN
  624.    ENDIF
  625.    IF no_flds=0
  626.       @ 24,0 say chr(7)+'You specified 0 fields to replace.  Press any key to continue...'
  627.       inkey(30)
  628.       @ 24,0
  629.       RETURN
  630.    ENDIF
  631.    IF rtype='F'
  632.       flt := space(254)
  633.       @ 10,1 say 'Enter filter:' get flt picture '@S40'
  634.       READ
  635.       IF lAbort
  636.          RETURN
  637.       ENDIF
  638.    ENDIF
  639.    IF no_flds<99
  640.       nCtr := 1
  641.       WHILE nCtr<=no_flds
  642.          a := str(no_flds,iif(no_flds<10,1,2))
  643.          fld&a. := space(10)
  644.          data&a. := space(254)
  645.          @ 12,1 clear to 20,78
  646.          @ 12,1 say nCtr picture '99'
  647.          @ 13,1 say 'Field name .....' get fld&a. picture '@!'
  648.          @ 14,1 say 'Replacement data' get data&a. picture '@S55'
  649.          READ
  650.          IF lAbort
  651.             RETURN
  652.          ENDIF
  653.          LOCATE FOR fld&a.==field_name
  654.          IF !found()
  655.             @ 24,0 say chr(7)+'Field name not found.  Press any key to retry...'
  656.             inkey(30)
  657.             @ 24,0
  658.             LOOP
  659.          ENDIF
  660.          nCtr++
  661.       ENDWHILE
  662.    ENDIF
  663.    @ 12,1 clear to 20,78
  664.    SELECT b
  665.    fShare(cDBFName)
  666.    IF !empty(cNTXStr)
  667.       o_indices()
  668.    ENDIF
  669.    IF !empty(cFilter)
  670.       SET FILTER to &(cFilter)
  671.    ENDIF
  672.    IF rtype='C'
  673.       rec := 0
  674.       @ 12,1 say 'Record #' get rec picture '999999'
  675.       READ
  676.       IF lAbort
  677.          USE
  678.          SELECT a
  679.          RETURN
  680.       ENDIF
  681.       IF rec<1.or.rec>reccount()
  682.          USE
  683.          SELECT a
  684.          @ 24,0 say chr(7)+'Invalid record #.  Press any key to continue...'
  685.          inkey(30)
  686.          @ 24,0
  687.          RETURN
  688.       ENDIF
  689.       GO rec
  690.       fLockRec()
  691.       IF no_flds=99
  692.          DELETE
  693.       ELSE
  694.          DO cur_REPLACE
  695.       ENDIF
  696.       UNLOCK
  697.    ELSE
  698.       @ 24,0 say reccount() picture '999,999'
  699.       WHILE !eof()
  700.          @ 24,10 say recno() picture '999,999'
  701.          IF rtype='F'
  702.             IF !(&flt.)
  703.                SKIP
  704.                LOOP
  705.             ENDIF
  706.          ENDIF
  707.          fLockRec()
  708.          IF no_flds=99
  709.             DELETE
  710.          ELSE
  711.             DO cur_REPLACE
  712.          ENDIF
  713.          UNLOCK
  714.          SKIP
  715.       ENDWHILE
  716.    ENDIF
  717.    USE
  718.    SELECT a
  719.    @ 24,0
  720. ENDPROCEDURE
  721.  
  722.  
  723. PROCEDURE cur_REPLACE
  724.    priv nCtr,a,b,c
  725.    nCtr := 1
  726.    WHILE nCtr<=no_flds
  727.       a := str(nCtr,iif(nCtr<10,1,2))
  728.       b := trim(fld&a.)
  729.       c := trim(data&a.)
  730.       fLockRec()
  731.       REPLACE &(b) with &(c)
  732.       UNLOCK
  733.       nCtr++
  734.    ENDWHILE
  735. ENDPROCEDURE
  736.  
  737.  
  738. ***** CREATE STRUCTURE FILE
  739. PROCEDURE dbf_h
  740.    @ 24,0
  741.    @ 24,0 say 'Creating structure file \STRUCT.DBF...'
  742.    COPY to \struct
  743.    @ 24,0
  744. ENDPROCEDURE
  745.  
  746.  
  747. ***** ZAP ALL DATA
  748. PROCEDURE dbf_i
  749.    IF !vIsSure()
  750.       RETURN
  751.    ENDIF
  752.    SELECT b
  753.    fNoShare(cDBFName)
  754.    IF !empty(cNTXStr)
  755.       o_indices()
  756.    ENDIF
  757.    set safe off
  758.    ZAP
  759.    PACK
  760.    USE
  761.    SELECT a
  762. ENDPROCEDURE
  763.  
  764.  
  765. ***** BROWSE
  766. PROCEDURE dbf_j
  767.    MEMVAR cFilter
  768.    DO chk_chg
  769.    SELECT b
  770.    scr := savescreen(0,0,24,79)
  771.    fNoShare(cDBFName)
  772.    IF !empty(cNTXStr)
  773.       o_indices()
  774.    ENDIF
  775.    IF !empty(cFilter)
  776.       SET FILTER to &(cFilter)
  777.    ENDIF
  778.    rec := 1
  779.    SEEK_str := space(50)
  780.    @ 6,1 say 'BROWSING'
  781.    @ 8,1 say 'Starting record #' get rec picture '999999'
  782.    @ 9,1 say 'Seek string:     ' get SEEK_str
  783.    READ
  784.    SEEK_str := trim(SEEK_str)
  785.    IF rec=999999
  786.       GO TOP
  787.    ELSEIF rec<1 .or. rec>reccount()
  788.       @ 24,0 say chr(7)+'Illegal record number.  Press any key to continue...'
  789.       inkey(30)
  790.       @ 24,0
  791.       USE
  792.       SELECT a
  793.       RETURN
  794.    ELSEIF !empty(SEEK_str)
  795.       SEEK &SEEK_str.
  796.    ELSE
  797.       go rec
  798.    ENDIF
  799.    CLS
  800.    SET KEY -2 to set_st
  801.    SET KEY -3 to set_end
  802.    SET KEY -4 to activ
  803.    @ 0, 0
  804.    @ 24,0 say '<F3>=Set start record  <F4>=Set end record  <F5>=Activate block commands'
  805.    fBrowse()
  806.    @ 24,0
  807.    SET KEY -4 to
  808.    SET KEY -3 to
  809.    SET KEY -2 to
  810.    USE
  811.    restscreen(0,0,24,79,scr)
  812.    SELECT a
  813.    UNLOCK
  814. ENDPROCEDURE
  815.  
  816.  
  817. ***** SET START RECORD
  818. PROCEDURE set_st
  819.    nStartRec := recno()
  820.    @ 0,5 say nStartRec picture '9,999,999'
  821. ENDPROCEDURE
  822.  
  823.  
  824. ***** SET END RECORD
  825. PROCEDURE set_end
  826.    nEndRec := recno()
  827.    @ 0,15 say nEndRec picture '9,999,999'
  828. ENDPROCEDURE
  829.  
  830.  
  831. ***** ACTIVATE BLOCK COMMANDS
  832. PROCEDURE activ
  833.    LOCAL x,a, nCurSel
  834.    IF nStartRec=0.or.nEndRec=0
  835.       RETURN
  836.    ENDIF
  837.    nCurSel := Select()
  838.    @ 24,0
  839.    @ 24,0 say 'D/elete  C/opy  A/bort'
  840.    x := inkey(10)
  841.    @ 24,0
  842.    @ 24,0 say '<F3>=Set start record  <F4>=Set end record  <F5>=Activate block commands'
  843.    a := upper(chr(x))
  844.    IF a="D"
  845.       GO nStartRec
  846.       WHILE nEndRec<>recno()
  847.          DELETE
  848.          SKIP
  849.       ENDWHILE
  850.       DELETE
  851.    ELSEIF a="C"
  852.       GO nStartRec
  853.       COPY to bv$$$ whil nEndRec<>recno()
  854.       COPY NEXT 1 to xx$$$
  855.       SELECT 122
  856.       USE bv$$$ excl
  857.       APPEND FROM xx$$$
  858.       ERASE xx$$$.dbf
  859.       IF file('xx$$$.dbt')
  860.          ERASE xx$$$.dbt
  861.       ENDIF
  862.       SELECT (Select(nCurSel))
  863.    ENDIF
  864.    STORE 0 to nStartRec, nEndRec
  865.    @ 0,5 say space(30)
  866. ENDPROCEDURE
  867.  
  868.  
  869. ***** PACK DATA
  870. PROCEDURE dbf_k
  871.    DO chk_chg
  872.    SELECT b
  873.    fNoShare(cDBFName)
  874.    IF !empty(cNTXStr)
  875.       o_indices()
  876.    ENDIF
  877.    @ 24,0 say 'Packing...'
  878.    PACK
  879.    USE
  880.    @ 24,0 say 'Warning!  Indices may have to be reindexed.'
  881.    inkey(5)
  882.    @ 24,0
  883.    SELECT a
  884. ENDPROCEDURE
  885.  
  886.  
  887. ***** APPEND RECORDS
  888. PROCEDURE dbf_l
  889.    DO chk_chg
  890.    SELECT b
  891.    fShare(cDBFName)
  892.    IF !empty(cNTXStr)
  893.       o_indices()
  894.    ENDIF
  895.    apfile := space(40)
  896.    @ 24,0 say 'File to append from ...' get apfile picture '@!'
  897.    READ
  898.    @ 24,0
  899.    apfilter := space(200)
  900.    @ 24,0 say 'Append from filter ...' get apfilter picture '@S60'
  901.    READ
  902.    apfilter := trim(apfilter)
  903.    IF empty(apfilter)
  904.       apfilter := '.y.'
  905.    ENDIF
  906.    apfile := trim(apfile)
  907.    IF !'.'$apfile
  908.       apfile := apfile+'.DBF'
  909.    ENDIF
  910.    @ 24,0
  911.    IF !file(apfile)
  912.       @ 24,0 say chr(7)+'Not found'
  913.       inkey(10)
  914.       @ 24,0
  915.       USE
  916.       SELECT a
  917.       RETURN
  918.    ENDIF
  919.    @ 24,0 say 'Appending records...'
  920.    APPEND FROM (apfile) FOR (apfilter)
  921.    USE
  922.    @ 24,0
  923.    SELECT a
  924. ENDPROCEDURE
  925.  
  926.  
  927. ***** Sets
  928. PROCEDURE dbf_m
  929.    MEMVAR cFilter
  930.    @ 6,1 say 'Enter the number preceding the SET VALUE to toggle:'
  931.    WHILE LOOPING
  932.       @ 8,1 say ' 1. Bell .......................'
  933.       @ 8,col()+1 say iif(set(26), 'On ', 'Off')
  934.       @ row()+1,1 say ' 2. Confirm ....................'
  935.       @ row(),col()+1 say iif(set(27), 'On ', 'Off')
  936.       @ row()+1,1 say ' 3. Cursor .....................'
  937.       @ row(),col()+1 say iif(set(16)>0, 'On ', 'Off')
  938.       @ row()+1,1 say ' 4. Deleted ....................'
  939.       @ row(),col()+1 say iif(set(11), 'On ', 'Off')
  940.       @ row()+1,1 say ' 5. Exact ......................'
  941.       @ row(),col()+1 say iif(set(1), 'On ', 'Off')
  942.       @ row()+1,1 say ' 6. Filter ..................... '+cFilter
  943.       @ row()+1,1 say ' 7. Print ......................'
  944.       @ row(),col()+1 say iif(set(23), 'On ', 'Off')
  945.       @ row()+1,1 say ' 8. Scoreboard .................'
  946.       @ row(),col()+1 say iif(set(32), 'On ', 'Off')
  947.       @ row()+1,1 say ' 9. Softseek ...................'
  948.       @ row(),col()+1 say iif(set(9), 'On ', 'Off')
  949.       @ row()+1,1 say '10. Unique .....................'
  950.       @ row(),col()+1 say iif(set(10), 'On ', 'Off')
  951.       @ row()+1,1 say '11. Wrap .......................'
  952.       @ row(),col()+1 say iif(set(35), 'On ', 'Off')
  953.       xopt := 0
  954.       @ 21,1 say 'Option # to toggle (0=quit):' get xopt picture '99'
  955.       READ
  956.       DO CASE
  957.       CASE xopt=0
  958.          EXIT
  959.       CASE xopt=1
  960.          set(26, !set(26))
  961.       CASE xopt=2
  962.          set(27, !set(27))
  963.       CASE xopt=3
  964.          set(16, !set(16))
  965.       CASE xopt=4
  966.          set(11, !set(11))
  967.       CASE xopt=5
  968.          set(1, !set(1))
  969.       CASE xopt=6
  970.          cFilter := cFilter+space(254-len(cFilter))
  971.          @ 24,0 say 'Current filter: ' get cFilter picture '@KS60'
  972.          READ
  973.          cFilter := trim(cFilter)
  974.          @ 24,0
  975.       CASE xopt=7
  976.          set(23, !set(23))
  977.       CASE xopt=8
  978.          set(32, !set(32))
  979.       CASE xopt=9
  980.          set(9, !set(9))
  981.       CASE xopt=10
  982.          set(10, !set(10))
  983.       CASE xopt=11
  984.          set(35, !set(35))
  985.       ENDCASE
  986.    ENDWHILE
  987. ENDPROCEDURE
  988.  
  989.  
  990. ***** STATS
  991. PROCEDURE dbf_n
  992.    MEMVAR cFilter
  993.    opt := 1
  994.    @ 24,0 prompt 'Info'
  995.    @ 24,col()+1 prompt 'Count'
  996.    @ 24,col()+1 prompt 'Avg'
  997.    @ 24,col()+1 prompt 'Sum'
  998.    @ 24,col()+1 prompt 'Expr'
  999.    @ 24,col()+1 prompt 'Generators'
  1000.    @ 24,col()+1 prompt 'Orphanage'
  1001.    @ 24,col()+1 prompt 'Reindex'
  1002.    @ 24,col()+1 prompt 'Print'
  1003.    @ 24,col()+1 prompt 'Dupl'
  1004.    MENU to opt
  1005.    @ 24,0
  1006.    IF opt=0
  1007.       RETURN
  1008.    ENDIF
  1009.    SELECT b
  1010.    fShare(cDBFName)
  1011.    IF !empty(cFilter)
  1012.       SET FILTER to &(cFilter)
  1013.    ENDIF
  1014.    DO CASE
  1015.    CASE opt=1
  1016.       @ 7,40 clear to 20,76
  1017.       @ 7,40 say '# records ....'
  1018.       @ 8,40 say '# fields .....'
  1019.       @ 9,40 say 'Record length '
  1020.       @ 7,55 say reccount() picture '9,999,999'
  1021.       USE
  1022.       SELECT a
  1023.       @ 8,55 say reccount() picture '9,999,999'
  1024.       SUM field_len to x
  1025.       @ 9,55 say x+1 picture '9,999,999'
  1026.       @ 24,0 say 'Press any key to continue...'
  1027.       inkey(0)
  1028.       @ 24,0
  1029.       @ 7,40 clear to 20,76
  1030.       RETURN
  1031.    CASE opt=2
  1032.       @ 24,0 say 'Counting...'
  1033.       COUNT to x
  1034.       @ 24,12 say x picture '9,999,999'
  1035.       inkey(0)
  1036.       @ 24,0
  1037.       USE
  1038.       SELECT a
  1039.       RETURN
  1040.    CASE opt=3
  1041.       fld := space(10)
  1042.       @ 24,0 say 'Field name or # (precede # with "#"):' get fld picture '@!'
  1043.       READ
  1044.       IF left(fld,1)="#"
  1045.          fld := field(val(substr(fld,2,9)))
  1046.       ENDIF
  1047.       fld := trim(fld)
  1048.       @ 24,0
  1049.       @ 24,0 say 'Averaging '+fld+' ...'
  1050.       AVERAGE &fld. to x
  1051.       @ 24,col()+1 say x
  1052.       USE
  1053.       SELECT a
  1054.       inkey(0)
  1055.       RETURN
  1056.    CASE opt=4
  1057.       fld := space(10)
  1058.       @ 24,0 say 'Field name or # (precede # with "#"):' get fld picture '@!'
  1059.       READ
  1060.       IF left(fld,1)="#"
  1061.          fld := field(val(substr(fld,2,9)))
  1062.       ENDIF
  1063.       fld := trim(fld)
  1064.       @ 24,0
  1065.       @ 24,0 say 'Summing '+fld+' ...'
  1066.       SUM &fld. to x
  1067.       @ 24,col()+1 say x
  1068.       USE
  1069.       SELECT a
  1070.       inkey(0)
  1071.       RETURN
  1072.    CASE opt=5
  1073.       exp := space(254)
  1074.       @ 24,0 say 'Expression:' get exp picture '@S60'
  1075.       READ
  1076.       @ 24,0
  1077.       exp := trim(exp)
  1078.       @ 24,0 say &(exp)
  1079.    CASE opt=6
  1080.       @ 24,0
  1081.       @ 24,0 prompt 'Word Processor'
  1082.       @ 24,col()+2 prompt 'Report Generator'
  1083.       @ 24,col()+2 prompt 'Label Generator'
  1084.       @ 24,col()+2 prompt 'Forms Generator'
  1085.       opt := 1
  1086.       MENU to opt
  1087.       SAVE SCREEN
  1088.       IF opt=1
  1089.          BecknerWP()
  1090.          CLOSE DATA
  1091.          SELECT a
  1092.          fNoShare('\bvdbase')
  1093.       ELSEIF opt=4
  1094.          BecknerFG()
  1095.          CLOSE DATA
  1096.          SELECT a
  1097.          fShare('\bvdbase')
  1098.       ELSEIF opt!=0
  1099.          pRepGen()
  1100.          CLOSE DATA
  1101.          SELECT a
  1102.          fShare('\bvdbase')
  1103.       ENDIF
  1104.       RESTORE SCREEN
  1105.       @ 24,0
  1106.    CASE opt=7
  1107.       SELECT b
  1108.       USE
  1109.       secondary := space(200)
  1110.       @ 24,0
  1111.       @ 24,0 say 'Secondary files:' get secondary picture '@!S50'
  1112.       READ
  1113.       @ 24,0
  1114.       cfn := 'ACCT_NO   '
  1115.       @ 24,0 say 'Common field name:' get cfn picture '@!'
  1116.       READ
  1117.       orphanage(cDBFName,cNTXStr,secondary,cfn)
  1118.    CASE opt=8
  1119.       IF empty(cNTXStr)
  1120.          pBeep()
  1121.       ELSE
  1122.          SELECT b
  1123.          USE
  1124.          fNoShare(cDBFName)
  1125.          o_indices()
  1126.          REINDEX
  1127.       ENDIF
  1128.    CASE opt=9
  1129.       SET CONSOLE off
  1130.       SET PRINT on
  1131.       ? 'Print file:',cDBFName,cNTXStr
  1132.       ? 'Filter:',cFilter
  1133.       ? 'Date/Time:',date(),time()
  1134.       ?
  1135.       ? 'Field list: Recno() '
  1136.       FOR x=1 to fcount()
  1137.          ?? field(x),''
  1138.       NEXT
  1139.       ?
  1140.       WHILE !eof()
  1141.          FOR x := 1 to fcount()
  1142.             aa := field(x)
  1143.             ?? &aa.,''
  1144.          NEXT
  1145.          ?
  1146.          SKIP
  1147.       ENDWHILE
  1148.    CASE opt=10
  1149.       @ 24, 0
  1150.       cExpr := space(500)
  1151.       @ 24, 0 say "Index Expression:" get cExpr picture "@S55"
  1152.       READ
  1153.       @ 24, 0
  1154.       cExpr := Trim(cExpr)
  1155.       IF !Empty(cExpr)
  1156.          vMessageOn("Creating temporary index...")
  1157.          INDEX ON (cExpr) to BEC$0
  1158.          vMessageOff()
  1159.       ENDIF
  1160.       GO TOP
  1161.       @ 24, 0
  1162.       @ 24, 0 say lastrec() picture "99,999,999"
  1163.       DECLARE aOldValue[nLen := fCount()]
  1164.       FOR nCtr := 1 to nLen
  1165.          aOldValue[nCtr] := FieldGet(nCtr)
  1166.          IF ValType(aOldValue[nCtr])="N"
  1167.             aOldValue[nCtr]++
  1168.          ENDIF
  1169.       NEXT
  1170.       WHILE !eof()
  1171.          @ 24, 15 say RecNo() picture "99,999,999"
  1172.          lDeleteIt := .y.
  1173.          FOR nCtr := 1 to nLen
  1174.             IF aOldValue[nCtr]!=FieldGet(nCtr)
  1175.                lDeleteIt := .n.
  1176.                EXIT
  1177.             ENDIF
  1178.          NEXT
  1179.          IF lDeleteIt
  1180.             fLockRec()
  1181.             DELETE
  1182.             UNLOCK
  1183.          ENDIF
  1184.          FOR nCtr := 1 to nLen
  1185.             aOldValue[nCtr] := FieldGet(nCtr)
  1186.          NEXT
  1187.          SKIP
  1188.       ENDWHILE
  1189.       @ 24, 0
  1190.    ENDCASE
  1191.    pBeep()
  1192.    USE
  1193.    SELECT a
  1194.    IF opt<6
  1195.       inkey(0)
  1196.    ENDIF
  1197. ENDPROCEDURE
  1198.  
  1199. FUNCTION dirchk(cWildCard)
  1200.    PRIVATE aFiles, nCtr, nLineCtr, nCount
  1201.    cWildCard := trim(cWildCard)
  1202.    IF cWildCard==''
  1203.       cWildCard := '*.DBF'
  1204.    ENDIF
  1205.    IF !'.'$cWildCard
  1206.       cWildCard += '.DBF'
  1207.    ENDIF
  1208.    nCount := len(aFiles := directory(cWildCard))
  1209.    nCtr := 1
  1210.    nLineCtr := 9
  1211.    WHILE nCtr<=nCount
  1212.       @ 9,1 clear to 20,78
  1213.       WHILE nCtr<nCount .and. nLineCtr<=20
  1214.          @ nLineCtr,2 say aFiles[nCtr, 1]
  1215.          @ row(),15 say aFiles[nCtr, 2] picture '99,999,999'
  1216.          @ row(),26 say aFiles[nCtr, 3]
  1217.          @ row(),35 say aFiles[nCtr, 4]
  1218.          @ row(),45 say aFiles[nCtr, 5]
  1219.          nCtr++
  1220.          nLineCtr++
  1221.       ENDWHILE
  1222.       @ 22,1 say 'PRESS ANY KEY TO CONTINUE'
  1223.       x_x := inkey(0)
  1224.       IF lAbort .or. x_x=-7
  1225.          EXIT
  1226.       ENDIF
  1227.       nLineCtr := 9
  1228.    ENDWHILE
  1229.    RETURN .y.
  1230. ENDFUNCTION
  1231.  
  1232. FUNCTION modlast
  1233.    fld_type := 'R'
  1234.    newstuff := oldstuff := space(10)
  1235.    CLEAR GETS
  1236.    @ 15,1 say 'Old:' get oldstuff picture '@!'
  1237.    @ 16,1 say 'New:' get newstuff picture '@!'
  1238.    READ
  1239.    fld_name := strtran(field_name,trim(oldstuff),trim(newstuff))
  1240.    @ 15,1 clear to 16,30
  1241.    RETURN .y.
  1242. ENDFUNCTION
  1243.  
  1244. FUNCTION orphanage()
  1245.    LOCAL lFound
  1246.    para mainfile,ntxfile,filelist,checkfld
  1247.    priv aa,cursel,nCtr
  1248.    cursel := select()
  1249.    SELECT 0
  1250.    fShare(mainfile,'MAIN')
  1251.    o_indices()
  1252.    SET ORDER to 0
  1253.    checkfld := trim(checkfld)
  1254.    WHILE !empty(filelist)
  1255.       aa := sParse(@filelist,'/')
  1256.       SELECT 0
  1257.       fShare(aa,'DATA')
  1258.       @ 24,0
  1259.       @ 24,0 say aa
  1260.       @ 24,20 say reccount() picture '9,999,999'
  1261.       nCtr := 0
  1262.       WHILE !eof()
  1263.          @ 24,40 say recno() picture '9,999,999'
  1264.          IF deleted()
  1265.             SKIP
  1266.             LOOP
  1267.          ENDIF
  1268.          SELECT main
  1269.          lFound := .y.
  1270.          IF IndexOrd()=0
  1271.             IF Data->&CheckFld.>0 .and. Data->&CheckFld.<=LastRec()
  1272.                dbGoto(Data->&CheckFld.)
  1273.                IF Deleted()
  1274.                   lFound := .n.
  1275.                ENDIF
  1276.             ELSE
  1277.                lFound := .n.
  1278.             ENDIF
  1279.          ELSE
  1280.             SEEK data->&checkfld.
  1281.             lFound := Found()
  1282.          ENDIF
  1283.          IF !lFound
  1284.             SELECT data
  1285.             fLockRec()
  1286.             DELETE
  1287.             UNLOCK
  1288.             nCtr++
  1289.             @ 24,60 say nCtr picture '9,999,999'
  1290.          ENDIF
  1291.          SELECT data
  1292.          SKIP
  1293.       ENDWHILE
  1294.       USE
  1295.       SELECT main
  1296.    ENDWHILE
  1297.    @ 24,0
  1298.    USE
  1299.    SELECT (cursel)
  1300.    RETURN 0
  1301. ENDFUNCTION
  1302.  
  1303. FUNCTION o_indices
  1304.    IF !','$cNTXStr
  1305.       SET INDEX to (cNTXStr)
  1306.       RETURN 0
  1307.    ENDIF
  1308.    n := cNTXStr
  1309.    DO CASE
  1310.    CASE sCount(',',n)=0
  1311.       SET INDEX to (sParse(@n,',')),;
  1312.       (n)
  1313.    CASE sCount(',',n)=1
  1314.       SET INDEX to (sParse(@n,',')),;
  1315.       (sParse(@n,',')),;
  1316.       (n)
  1317.    CASE sCount(',',n)=2
  1318.       SET INDEX to (sParse(@n,',')),;
  1319.       (sParse(@n,',')),;
  1320.       (sParse(@n,',')),;
  1321.       (n)
  1322.    CASE sCount(',',n)=3
  1323.       SET INDEX to (sParse(@n,',')),;
  1324.       (sParse(@n,',')),;
  1325.       (sParse(@n,',')),;
  1326.       (sParse(@n,',')),;
  1327.       (n)
  1328.    CASE sCount(',',n)=4
  1329.       SET INDEX to (sParse(@n,',')),;
  1330.       (sParse(@n,',')),;
  1331.       (sParse(@n,',')),;
  1332.       (sParse(@n,',')),;
  1333.       (sParse(@n,',')),;
  1334.       (n)
  1335.    CASE sCount(',',n)=5
  1336.       SET INDEX to (sParse(@n,',')),;
  1337.       (sParse(@n,',')),;
  1338.       (sParse(@n,',')),;
  1339.       (sParse(@n,',')),;
  1340.       (sParse(@n,',')),;
  1341.       (sParse(@n,',')),;
  1342.       (n)
  1343.    CASE sCount(',',n)=6
  1344.       SET INDEX to (sParse(@n,',')),;
  1345.       (sParse(@n,',')),;
  1346.       (sParse(@n,',')),;
  1347.       (sParse(@n,',')),;
  1348.       (sParse(@n,',')),;
  1349.       (sParse(@n,',')),;
  1350.       (sParse(@n,',')),;
  1351.       (n)
  1352.    CASE sCount(',',n)=7
  1353.       SET INDEX to (sParse(@n,',')),;
  1354.       (sParse(@n,',')),;
  1355.       (sParse(@n,',')),;
  1356.       (sParse(@n,',')),;
  1357.       (sParse(@n,',')),;
  1358.       (sParse(@n,',')),;
  1359.       (sParse(@n,',')),;
  1360.       (sParse(@n,',')),;
  1361.       (n)
  1362.    CASE sCount(',',n)=8
  1363.       SET INDEX to (sParse(@n,',')),;
  1364.       (sParse(@n,',')),;
  1365.       (sParse(@n,',')),;
  1366.       (sParse(@n,',')),;
  1367.       (sParse(@n,',')),;
  1368.       (sParse(@n,',')),;
  1369.       (sParse(@n,',')),;
  1370.       (sParse(@n,',')),;
  1371.       (sParse(@n,',')),;
  1372.       (n)
  1373.    CASE sCount(',',n)=9
  1374.       SET INDEX to (sParse(@n,',')),;
  1375.       (sParse(@n,',')),;
  1376.       (sParse(@n,',')),;
  1377.       (sParse(@n,',')),;
  1378.       (sParse(@n,',')),;
  1379.       (sParse(@n,',')),;
  1380.       (sParse(@n,',')),;
  1381.       (sParse(@n,',')),;
  1382.       (sParse(@n,',')),;
  1383.       (sParse(@n,',')),;
  1384.       (n)
  1385.    CASE sCount(',',n)=10
  1386.       SET INDEX to (sParse(@n,',')),;
  1387.       (sParse(@n,',')),;
  1388.       (sParse(@n,',')),;
  1389.       (sParse(@n,',')),;
  1390.       (sParse(@n,',')),;
  1391.       (sParse(@n,',')),;
  1392.       (sParse(@n,',')),;
  1393.       (sParse(@n,',')),;
  1394.       (sParse(@n,',')),;
  1395.       (sParse(@n,',')),;
  1396.       (sParse(@n,',')),;
  1397.       (n)
  1398.    CASE sCount(',',n)=11
  1399.       SET INDEX to (sParse(@n,',')),;
  1400.       (sParse(@n,',')),;
  1401.       (sParse(@n,',')),;
  1402.       (sParse(@n,',')),;
  1403.       (sParse(@n,',')),;
  1404.       (sParse(@n,',')),;
  1405.       (sParse(@n,',')),;
  1406.       (sParse(@n,',')),;
  1407.       (sParse(@n,',')),;
  1408.       (sParse(@n,',')),;
  1409.       (sParse(@n,',')),;
  1410.       (sParse(@n,',')),;
  1411.       (n)
  1412.    CASE sCount(',',n)=12
  1413.       SET INDEX to (sParse(@n,',')),;
  1414.       (sParse(@n,',')),;
  1415.       (sParse(@n,',')),;
  1416.       (sParse(@n,',')),;
  1417.       (sParse(@n,',')),;
  1418.       (sParse(@n,',')),;
  1419.       (sParse(@n,',')),;
  1420.       (sParse(@n,',')),;
  1421.       (sParse(@n,',')),;
  1422.       (sParse(@n,',')),;
  1423.       (sParse(@n,',')),;
  1424.       (sParse(@n,',')),;
  1425.       (sParse(@n,',')),;
  1426.       (n)
  1427.    CASE sCount(',',n)=13
  1428.       SET INDEX to (sParse(@n,',')),;
  1429.       (sParse(@n,',')),;
  1430.       (sParse(@n,',')),;
  1431.       (sParse(@n,',')),;
  1432.       (sParse(@n,',')),;
  1433.       (sParse(@n,',')),;
  1434.       (sParse(@n,',')),;
  1435.       (sParse(@n,',')),;
  1436.       (sParse(@n,',')),;
  1437.       (sParse(@n,',')),;
  1438.       (sParse(@n,',')),;
  1439.       (sParse(@n,',')),;
  1440.       (sParse(@n,',')),;
  1441.       (sParse(@n,',')),;
  1442.       (n)
  1443.    ENDCASE
  1444.    RETURN 0
  1445. ENDFUNCTION
  1446.  
  1447. /*
  1448.  1.02 02.02.93 Corrected dirchk(), so as not to skip first entry
  1449.  1.02 05.19.93 Made Red_Alert() do pQuit() instead of QUIT
  1450. */
  1451.