home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / commands.zip / COMMANDS.PRG next >
Text File  |  1986-05-28  |  16KB  |  628 lines
  1.  
  2.  
  3.  
  4. * Program.....: COMMANDS.PRG
  5. * DATES ......: 10/25/85, 10/27/85,03/14/86, 05/14/86
  6. * NOTICE......: Copyright 1985 1986, Glenn Abelson, Inc.  All rights reserved
  7. * NOTES.......: MUST USE WITH ERRORCHK.PRG & GLIST.PRG
  8. CLOS DATA
  9. SET SAFE OFF
  10. *
  11. * -- Look for pre set normal and reverse colors
  12. * -- if not found establish some
  13. *
  14. IF TYPE('GACOLN') = 'U'
  15.   STORE 'BG+/ ,GR+/ ' TO GACOLN
  16.   STORE 'GR+/ ,BG+/ ' TO GACOLR
  17. ENDI
  18. *
  19. * -- Public memvars carry into errors.prg
  20. * --
  21. PUBLIC CLIPPER,MCOND,MFIELD,MBASE,MCMD,MMB,MINDEX,MNAME
  22. MBASE = ' '
  23. MINDEX = ' '
  24. HELP_CODE = '101'    && If using Clipper, you may assign a help code
  25. CLEA
  26. *
  27. *
  28. *
  29. DO WHIL .T.
  30.   CLEAR
  31.   CHOICE = SPACE(1)
  32.   SET EXACT ON
  33.   SET COLOR TO &GACOLN 
  34.   IF CLIPPER
  35.     frame = CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200)+;
  36.     CHR(186)
  37.     @ 1,10,15,70 BOX frame
  38.   ELSE
  39.     @  1, 10  TO 15, 70    DOUBLE
  40.   ENDI
  41. *
  42. * -- Command mode menu
  43. *
  44.   @  1, 25  SAY "  Command menu selections  "
  45.   SET COLOR TO &GACOLR 
  46.   @  3, 12  SAY "SET-UP DATABASE               CLEAN-UP FUNCTIONS"
  47.   @  4, 12  SAY "<U>se a database              <D>elete records"
  48.   @  5, 12  SAY "<I>ndex set up                <R>ecall records"
  49.   @  6, 12  SAY "<F>ield list                  <P>ack database"
  50.   @  7, 42  SAY "<Z>ap database"
  51.   @  8, 12  SAY "MATH FUNCTIONS"
  52.   @  9, 12  SAY "<A>verage a field             SEARCH AND LOCATE"
  53.   @ 10, 12  SAY "<C>ount records               <L>ist/Display"
  54.   @ 11, 12  SAY "<T>otals/sums                 <S>earch/Locate records"
  55.   @ 13, 27  SAY "GLOBAL UPDATE"
  56.   @ 14, 27  SAY "<G>lobal Replace"
  57.   SET COLOR TO &GACOLN 
  58.   @ 16, 11  SAY "All commands are fully error checked, with step by step"
  59.   @ 17, 11  SAY "walk through for building commands and conditions."
  60.   SET COLOR TO &GACOLR 
  61.   @ 19, 11  SAY "Press letter in <> for more info, then <enter> to continue"
  62.   @ 20, 11  SAY "with function, or any other key to return to menu."
  63.   SET COLOR TO &GACOLN 
  64.   @ 21, 11  SAY "F1 for more help"
  65.   SET COLOR TO &GACOLR 
  66.   @ 22, 11  SAY 'Using &MBASE'
  67.   @ 23, 11  SAY "Any LETTER (F for field list) or <enter> to exit ... "
  68.   @ 23, 63  GET CHOICE
  69.   READ
  70.   DO CASE
  71.     CASE "" = CHOICE
  72.       CLOSE DATA
  73.       SET EXACT OFF
  74.       RETURN
  75. ****
  76. ****
  77. ****  
  78.     CASE UPPER(CHOICE) = 'U'
  79.       SET COLOR TO W+
  80.       @ 23,0 CLEAR
  81.       @ 23,0 SAY 'Use a database from this or any other directory, any extension.'
  82.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  83.       IF .NOT. "" = MGO
  84.         @ 23,0 CLEAR
  85.         LOOP
  86.       ENDI
  87.       CLEAR
  88.       ?' The following databases exist'
  89.       DIR
  90.       ACCE 'USE ... ' TO MBASE
  91.       STORE UPPER(MBASE) TO MBASE
  92. *
  93. * Make sure correct typing
  94. *
  95.       IF FILE('&MBASE') .OR. FILE ('&MBASE' + '.DBF')
  96.         SELECT 1
  97.         USE &MBASE
  98. *
  99. * -- If work is being done on  database, make MLOOK True so
  100. * -- error checking routine for field names will be in effect
  101. *
  102.         ?'Creating error check program for database in use '
  103.         COPY TO DATADICT STRUCTURE EXTENDED
  104.         SELE 2
  105.         USE DATADICT
  106.       ELSE
  107.         MBASE = ' '
  108.         ?' Check list and your spelling -- then re- enter'
  109.         wait
  110.       ENDI
  111.       
  112. *
  113.       
  114. ****
  115. ****
  116. ****
  117.     CASE UPPER(CHOICE) = 'I'
  118.       SET COLOR TO W+
  119.       @ 23,0 CLEAR
  120.       @ 23,0 SAY 'Set an index if you want records in a particular order '
  121.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  122.       IF .NOT. "" = MGO
  123.         @ 23,0 CLEAR
  124.         LOOP
  125.       ENDI
  126.       IF MBASE = " "
  127.         ?'YOU MUST USE A DATABASE FIRST'
  128.         WAIT
  129.         LOOP
  130.       ENDI
  131.       CLEA
  132.       IF CLIPPER 
  133.         ? 'Clipper requires an .NTX index.  You may create an index, here.'
  134.         ? '.ntx will be automatically added '
  135.       ENDI
  136.       
  137.       ?' Use INDEX selection or create an index'
  138.       ?
  139.       ?' The following index fields currently exist - See manual for which'
  140.       ?' index fields belong with which databases'
  141.       DIR *.NTX
  142.       ?
  143.       ?'1. Use a current index '
  144.       WAIT '2. Create and use a new index ' TO MIN
  145.       IF MIN <> '2'
  146.         SELECT 1
  147.         ACCE 'SET INDEX TO 'TO MINDEX
  148.         IF FILE('&MINDEX') .OR. FILE('&MINDEX' + '.NTX') .OR. FILE('&MINDEX' + '.NDX')
  149.           SET INDEX TO &MINDEX
  150.           LOOP
  151.         ELSE
  152.           ?"Can't find that index"
  153.           ?'You may re-enter data'
  154.           ?'or Create a new index from Index menu'
  155.           wait
  156.           loop
  157.         endi
  158.       ELSE
  159.         SELECT 1
  160.         ACCE 'Field or field combination to index on ... ' TO MINON
  161.         ACCE 'Index name... ' TO MINDEX
  162.         IF MINDEX < "!"
  163.           LOOP
  164.         ENDI
  165.         ?' INDEXING TO &MINDEX '
  166.         INDEX ON &MINON TO &MINDEX
  167.       ENDI
  168. ****
  169. ****
  170. ****
  171.     CASE UPPER(CHOICE) = 'F'
  172.       SET COLOR TO W+
  173.       @ 23,0 CLEAR
  174.       @ 23,0 SAY 'List field names, types, lengths and decimals '
  175.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  176.       IF .NOT. "" = MGO
  177.         @ 23,0 CLEAR
  178.         LOOP
  179.       ENDI
  180. *
  181.       SELECT 2
  182.       USE DATADICT
  183.       DO WHILE .NOT. EOF()
  184.         DISP NEXT 19 FIELD_NAME,FIELD_TYPE,FIELD_LEN,FIELD_DEC
  185.         WAIT 'MORE Y/N? ' TO MMORE
  186.         IF UPPER(MMORE) = 'Y'
  187.           LOOP
  188.         ENDI
  189.         CLEAR
  190.         EXIT
  191.       ENDD
  192. ****
  193. ****
  194. ****
  195.     CASE UPPER(CHOICE) = 'A'
  196.       SET COLOR TO W+
  197.       @ 23,0 CLEAR
  198.       @ 23,0 SAY 'Find the Average of any field for any combination of conditions.'
  199.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  200.       IF .NOT. "" = MGO
  201.         @ 23,0 CLEAR
  202.         LOOP
  203.       ENDI
  204.       IF MBASE = " "
  205.         ?'YOU MUST USE A DATABASE FIRST'
  206.         WAIT
  207.         LOOP
  208.       ENDI
  209.       CLEA
  210.       ?' Average [<expression list>][TO <memvar>][FOR/WHILE X=Y]'
  211.       ?' Average requires two Inputs from you -- '
  212.       ?
  213.       ?' 1. The field (from open database) you wish to average'
  214.       ?' 2. The conditions. To use ALL RECORDS, press return when prompted'
  215.       ?'    for conditions.'
  216.       ?' memvar is automatically created as MAVERAGE and displayed to screen'
  217.       ?
  218.       ACCE 'Field on which to AVERAGE 'TO MFIELD
  219.       IF MFIELD < "!"
  220.         LOOP
  221.       ENDI
  222. *
  223. * ERROR CHECKING ROUTINE, ON  DATABASE ONLY
  224. *
  225.       
  226.       SELE 2
  227.       STORE UPPER(MFIELD) TO MC
  228.       LOCATE FOR FIELD_NAME="&MC"
  229.       IF EOF()
  230.         ? CHR(7)
  231.         ?'That is not a field name in  &MBASE'
  232.         wait
  233.         loop
  234.       ENDI
  235.       STORE FIELD_TYPE TO MTYPE
  236.       IF MTYPE <> 'N'
  237.         ?CHR(7)
  238.         ?'You must use a NUMERIC field with this command'
  239.         WAIT
  240.         LOOP
  241.       ENDI
  242.       STORE 'AVERAGE' TO MCMD
  243.       DO ERRORCHK      && Mini error checking, on conditions only
  244.       IF MCOND = 'NONE'
  245.         LOOP
  246.       ENDI
  247. *
  248. * AVERAGE ALL RECORDS IF NO  FOR CONDITION IS ENTERED
  249. *
  250. *
  251.       SELE 1
  252.       AVERAGE &MFIELD TO MAVERAGE FOR &MCOND
  253.       ?MAVERAGE
  254.       wait
  255.       
  256. ****
  257. ****
  258. ****
  259.     CASE UPPER(CHOICE) = 'C'
  260.       SET COLOR TO W+
  261.       @ 23,0 CLEAR
  262.       @ 23,0 SAY 'Count the number of records that meet specified conditions.'
  263.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  264.       IF .NOT. "" = MGO
  265.         @ 23,0 CLEAR
  266.         LOOP
  267.       ENDI
  268.       IF MBASE = " "
  269.         ?'YOU MUST USE A DATABASE FIRST'
  270.         WAIT
  271.         LOOP
  272.       ENDI
  273.       CLEA
  274.       STORE 'COUNT' TO MCMD
  275.       STORE 'ALL' TO MFIELD
  276.       DO ERRORCHK
  277.       IF MCOND = 'NONE'
  278.         LOOP
  279.       ENDI
  280.       SELE 1
  281.       COUNT ALL TO MCOUNT FOR &MCOND
  282.       ?MCOUNT
  283.       WAIT
  284.       SET FILTER TO
  285. ****
  286. ****
  287. ****
  288.     CASE UPPER(CHOICE) = 'T'
  289.       SET COLOR TO W+
  290.       @ 23,0 CLEAR
  291.       @ 23,0 SAY 'Get the sum of a field for all records or specific conditions.'
  292.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  293.       IF .NOT. "" = MGO
  294.         @ 23,0 CLEAR
  295.         LOOP
  296.       ENDI
  297.       IF MBASE = " "
  298.         ?'YOU MUST USE A DATABASE FIRST'
  299.         WAIT
  300.         LOOP
  301.       ENDI
  302.       CLEA
  303.       
  304.       ?' SUM [FIELD NAME] TO MEMVAR FOR [CONDITIONS]'
  305.       ?
  306.       ACCE 'SUM (field name) ' TO MCOM
  307.       IF MCOM <"!"
  308.         LOOP
  309.       ENDI
  310. *
  311. * ERROR CHECKING ROUTINE, ON  DATABASE ONLY
  312. *
  313.       STORE '&MCOM' TO MFIELD
  314.       SELE 2
  315.       STORE UPPER(MCOM) TO MC
  316.       LOCATE FOR FIELD_NAME="&MC"
  317.       IF EOF()
  318.         ? CHR(7)
  319.         ?'That is not a field name in  &MBASE'
  320.         wait
  321.         loop
  322.       ENDI
  323.       STORE FIELD_TYPE TO MTYPE
  324.       IF MTYPE <> 'N'
  325.         ?CHR(7)
  326.         ?'You must use a NUMERIC field with this command'
  327.         WAIT
  328.         LOOP
  329.       ENDI
  330.       STORE 'SUM' TO MCMD
  331.       DO ERRORCHK
  332.       IF MCOND = 'NONE'
  333.         LOOP
  334.       ENDI
  335.       SELE 1
  336.       SUM &MCOM TO MSUM FOR &MCOND
  337.       ?MSUM
  338.       WAIT
  339.       
  340. ****
  341. ****
  342. ****
  343.     CASE UPPER(CHOICE) = 'D'
  344.       SET COLOR TO W+
  345.       @ 23,0 CLEAR
  346.       @ 23,0 SAY 'Delete records by number(s) or by special mark in any field'
  347.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  348.       IF .NOT. "" = MGO
  349.         @ 23,0 CLEAR
  350.         LOOP
  351.       ENDI
  352.       IF MBASE = " "
  353.         ?'YOU MUST USE A DATABASE FIRST'
  354.         WAIT
  355.         LOOP
  356.       ENDI
  357.       CLEA
  358.       STORE 'DELETE' TO MCMD
  359.       STORE 'ALL' TO MFIELD
  360.       DO ERRORCHK
  361.       IF MCOND = 'NONE'
  362.         LOOP
  363.       ENDI
  364.       SELE 1
  365.       
  366.       
  367.       DELETE ALL FOR &MCOND
  368.       ?'Deletion done'
  369.       
  370. ****
  371. ****
  372. ****
  373.     CASE UPPER(CHOICE) = 'R'
  374.       SET COLOR TO W+
  375.       @ 23,0 CLEAR
  376.       @ 23,0 SAY 'Recall, or bring back deleted records.'
  377.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  378.       IF .NOT. "" = MGO
  379.         @ 23,0 CLEAR
  380.         LOOP
  381.       ENDI
  382.       IF MBASE = " "
  383.         ?'YOU MUST USE A DATABASE FIRST'
  384.         WAIT
  385.         LOOP
  386.       ENDI
  387.       CLEA
  388.       STORE 'RECALL' TO MCMD
  389.       STORE 'ALL' TO MFIELD
  390.       DO ERRORCHK
  391.       IF MCOND = 'NONE'
  392.         LOOP
  393.       ENDI
  394.       SELE 1
  395.       
  396.       RECALL ALL FOR &MCOND
  397.       SET DELETED ON
  398.       WAIT 'Recall done - press a key for menu'
  399.       
  400. ****
  401. ****
  402. ****
  403.     CASE UPPER(CHOICE) = 'P'
  404.       SET COLOR TO W+
  405.       @ 23,0 CLEAR
  406.       @ 23,0 SAY 'Pack -- permanently erase deleted records from file.'
  407.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  408.       IF .NOT. "" = MGO
  409.         @ 23,0 CLEAR
  410.         LOOP
  411.       ENDI
  412.       IF MBASE = " "
  413.         ?'YOU MUST USE A DATABASE FIRST'
  414.         WAIT
  415.         LOOP
  416.       ENDI
  417.       CLEA
  418.       
  419.       ?' ALL DELETED RECORDS IN ACTIVE &MBASE WILL BE ERASED'
  420.       ?' <Enter> PACKS -- any other key ABORTS'
  421.       WAIT TO PRESS
  422.       IF PRESS >= "!"
  423.         LOOP
  424.       ENDI
  425.       ?'Packing &MBASE'
  426.       ?'Reindex when done'
  427.       PACK
  428.       
  429. ****
  430. ****
  431. ****
  432.     CASE UPPER(CHOICE) = 'Z'
  433.       SET COLOR TO W+
  434.       @ 23,0 CLEAR
  435.       @ 23,0 SAY 'Empty a database of ALL records, but save form.'
  436.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  437.       IF .NOT. "" = MGO
  438.         @ 23,0 CLEAR
  439.         LOOP
  440.       ENDI
  441.       IF MBASE = " "
  442.         ?'YOU MUST USE A DATABASE FIRST'
  443.         WAIT
  444.         LOOP
  445.       ENDI
  446.       CLEA
  447.    TEXT
  448.  
  449.    YOU ARE ABOUT TO ERASE ALL DATA FROM THE &MBASE IN USE.
  450.  
  451.    ENDTEXT
  452.       ACCE 'Type ZAP  to zap and press <enter>...anything else exits ' TO mzap
  453.       IF UPPER(mzap)="ZAP"
  454.         ? CHR(7)
  455.         WAIT 'You are about to remove ALL DATA from &MBASE - (C)ontinues ' to mgo
  456.         IF UPPER(mgo) = 'C'
  457.           SELECT 1
  458.           ZAP
  459.           SELECT 2
  460.         ELSE
  461.           LOOP
  462.         ENDI
  463.       ELSE
  464.         LOOP
  465.       ENDI
  466.       
  467. ****
  468. ****
  469. ****
  470.     CASE UPPER(CHOICE) = 'L'
  471.       SET COLOR TO W+
  472.       @ 23,0 CLEAR
  473.       @ 23,0 SAY 'Lists can be created and saved to Screen, text file or printer.'
  474.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  475.       IF .NOT. "" = MGO
  476.         @ 23,0 CLEAR
  477.         LOOP
  478.       ENDI
  479.       IF MBASE = " "
  480.         ?'YOU MUST USE A DATABASE FIRST'
  481.         WAIT
  482.         LOOP
  483.       ENDI
  484.       CLEA
  485.       DO GLIST
  486.       
  487. ****
  488. ****
  489. ****
  490.     CASE UPPER(CHOICE) = 'S'
  491.       SET COLOR TO W+
  492.       @ 23,0 CLEAR
  493.       @ 23,0 SAY 'Locate information from any position within a field. '
  494.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  495.       IF .NOT. "" = MGO
  496.         @ 23,0 CLEAR
  497.         LOOP
  498.       ENDI
  499.       IF MBASE = " "
  500.         ?'YOU MUST USE A DATABASE FIRST'
  501.         WAIT
  502.         LOOP
  503.       ENDI
  504.       CLEA
  505.       STORE 'LOCATE' TO MCMD
  506.       STORE 'ALL' TO MFIELD
  507.       DO ERRORCHK
  508.       IF MCOND = 'NONE'
  509.         LOOP
  510.       ENDI
  511.       SELE 1
  512.       
  513. *
  514. * Since SET TALK is off for Compiled dbase, below must be
  515. * used to show results of LOCATE
  516. *
  517.       SET TALK OFF
  518.       ?'MATCHING LIST - EDIT IN EDIT MODE'
  519.       LOCATE FOR &MCOND
  520.       DO WHIL .T.
  521.         CLEAR
  522.         LINE = 1
  523.         DO WHILE LINE < 20
  524.           @ ROW()+1,1 SAY RECNO()
  525.           @ ROW(), COL()+1 SAY &MNAME
  526.           
  527.           LINE = LINE + 1
  528.           IF EOF()
  529.             ?'You may show a blank record at end of file. This is normal.'
  530.             WAIT
  531.             STORE ' ' TO MWHAT   && To force return to menu
  532.             EXIT
  533.           ELSE
  534.             CONT
  535.             IF LINE < 20
  536.               LOOP
  537.             ENDI
  538.           ENDI
  539.           
  540.           WAIT '(M)ore or <enter> exit ' to MWHAT
  541.         ENDD
  542.         IF MWHAT < "!"
  543.           EXIT
  544.         ELSE
  545.           CONT
  546.           LOOP
  547.         ENDI
  548.       ENDDO
  549. ****
  550. ****
  551. ****
  552.     CASE UPPER(CHOICE) = 'G'
  553.       SET COLOR TO W+
  554.       @ 23,0 CLEAR
  555.       @ 23,0 SAY 'Replace contents of one field with new data for part or whole database.'
  556.       WAIT '<enter> to continue, any other key to exit ' TO MGO
  557.       IF .NOT. "" = MGO
  558.         @ 23,0 CLEAR
  559.         LOOP
  560.       ENDI
  561.       IF MBASE = " "
  562.         ?'YOU MUST USE A DATABASE FIRST'
  563.         WAIT
  564.         LOOP
  565.       ENDI
  566.       CLEA
  567.       
  568.       SET COLOR TO W*+/ ,W/ ,W
  569.       ?' BE SURE YOU HAVE A BACKUP OF FILES FIRST'
  570.       SET COLOR TO &GACOLN 
  571.       STORE 'REPLACE' TO MCMD
  572.       SELECT 1
  573.       
  574.       ?
  575.       ?'REPLACE [scope][field(s) WITH <expression>][FOR/WHILE <condition>]'
  576.       ?
  577.       ?'Below reassigns GRA to all SKA accounts for NY state'
  578.       ?'REPLACE [ALL] [SALES_CODE] WITH ["GRA"] FOR [SALES_CODE="SKA" .AND.'
  579.       ?'STATE = "NY"'
  580.       ?
  581.       ?' You will enter information in three sections'
  582.       ?' First is field(s) to replace'
  583.       ?' At next prompt enter what to replace with'
  584.       ?' At third prompt enter conditions to look for'
  585.       ?
  586.       ACCE 'REPLACE ALL [FIELDNAME]' TO MCOM
  587.       IF MCOM <"!"
  588.         LOOP
  589.       ENDI
  590. *
  591. * ERROR CHECKING ROUTINE, ON  DATABASE ONLY
  592. *
  593.       STORE '&MCOM' TO MFIELD
  594.       SELE 2
  595.       STORE UPPER(MCOM) TO MC
  596.       LOCATE FOR FIELD_NAME="&MC"
  597.       IF EOF()
  598.         ? CHR(7)
  599.         ?'That is not a field name in  &MBASE'
  600.         wait
  601.         loop
  602.       ENDI
  603.       
  604.       ACCE 'REPLACE ALL &MCOM WITH [WHAT TO REPLACE WITH]' TO MMB
  605.       IF FIELD_TYPE = 'C' .OR. FIELD_TYPE = 'L'  && ADD QUOTES IF NEEDED
  606.         STORE '"'+'&MMB'+'"' TO MMB
  607.       ENDI
  608.       DO ERRORCHK
  609.       IF MCOND = 'NONE'
  610.         LOOP
  611.       ENDI
  612.       ? 'REPLACE ALL &MCOM WITH &MMB FOR &MCOND'
  613.       SELE 1
  614.       REPLACE ALL &MCOM WITH &MMB FOR &MCOND
  615.       
  616.       ?' done'
  617.       WAIT
  618.       
  619. ****
  620. ****
  621. ****
  622.     OTHERWISE
  623.       CLOSE DATABASE
  624.       SET EXACT OFF
  625.       RETURN
  626.   ENDCASE
  627. ENDDO
  628.