home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / dbase / dop.arc / DOP3.PRG < prev   
Text File  |  1985-09-16  |  10KB  |  341 lines
  1. **********  DOP3.PRG  VERSION  2.3  DBASE III VERSION  **************
  2. ** BY GARY C. AREY  1030 HOLLAND DR.  GARLAND, TX. 75040   7/26/84 **
  3. SET TALK OFF
  4. SET DEVICE TO SCREEN
  5. CLEAR ALL
  6. CLEAR
  7. ?  'The following .DBF files are on the default drive :'
  8.     ?
  9.   LIST FILES LIKE *.DBF
  10. ?
  11.   ACCEPT 'WHAT DATABASE DO YOU WISH TO USE : ' TO BB
  12.   DO WHILE .T.
  13.   CLEAR
  14.    @ 01,27 SAY 'DBASE III OPERATIONS MENU'
  15.    @ 02,27 SAY '========================='
  16.    @ 04,17 SAY 'The Current .DBF File Now In Use is :'
  17.    @ 04,56 SAY '&BB' PICTURE "!!!!!!!!!!!!"
  18.    @ 08,11 SAY ' 1> List                           <C> Create .DBF'
  19.    @ 09,11 SAY ' 2> Browse                         <S> Sort File'
  20.    @ 10,11 SAY ' 3> Edit Record                    <E> Erase File '
  21.    @ 11,11 SAY ' 4> Search Character Field         <L> DIR Files on Drive'
  22.    @ 12,11 SAY ' 5> Search Numeric Field           <R> Create/Modify Report'
  23.    @ 13,11 SAY ' 6> Append (Add Records)           <N> Change Database'
  24.    @ 14,11 SAY ' 7> Mark to Delete                 <D> Delete (Pack)'
  25.    @ 15,11 SAY ' 8> Report to Screen               <P> Report Print '
  26.    @ 16,11 SAY ' 9> View Structure                 <F> View Files   '
  27.    @ 17,11 SAY ' X> Exit To DBASE . Prompt         <Q> Quit to DOS  '
  28. SET CONSOLE OFF
  29. WAIT TO Action
  30. SET CONSOLE ON
  31.        IF UPPER(Action)= '1'
  32.          CLEAR
  33.          USE &BB
  34.         INPUT 'BEGINNING RECORD NO. : ' TO Q
  35.          ?
  36.    ACCEPT 'Do you want to PRINT the result?  (Y)es (N)o : ' to PR
  37.    IF UPPER(PR) = 'Y'
  38.    SET PRINT ON
  39.    ENDIF
  40.    RELEASE PR
  41.          GOTO Q
  42.          CLEAR
  43.          LIST FOR RECNO() >= Q
  44.          ?
  45.    SET PRINT OFF
  46.           WAIT
  47.           USE
  48.            ELSE
  49.              IF UPPER(Action)= '2'
  50.                CLEAR
  51.                USE &BB
  52.           ? 'While BROWSING you may Return to enter and move through record.'
  53.           ? 'Control B  moves screen right one field.      '
  54.           ? 'Control Z  moves screen left one field.       '
  55.           ? 'Control U  marks a record for deletion.       '
  56.           ? 'PgUp and PgDn  moves edit line up and down one record.'
  57.           ? 'Control Q  quits without saving changes.      '
  58.           ? 'Control W  saves changes and quits.           '
  59.           ?
  60.                 INPUT 'BEGINNING RECORD NO. : ' TO Q
  61.                 GOTO Q
  62.                BROWSE
  63.                USE
  64.            ELSE
  65.              IF UPPER(Action)= '3'
  66.              CLEAR
  67.              USE &BB
  68.            ? 'While EDITING you may Return to enter record and complete Edit.'
  69.            ? 'Control Q  quits without saving changes.'
  70.            ? 'Control W  saves changes and quits.'
  71.            ?
  72.            INPUT 'BEGINNING RECORD NO. : 'TO Q
  73.              GOTO Q
  74.              EDIT
  75.              USE
  76.            ELSE
  77.              IF UPPER(Action)= '4'
  78.              CLEAR
  79. ACCEPT ' Do you wish to SEARCH on (1) or (2) fields? ' to QR
  80.   IF UPPER(QR)='1'
  81.              CLEAR
  82.              USE &BB
  83.              LIST STRUCTURE
  84.                ?
  85.                ACCEPT 'SEARCH FIELD : ' TO SF
  86.                ACCEPT 'SEARCH FOR   : ' TO CN
  87.     ?
  88.     ACCEPT 'Do you want to PRINT the result?  (Y)es (N)o : ' to PR
  89.     IF UPPER(PR)='Y'
  90.     SET PRINT ON
  91.     ENDIF
  92.     RELEASE PR
  93.              CLEAR
  94.              LIST FOR UPPER('&CN')$&SF
  95.     SET PRINT OFF
  96.              ?
  97.              USE
  98.              WAIT
  99.              ENDIF
  100.   IF UPPER(QR)='2'
  101.              CLEAR
  102.              USE &BB
  103.              LIST STRUCTURE
  104.              ?
  105.              ACCEPT 'Enter Search Field 1 : ' to SF
  106.              ACCEPT 'Search for             ' to CN
  107.              ACCEPT 'Enter Search Field 2 : ' to SF2
  108.              ACCEPT 'Search for             ' to CN2
  109.              ?
  110.   ACCEPT 'Do you want to PRINT the result?  (Y)es (N)o : ' to PR
  111.    IF UPPER(PR)='Y'
  112.    SET PRINT ON
  113.    ENDIF
  114.    RELEASE PR
  115.              CLEAR
  116.              LIST FOR UPPER('&CN')$&SF .AND. UPPER('&CN2')$&SF2
  117.    SET PRINT OFF
  118.              ?
  119.              USE
  120.              WAIT
  121.              ENDIF
  122.            ELSE
  123.              IF UPPER(Action)= '5'
  124.              CLEAR
  125.              USE &BB
  126.              LIST STRUCTURE
  127.                ?
  128.                ACCEPT 'NUMERIC SEARCH FIELD : ' TO NF
  129.                INPUT  'NUMERIC AMOUNT       : ' TO NN
  130.                ACCEPT '<  =  >              : ' TO E
  131.                ?
  132.     ACCEPT 'Do you want to PRINT the result?  (Y)es (N)o : ' to PR
  133.     IF UPPER(PR)='Y'
  134.     SET PRINT ON
  135.     ENDIF
  136.     RELEASE PR
  137.              CLEAR
  138.              LIST FOR &NF &E NN
  139.     SET PRINT OFF
  140.              ?
  141.              WAIT
  142.              USE
  143.            ELSE
  144.              IF UPPER(Action)= '6'
  145.              CLEAR
  146.              USE &BB
  147.     ? 'In APPEND mode  Control W quits and saves new records to disk.'
  148.     ? '                Control Q quits without saving new records.'
  149.     ?
  150.      WAIT
  151.              APPEND
  152.              USE
  153.            ELSE
  154.              IF UPPER(Action)= '7'
  155.              CLEAR
  156.              USE &BB
  157.              ACCEPT 'RECORD NO. TO BE MARKED FOR DELETION : ' TO RD
  158.              DELETE RECORD &RD
  159.            ?   'SELECTED RECORD WAS MARKED FOR DELETION !'
  160.              WAIT
  161.              CLEAR
  162.              USE
  163.            ELSE
  164.              IF UPPER(ACTION)='C'
  165.              CLEAR
  166.            ? 'The following .DBF files already exist on the default drive :'
  167.            LIST FILES LIKE *.DBF
  168.            ?
  169.              CREATE
  170.              CLEAR
  171.            ELSE
  172.              IF UPPER(Action)= 'N'
  173.              CLEAR
  174.              RELEASE ALL
  175.           ? 'The following .DBF files are on the default drive :'
  176.              ?
  177.              LIST FILES LIKE *.DBF
  178.              ?
  179.              ACCEPT 'ENTER NAME OF NEW DATABASE YOU WISH TO USE : ' TO BB
  180.            ELSE
  181.             IF UPPER(Action)= 'D'
  182.              CLEAR
  183.              USE &BB
  184.              PACK
  185.            ?   'PACK AND DELETION COMPLETED !'
  186.              USE
  187.            ELSE
  188.              IF UPPER(Action)= 'R'
  189.              CLEAR
  190.              USE &BB
  191.            ? 'The following .FRM Report Forms are on the default drive :'
  192.              ?
  193.              LIST FILES LIKE *.FRM
  194.              ?
  195.              MODIFY REPORT
  196.              USE
  197.            ELSE
  198.              IF UPPER(Action)= '8'
  199.              CLEAR
  200.              USE &BB
  201.       ? 'The following .FRM Report Forms are on the default drive :'
  202.       ?
  203.       LIST FILES LIKE *.FRM
  204.       ?
  205.              REPORT
  206.              WAIT
  207.              USE
  208.            ELSE
  209.              IF UPPER(Action)= 'P'
  210.              CLEAR
  211.              USE &BB
  212.            INPUT 'ENTER NUMBER OF COPIES TO PRINT : ' TO MNO
  213.    ? 'The following .FRM Report Forms are on the default drive :'
  214.       ?
  215.       LIST FILES LIKE *.FRM
  216.       ?
  217.            ACCEPT '    NAME OF REPORT YOU WISH TO PRINT : ' TO RF
  218.            CLEAR
  219.            DO WHILE .NOT. EOF()
  220.            DO WHILE MNO > 0
  221.            STORE MNO-1 TO MNO
  222.              REPORT FORM &RF TO PRINT
  223.            ENDDO
  224.            ENDDO
  225.              WAIT
  226.              USE
  227.            ELSE
  228.              IF UPPER(Action)= '9'
  229.              CLEAR
  230.              USE &BB
  231.              LIST STRUCTURE
  232.              WAIT
  233.              USE
  234.           ELSE
  235.             IF UPPER(Action)='S'
  236.             CLEAR
  237.             USE &BB
  238.             LIST STRUCTURE
  239.             ?
  240.             ACCEPT 'Do you wish to SORT on (1) or (2) fields? : 'to NB
  241.               IF UPPER(NB)='1'
  242.               ACCEPT 'Enter Field Name to SORT on : ' to FT
  243.               ?
  244.               ? 'SORTING IN PROGRESS !'
  245.               SORT TO TEMP ON &FT/A
  246.                  USE TEMP
  247.                  COPY TO &BB
  248.                  USE &BB
  249.                  ERASE TEMP.DBF
  250.                  ERASE TEMP.DBT
  251.                  USE
  252.               ENDIF
  253.               IF UPPER(NB)='2'
  254.               ACCEPT 'Enter Sort Field 1 : 'to FT
  255.               ACCEPT 'Enter Sort Field 2 : 'to FQ
  256.               ?
  257.               ? 'SORTING IN PROGRESS !'
  258.               USE &BB
  259.               SORT TO TEMP ON &FT/A,&FQ/A
  260.                 USE TEMP
  261.                 COPY TO &BB
  262.                 USE &BB
  263.                 ERASE TEMP.DBF
  264.                 ERASE TEMP.DBT
  265.               ENDIF
  266.             USE
  267.            ELSE
  268.              IF UPPER(Action)='E'
  269.              CLEAR
  270.              ? 'Enter (0) if you do NOT wish to Erase a File.'
  271.              ?
  272.              ACCEPT 'Enter File Name you wish to ERASE ! : ' to ERS
  273.              ERASE &ERS
  274.              RELEASE ERS
  275.            ELSE
  276.              IF UPPER(Action)='L'
  277.              CLEAR
  278.              ACCEPT 'Enter Drive Letter (Ex. B  C) for DIR : ' to DR
  279.              ACCEPT 'Enter Filespec  *.* for all or directory path : 'to SPC
  280.              DIR &DR:&SPC
  281.              WAIT
  282.            ELSE
  283.              IF UPPER(Action)= 'F'
  284.              CLEAR
  285.           ? 'ENTER FILE SPEC to VIEW FILES on Default Drive ;'
  286.           ?
  287.           ? '      DBF  for Database Files'
  288.           ? '      FRM  for Report Form Files'
  289.           ? '      PRG  for Command Program Files'
  290.           ? '      DBT  for Memo Fields Files'
  291.           ? '      LBL  for Label Form Files'
  292.           ? '      FMT  for Format Files'
  293.           ? '      NDX  for Index Files'
  294.           ? '      MEM  for Memory Files'
  295.           ? '      TXT  for Text Files'
  296.           ?
  297.              ACCEPT 'ENTER FILE SPEC : ' TO FS
  298.              ?
  299.              LIST FILES LIKE *.&FS
  300.              ?
  301.              WAIT
  302.            ELSE
  303.              IF UPPER(Action)='Q'
  304.              USE
  305.              CLEAR
  306.              CLEAR ALL
  307.              QUIT
  308.            ELSE
  309.              IF UPPER(Action)= 'X'
  310.                CLEAR ALL
  311.              RETURN
  312.            ENDIF
  313.           ENDIF
  314.           ENDIF
  315.           ENDIF
  316.           ENDIF
  317.           ENDIF
  318.           ENDIF
  319.           ENDIF
  320.           ENDIF
  321.           ENDIF
  322.           ENDIF
  323.           ENDIF
  324.           ENDIF
  325.           ENDIF
  326.           ENDIF
  327.           ENDIF
  328.          ENDIF
  329.         ENDIF
  330.         ENDIF
  331.        ENDIF
  332.       ENDDO
  333. RELEASE T, ACTION
  334. 
  335.           ENDIF
  336.           ENDIF
  337.          ENDIF
  338.         ENDIF
  339.         ENDIF
  340.        ENDIF
  341.       ENDDO