home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG028.ARK / DBQUERY.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  7KB  |  214 lines
  1.     PRINT "QUERY PROGRAM OF 3-23-78"
  2.     FIELDS = 20        REM  POSSIBLE NUMBER OF FIELDS.
  3.     DIM DATA$(FIELDS), FIELD$(FIELDS), TYPE(FIELDS), FIELD.WIDTH(FIELDS)
  4.     DIM SKIP(FIELDS),MIN(FIELDS),MAX(FIELDS)
  5.     BUFSIZ = 200            REM  MAIN STRING BUFFER SIZE.
  6.     DIM BUFFER$(BUFSIZ), REC(BUFSIZ)
  7.     REM  CONSTANTS
  8.     ZERO =0: ONE=1: TWO=2
  9.     DATA$(ZERO) = "1"
  10. 3001    INPUT "DO YOU NEED INSTRUCTIONS";ANS$
  11.     IF ANS$="NO"    THEN 3000
  12.     PRINT
  13.     PRINT "THE PURPOSE OF THIS PROGRAM IS TO PROVIDE A WAY TO"
  14.     PRINT "EXAMINE AND CHANGE THE DATABASE."
  15.     PRINT "THE COMMANDS PROVIDED FOR THIS ARE:"
  16.     PRINT
  17.     PRINT "LIST - LISTS THE ITEMS REQUESTED.  ALL ITEMS ARE"
  18.     PRINT "       LISTED THAT ARE INCLUDED IN THE SET NAMED."
  19.     PRINT
  20.     PRINT "SUM - SUMS THE FIELDS OF THE ITEMS REQUESTED."
  21.     PRINT
  22.     PRINT "BYE - EXITS BACK TO CP/M OPERATING SYSTEM."
  23.     PRINT
  24.     PRINT "CHANGE - CHANGES THE ITEMS REQUESTED FROM THE KEYBOARD."
  25.     PRINT
  26.     GOTO 3000
  27.     PRINT "ADD - ADD NEW ITEMS TO A FILE."
  28.     PRINT "        EXAMPLE:   ADD LAB SUPPLIES"
  29.     PRINT
  30.     PRINT "RUN - RUN A PREVIOUSLY SET UP SEQUENCE"
  31.     PRINT "        EXAMPLE:   RUN PACKAGE"
  32.     PRINT
  33. 3000    PRINT
  34.     PRINT
  35.     INPUT "COMMAND";CMD$
  36.     CMD$ = LEFT$(CMD$,3)
  37.     IF CMD$ = "LIS" THEN 3100
  38.     IF CMD$ = "SUM" THEN 3200
  39.     IF CMD$ = "CHA" THEN 3300
  40.     IF CMD$ = "ADD" THEN 3400
  41.     IF CMD$ = "RUN" THEN 3500
  42.     IF CMD$ = "BYE" THEN STOP
  43.     GOTO 3001
  44. 3100    REM  LIST THE ITEMS REQUESTED
  45.     GOSUB 4000        REM  FIND FILE NAME(S).
  46.     PHEAD = ONE
  47.     GOSUB 4500        REM  READ AND PRINT HEADINGS.
  48. 3110    GOSUB 4100        REM  READ FIELD SPECIFICATIONS.
  49.     PRINT
  50. 3120    GOSUB 4300        REM  READ A RECORD INTO DATA ARRAY.
  51.     IF ENDFILE = ONE THEN 3130    REM QUIT IF END OF FILE.
  52.     GOSUB 4400        REM  PRINT DATA ARRAY IN FORMAT.
  53.     IF FIELD.WIDTH(ONE) = ZERO THEN PRINT
  54.     RECNO = RECNO + ONE
  55.     GOTO 3120        REM  READ ANOTHER LINE.
  56. 3130    CLOSE ONE
  57.     GOTO 3000
  58. 3200    REM  SUM THE FIELDS OF THE ITEMS REQUESTED
  59.     TOTAL = ZERO
  60.     GOSUB 4000        REM  FIND FILE NAME.
  61.     PHEAD = ZERO
  62.     GOSUB 4500        REM  READ HEADINGS, NO PRINT.
  63.     GOSUB 4100        REM  READ FIELD SPECIFICATIONS.
  64.     PRINT "THE FIELDS ARE:"
  65.     FOR I = ONE TO NO.OF.FIELDS
  66.         PRINT FIELD$(I)
  67.     NEXT I
  68. 3210    INPUT "SUM ON WHAT FIELD";ANS$
  69.     FOR I = ONE TO NO.OF.FIELDS
  70.         IF ANS$ = FIELD$(I) THEN AFIELD = I: GOTO 3220
  71.     NEXT I
  72.     PRINT "NO SUCH FIELD"
  73.     GOTO 3210
  74. 3220    INPUT "MULTIPLY BY WHAT FIELD (NAME OF FIELD OR NONE)";ANS$
  75.     IF ANS$ = "NONE" THEN MFIELD = 0: GOTO 3230
  76.     FOR I = ONE TO NO.OF.FIELDS
  77.         IF ANS$ = FIELD$(I) THEN MFIELD = I: GOTO 3230
  78.     NEXT I
  79.     PRINT "NO SUCH FIELD"
  80.     GOTO 3220
  81. 3230    GOSUB 4300        REM  READ DATA FROM FILE.
  82.     IF ENDFILE = ONE THEN 3240    REM  QUIT IF END OF FILE.
  83.     AF = VAL(DATA$(AFIELD))
  84.     MF = VAL(DATA$(MFIELD))
  85.     TOTAL = TOTAL + MF*AF
  86.     RECNO = RECNO + ONE        REM  INCREMENT RECORD NUMBER.
  87.     GOTO 3230
  88. 3240    CLOSE ONE
  89.     PRINT "THE SUM IS ";TOTAL
  90.     GOTO 3000
  91. 3300    REM  CHANGE THE ITEMS REQUESTED
  92.     GOSUB 4000            REM  FIND FILE.
  93.     PHEAD = ZERO
  94.     GOSUB 4500            REM  READ HEADINGS.
  95.     GOSUB 4100            REM  READ FIELD SPECS.
  96.     GOSUB 4600            REM  READ INDEX.
  97.     IF NIND = ZERO THEN 3350    REM  QUIT IF NO INDEX.
  98. 3310    PRINT "WHAT ";INDFLD$;" DO YOU WANT";
  99.     INPUT ANS$
  100.     FOR I = ONE TO INDSIZ
  101.         IF ANS$ = BUFFER$(I) THEN 3320
  102.     NEXT I
  103.     PRINT ANS$;" NOT FOUND."
  104.     PRINT "INDEX TABLE:"
  105.     FOR I = ONE TO INDSIZ        REM  PRINT INDEX TABLE.
  106.         PRINT BUFFER$(I)
  107.     NEXT I
  108.     GOTO 3310
  109. 3320    RECNO = REC(I)        REM  FOUND RECORD NUMBER.
  110.     GOSUB 4300        REM  READ DATA RECORD AND SEPERATE.
  111.     PRINT HEADINGS$
  112.     PRINT
  113.     GOSUB 4400        REM  PRINT DATA ARRAY IN FORMAT.
  114. 3330    INPUT "CHANGE WHICH FIELD ";ANS$
  115.     IF ANS$ = INDFLD$ THEN \
  116.         PRINT "YOU CAN'T CHANGE INDEX FIELD.": GOTO 3330
  117.     FOR I = ONE TO NO.OF.FIELDS    REM  LOOK FOR FIELD TO CHANGE.
  118.         IF ANS$ = FIELD$(I) THEN 3340
  119.     NEXT I
  120.     PRINT ANS$;" WAS NOT A VALID FIELD."
  121.     GOTO 3330
  122. 3340    PRINT "NEW ";FIELD$(I);
  123.     INPUT DATA$(I)
  124.     GOSUB 4200        REM  PRINT DATA OUT TO DISK.
  125.     INPUT "DO YOU WANT TO CHANGE MORE ITEMS";ANS$
  126.     IF ANS$ = "YES" THEN 3310
  127. 3350    CLOSE ONE        REM  CLOSE DATA FILE.
  128.     GOTO 3000
  129. 3400    REM  ADD ITEMS TO THE REQUESTED FILE
  130. 3500    REM  RUN THE SEQUENCE REQUESTED
  131.     PRINT "COMMAND NOT ACTIVATED"
  132.     GOTO 3000
  133. 4000    REM  FIND FILE NAME(S) REQUESTED BY COMMAND COMMAND$.
  134.     INPUT "NAME OF FILE";FILE.NAME$
  135.     FILE FILE.NAME$        REM  OPEN THE FILE.
  136.     RECNO = ONE        REM  READ RECORD #1.
  137.     READ #ONE;RECLEN,NO.OF.FIELDS,NHEAD,NIND,FILETYPE,CODE,SPARE
  138.     RECNO = RECNO + ONE    REM  INCREMENT RECORD NUMBER.
  139.     IF RECLEN <> ZERO THEN \
  140.         CLOSE ONE :\
  141.         FILE FILE.NAME$(RECLEN) REM MAKE RANDOM INSTEAD OF SEQ.
  142.     PRINT
  143.     RETURN
  144. 4100    REM  READ THE FIELD SPECIFICATIONS.
  145.     FOR I = ONE TO NO.OF.FIELDS
  146.         IF RECLEN = ZERO THEN \
  147.         READ #ONE;FIELD$(I),TYPE(I),FIELD.WIDTH(I),SKIP(I), \
  148.               MIN(I),MAX(I),SPARE
  149.         IF RECLEN <> ZERO THEN \
  150.         READ #ONE,RECNO;FIELD$(I),TYPE(I),FIELD.WIDTH(I),SKIP(I), \
  151.                 MIN(I),MAX(I),SPARE
  152.     RECNO = RECNO + ONE
  153.     NEXT I
  154.     RETURN
  155. 4200    REM  ASSEMBLE DATA INTO A RECORD AND WRITE TO DISK.
  156.     RECORD$ = ""
  157.     FOR I = ONE TO NO.OF.FIELDS
  158.         RECORD$ = RECORD$ + DATA$(I) + "!"
  159.     NEXT I
  160.     PRINT #ONE,RECNO;RECORD$    REM  WRITE TO DISK.
  161.     RETURN
  162. 4300    REM  READ A RECORD OF DATA AND SEPERATE INTO FIELDS.
  163.     IF RECLEN = ZERO THEN \
  164.         READ #ONE;RECORD$
  165.     IF RECLEN <> ZERO THEN \
  166.         READ #ONE,RECNO;RECORD$
  167.     IF END #ONE THEN 4340
  168.     START = ONE
  169.     FOR I = ONE TO NO.OF.FIELDS
  170.         LENGTH = ZERO
  171.         FOR P = START TO LEN(RECORD$)
  172.         IF MID$(RECORD$,P,ONE) = "!" THEN 4320
  173.         LENGTH = LENGTH + ONE
  174.         NEXT P
  175. 4320        DATA$(I) = MID$(RECORD$,START,LENGTH)
  176.         START = START + LENGTH + ONE
  177.     NEXT I
  178.     ENDFILE = ZERO
  179. 4330    RETURN
  180. 4340    ENDFILE = ONE
  181.     RETURN
  182. 4400    REM  PRINT DATA IN CORRECT FORMAT.
  183.     POSITION = ONE        REM  STARTING TAB POSITION.
  184.     FOR I = ONE TO NO.OF.FIELDS
  185.         IF FIELD.WIDTH(I) <> ZERO THEN PRINT TAB(POSITION);
  186.         IF SKIP(I) = ONE THEN PRINT
  187.         IF DATA$(I) <> "" THEN PRINT DATA$(I);" ";
  188.         POSITION = POSITION + FIELD.WIDTH(I) + ONE
  189.     NEXT I
  190.     PRINT
  191.     RETURN
  192. 4500    REM  READ HEADINGS, ALSO PRINT IF PHEAD = 1
  193.     IF NHEAD = ZERO THEN 4510
  194.         FOR I = ONE TO NHEAD
  195.         IF RECLEN = ZERO THEN READ #1;HEADINGS$
  196.         IF RECLEN <> ZERO THEN READ #ONE,RECNO;HEADINGS$
  197.         IF PHEAD = 1 THEN PRINT HEADINGS$
  198.         RECNO = RECNO + ONE
  199.         NEXT I
  200. 4510    RETURN
  201. 4600    REM  READ INDEX INTO MEMORY IF THERE IS ONE.
  202.     IF NIND = ZERO THEN PRINT "THERE'S NO INDEX.": RETURN
  203.     INDEX.FILE$ = FILE.NAME$ + ".IND"
  204.     FILE INDEX.FILE$        REM  OPEN INDEX FILE.
  205.     READ #TWO;INDFLD$        REM  READ INDEX FIELD NAME.
  206.     FOR I = ONE TO BUFSIZ
  207.         READ #TWO;BUFFER$(I),REC(I)
  208.         IF END #TWO THEN 4610
  209.     NEXT I
  210. 4610    INDSIZ = I        REM  INDEX SIZE.
  211.     CLOSE TWO
  212.     RETURN
  213.     END
  214.