Power-Programmierung/CD1.mdf/xbase/library/dbase/commands/commands.prg

Text File | 1986-05-28 | 15.3 KB | 628 lines

* Program.....: COMMANDS.PRG
* DATES ......: 10/25/85, 10/27/85,03/14/86, 05/14/86
* NOTICE......: Copyright 1985 1986, Glenn Abelson, Inc.  All rights reserved
* NOTES.......: MUST USE WITH ERRORCHK.PRG & GLIST.PRG
CLOS DATA
SET SAFE OFF
*
* -- Look for pre set normal and reverse colors
* -- if not found establish some
*
IF TYPE('GACOLN') = 'U'
  STORE 'BG+/ ,GR+/ ' TO GACOLN
  STORE 'GR+/ ,BG+/ ' TO GACOLR
ENDI
*
* -- Public memvars carry into errors.prg
* --
PUBLIC CLIPPER,MCOND,MFIELD,MBASE,MCMD,MMB,MINDEX,MNAME
MBASE = ' '
MINDEX = ' '
HELP_CODE = '101'    && If using Clipper, you may assign a help code
CLEA
*
*
*
DO WHIL .T.
  CLEAR
  CHOICE = SPACE(1)
  SET EXACT ON
  SET COLOR TO &GACOLN
  IF CLIPPER
    frame = CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200)+;
    CHR(186)
    @ 1,10,15,70 BOX frame
  ELSE
    @  1, 10  TO 15, 70    DOUBLE
  ENDI
*
* -- Command mode menu
*
  @  1, 25  SAY "  Command menu selections  "
  SET COLOR TO &GACOLR
  @  3, 12  SAY "SET-UP DATABASE               CLEAN-UP FUNCTIONS"
  @  4, 12  SAY "<U>se a database              <D>elete records"
  @  5, 12  SAY "<I>ndex set up                <R>ecall records"
  @  6, 12  SAY "<F>ield list                  <P>ack database"
  @  7, 42  SAY "<Z>ap database"
  @  8, 12  SAY "MATH FUNCTIONS"
  @  9, 12  SAY "<A>verage a field             SEARCH AND LOCATE"
  @ 10, 12  SAY "<C>ount records               <L>ist/Display"
  @ 11, 12  SAY "<T>otals/sums                 <S>earch/Locate records"
  @ 13, 27  SAY "GLOBAL UPDATE"
  @ 14, 27  SAY "<G>lobal Replace"
  SET COLOR TO &GACOLN
  @ 16, 11  SAY "All commands are fully error checked, with step by step"
  @ 17, 11  SAY "walk through for building commands and conditions."
  SET COLOR TO &GACOLR
  @ 19, 11  SAY "Press letter in <> for more info, then <enter> to continue"
  @ 20, 11  SAY "with function, or any other key to return to menu."
  SET COLOR TO &GACOLN
  @ 21, 11  SAY "F1 for more help"
  SET COLOR TO &GACOLR
  @ 22, 11  SAY 'Using &MBASE'
  @ 23, 11  SAY "Any LETTER (F for field list) or <enter> to exit ... "
  @ 23, 63  GET CHOICE
  READ
  DO CASE
    CASE "" = CHOICE
      CLOSE DATA
      SET EXACT OFF
      RETURN
****
****
****
    CASE UPPER(CHOICE) = 'U'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Use a database from this or any other directory, any extension.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      CLEAR
      ?' The following databases exist'
      DIR
      ACCE 'USE ... ' TO MBASE
      STORE UPPER(MBASE) TO MBASE
*
* Make sure correct typing
*
      IF FILE('&MBASE') .OR. FILE ('&MBASE' + '.DBF')
        SELECT 1
        USE &MBASE
*
* -- If work is being done on  database, make MLOOK True so
* -- error checking routine for field names will be in effect
*
        ?'Creating error check program for database in use '
        COPY TO DATADICT STRUCTURE EXTENDED
        SELE 2
        USE DATADICT
      ELSE
        MBASE = ' '
        ?' Check list and your spelling -- then re- enter'
        wait
      ENDI

*

****
****
****
    CASE UPPER(CHOICE) = 'I'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Set an index if you want records in a particular order '
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      IF CLIPPER
        ? 'Clipper requires an .NTX index.  You may create an index, here.'
        ? '.ntx will be automatically added '
      ENDI

      ?' Use INDEX selection or create an index'
      ?
      ?' The following index fields currently exist - See manual for which'
      ?' index fields belong with which databases'
      DIR *.NTX
      ?
      ?'1. Use a current index '
      WAIT '2. Create and use a new index ' TO MIN
      IF MIN <> '2'
        SELECT 1
        ACCE 'SET INDEX TO 'TO MINDEX
        IF FILE('&MINDEX') .OR. FILE('&MINDEX' + '.NTX') .OR. FILE('&MINDEX' + '.NDX')
          SET INDEX TO &MINDEX
          LOOP
        ELSE
          ?"Can't find that index"
          ?'You may re-enter data'
          ?'or Create a new index from Index menu'
          wait
          loop
        endi
      ELSE
        SELECT 1
        ACCE 'Field or field combination to index on ... ' TO MINON
        ACCE 'Index name... ' TO MINDEX
        IF MINDEX < "!"
          LOOP
        ENDI
        ?' INDEXING TO &MINDEX '
        INDEX ON &MINON TO &MINDEX
      ENDI
****
****
****
    CASE UPPER(CHOICE) = 'F'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'List field names, types, lengths and decimals '
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
*
      SELECT 2
      USE DATADICT
      DO WHILE .NOT. EOF()
        DISP NEXT 19 FIELD_NAME,FIELD_TYPE,FIELD_LEN,FIELD_DEC
        WAIT 'MORE Y/N? ' TO MMORE
        IF UPPER(MMORE) = 'Y'
          LOOP
        ENDI
        CLEAR
        EXIT
      ENDD
****
****
****
    CASE UPPER(CHOICE) = 'A'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Find the Average of any field for any combination of conditions.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      ?' Average [<expression list>][TO <memvar>][FOR/WHILE X=Y]'
      ?' Average requires two Inputs from you -- '
      ?
      ?' 1. The field (from open database) you wish to average'
      ?' 2. The conditions. To use ALL RECORDS, press return when prompted'
      ?'    for conditions.'
      ?' memvar is automatically created as MAVERAGE and displayed to screen'
      ?
      ACCE 'Field on which to AVERAGE 'TO MFIELD
      IF MFIELD < "!"
        LOOP
      ENDI
*
* ERROR CHECKING ROUTINE, ON  DATABASE ONLY
*

      SELE 2
      STORE UPPER(MFIELD) TO MC
      LOCATE FOR FIELD_NAME="&MC"
      IF EOF()
        ? CHR(7)
        ?'That is not a field name in  &MBASE'
        wait
        loop
      ENDI
      STORE FIELD_TYPE TO MTYPE
      IF MTYPE <> 'N'
        ?CHR(7)
        ?'You must use a NUMERIC field with this command'
        WAIT
        LOOP
      ENDI
      STORE 'AVERAGE' TO MCMD
      DO ERRORCHK      && Mini error checking, on conditions only
      IF MCOND = 'NONE'
        LOOP
      ENDI
*
* AVERAGE ALL RECORDS IF NO  FOR CONDITION IS ENTERED
*
*
      SELE 1
      AVERAGE &MFIELD TO MAVERAGE FOR &MCOND
      ?MAVERAGE
      wait

****
****
****
    CASE UPPER(CHOICE) = 'C'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Count the number of records that meet specified conditions.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      STORE 'COUNT' TO MCMD
      STORE 'ALL' TO MFIELD
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      SELE 1
      COUNT ALL TO MCOUNT FOR &MCOND
      ?MCOUNT
      WAIT
      SET FILTER TO
****
****
****
    CASE UPPER(CHOICE) = 'T'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Get the sum of a field for all records or specific conditions.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA

      ?' SUM [FIELD NAME] TO MEMVAR FOR [CONDITIONS]'
      ?
      ACCE 'SUM (field name) ' TO MCOM
      IF MCOM <"!"
        LOOP
      ENDI
*
* ERROR CHECKING ROUTINE, ON  DATABASE ONLY
*
      STORE '&MCOM' TO MFIELD
      SELE 2
      STORE UPPER(MCOM) TO MC
      LOCATE FOR FIELD_NAME="&MC"
      IF EOF()
        ? CHR(7)
        ?'That is not a field name in  &MBASE'
        wait
        loop
      ENDI
      STORE FIELD_TYPE TO MTYPE
      IF MTYPE <> 'N'
        ?CHR(7)
        ?'You must use a NUMERIC field with this command'
        WAIT
        LOOP
      ENDI
      STORE 'SUM' TO MCMD
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      SELE 1
      SUM &MCOM TO MSUM FOR &MCOND
      ?MSUM
      WAIT

****
****
****
    CASE UPPER(CHOICE) = 'D'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Delete records by number(s) or by special mark in any field'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      STORE 'DELETE' TO MCMD
      STORE 'ALL' TO MFIELD
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      SELE 1


      DELETE ALL FOR &MCOND
      ?'Deletion done'

****
****
****
    CASE UPPER(CHOICE) = 'R'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Recall, or bring back deleted records.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      STORE 'RECALL' TO MCMD
      STORE 'ALL' TO MFIELD
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      SELE 1

      RECALL ALL FOR &MCOND
      SET DELETED ON
      WAIT 'Recall done - press a key for menu'

****
****
****
    CASE UPPER(CHOICE) = 'P'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Pack -- permanently erase deleted records from file.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA

      ?' ALL DELETED RECORDS IN ACTIVE &MBASE WILL BE ERASED'
      ?' <Enter> PACKS -- any other key ABORTS'
      WAIT TO PRESS
      IF PRESS >= "!"
        LOOP
      ENDI
      ?'Packing &MBASE'
      ?'Reindex when done'
      PACK

****
****
****
    CASE UPPER(CHOICE) = 'Z'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Empty a database of ALL records, but save form.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
   TEXT

   YOU ARE ABOUT TO ERASE ALL DATA FROM THE &MBASE IN USE.

   ENDTEXT
      ACCE 'Type ZAP  to zap and press <enter>...anything else exits ' TO mzap
      IF UPPER(mzap)="ZAP"
        ? CHR(7)
        WAIT 'You are about to remove ALL DATA from &MBASE - (C)ontinues ' to mgo
        IF UPPER(mgo) = 'C'
          SELECT 1
          ZAP
          SELECT 2
        ELSE
          LOOP
        ENDI
      ELSE
        LOOP
      ENDI

****
****
****
    CASE UPPER(CHOICE) = 'L'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Lists can be created and saved to Screen, text file or printer.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      DO GLIST

****
****
****
    CASE UPPER(CHOICE) = 'S'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Locate information from any position within a field. '
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA
      STORE 'LOCATE' TO MCMD
      STORE 'ALL' TO MFIELD
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      SELE 1

*
* Since SET TALK is off for Compiled dbase, below must be
* used to show results of LOCATE
*
      SET TALK OFF
      ?'MATCHING LIST - EDIT IN EDIT MODE'
      LOCATE FOR &MCOND
      DO WHIL .T.
        CLEAR
        LINE = 1
        DO WHILE LINE < 20
          @ ROW()+1,1 SAY RECNO()
          @ ROW(), COL()+1 SAY &MNAME

          LINE = LINE + 1
          IF EOF()
            ?'You may show a blank record at end of file. This is normal.'
            WAIT
            STORE ' ' TO MWHAT   && To force return to menu
            EXIT
          ELSE
            CONT
            IF LINE < 20
              LOOP
            ENDI
          ENDI

          WAIT '(M)ore or <enter> exit ' to MWHAT
        ENDD
        IF MWHAT < "!"
          EXIT
        ELSE
          CONT
          LOOP
        ENDI
      ENDDO
****
****
****
    CASE UPPER(CHOICE) = 'G'
      SET COLOR TO W+
      @ 23,0 CLEAR
      @ 23,0 SAY 'Replace contents of one field with new data for part or whole database.'
      WAIT '<enter> to continue, any other key to exit ' TO MGO
      IF .NOT. "" = MGO
        @ 23,0 CLEAR
        LOOP
      ENDI
      IF MBASE = " "
        ?'YOU MUST USE A DATABASE FIRST'
        WAIT
        LOOP
      ENDI
      CLEA

      SET COLOR TO W*+/ ,W/ ,W
      ?' BE SURE YOU HAVE A BACKUP OF FILES FIRST'
      SET COLOR TO &GACOLN
      STORE 'REPLACE' TO MCMD
      SELECT 1

      ?
      ?'REPLACE [scope][field(s) WITH <expression>][FOR/WHILE <condition>]'
      ?
      ?'Below reassigns GRA to all SKA accounts for NY state'
      ?'REPLACE [ALL] [SALES_CODE] WITH ["GRA"] FOR [SALES_CODE="SKA" .AND.'
      ?'STATE = "NY"'
      ?
      ?' You will enter information in three sections'
      ?' First is field(s) to replace'
      ?' At next prompt enter what to replace with'
      ?' At third prompt enter conditions to look for'
      ?
      ACCE 'REPLACE ALL [FIELDNAME]' TO MCOM
      IF MCOM <"!"
        LOOP
      ENDI
*
* ERROR CHECKING ROUTINE, ON  DATABASE ONLY
*
      STORE '&MCOM' TO MFIELD
      SELE 2
      STORE UPPER(MCOM) TO MC
      LOCATE FOR FIELD_NAME="&MC"
      IF EOF()
        ? CHR(7)
        ?'That is not a field name in  &MBASE'
        wait
        loop
      ENDI

      ACCE 'REPLACE ALL &MCOM WITH [WHAT TO REPLACE WITH]' TO MMB
      IF FIELD_TYPE = 'C' .OR. FIELD_TYPE = 'L'  && ADD QUOTES IF NEEDED
        STORE '"'+'&MMB'+'"' TO MMB
      ENDI
      DO ERRORCHK
      IF MCOND = 'NONE'
        LOOP
      ENDI
      ? 'REPLACE ALL &MCOM WITH &MMB FOR &MCOND'
      SELE 1
      REPLACE ALL &MCOM WITH &MMB FOR &MCOND

      ?' done'
      WAIT

****
****
****
    OTHERWISE
      CLOSE DATABASE
      SET EXACT OFF
      RETURN
  ENDCASE
ENDDO