home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib36b.dsk
/
PRICE.FILE.COMP.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
4KB
|
82 lines
10 REM **********************
20 REM * PRICE.FILE.COMP *
30 REM * BY GERHALD HANSEL *
40 REM * COPYRIGHT(C) 1989 *
50 REM * MICROSPARC, INC *
60 REM * CONCORD, MA 01742 *
70 REM **********************
80 REM
90 POKE 33,40: ONERR GOTO 700
100 HOME : GOTO 120
110 HTAB 20 - INT( LEN(A$)/2): PRINT A$: RETURN
120 A$ = "PRICE FILE COMPRESSOR": GOSUB 110:A$ = "BY GERHALD HANSEL": GOSUB 110
130 A$ = "COPYRIGHT(C) 1989": GOSUB 110
140 A$ = "MICROSPARC, INC": GOSUB 110: PRINT
150 PRINT : PRINT : PRINT
160 PRINT "THIS PROGRAM ALLOWS YOU TO SHORTEN": PRINT
170 PRINT "THE PRICE FILES CREATED BY": PRINT : PRINT "THE NIBBLE INVESTOR"
180 PRINT : PRINT
190 PRINT "THE INVESTOR WAS PUBLISHED IN NIBBLE": PRINT
200 PRINT "VOLUME #4, ISSUE #2 AND": PRINT
210 PRINT "NIBBLE EXPRESS VOLUME IV.": PRINT
220 GOSUB 290
230 HOME : CLEAR :D$ = CHR$(4): REM CTRL-D
240 PRINT "CHOOSE ONE OF THE FOLLOWING:": PRINT : PRINT "1..SHORTEN PRICE FILE"
250 PRINT : PRINT "2..QUIT PROGRAM": PRINT : PRINT "ENTER CHOICE ";:
260 GET A$: PRINT :A = VAL(A$): IF A <1 OR A >2 THEN 230
270 HOME :X = FRE(0)
280 ON A GOTO 310,690
290 INPUT "PRESS <RETURN> TO CONTINUE.";A$: RETURN
300 REM FILE NAME INPUT
310 HOME : PRINT "IF YOU NEED THE CATALOG, TYPE ? <RETURN>"
320 INPUT "FILE NAME ";NA$: IF NA$ = "" THEN 310
330 IF NA$ = "?" THEN PRINT D$;"CATALOG": GOSUB 290: GOTO 310
340 NL = ASC(NA$): IF NL > = 65 AND NL < = 90 OR NL > = 193 AND NL < = 218 THEN 360
350 PRINT "FILE NAME MUST BEGAN WITH A LETTER": PRINT : GOSUB 290: GOTO 310
360 PRINT D$;"VERIFY";NA$
370 REM INPUT RECORD 0
380 PRINT D$;"OPEN";NA$;",L50
390 PRINT D$;"READ ";NA$;",R0"
400 INPUT U$:R = VAL(U$): PRINT D$;"CLOSE";NA$
410 PRINT : PRINT "THERE ARE "R" RECORDS IN FILE ": PRINT : PRINT NA$".": PRINT
420 IF R < = 52 THEN PRINT "THERE IS NO NEED TO SHORTEN THE FILE ": PRINT : PRINT NA$".": PRINT : GOSUB 290: GOTO 230
430 DIM U$(R +1,7),V$(53,7)
440 PRINT "DO YOU WANT TO SHORTEN ": PRINT : PRINT NA$: PRINT : PRINT "TO 52 RECORDS Y/N ?": GET A$: PRINT
450 IF (A$ = "N" OR A$ = "n") THEN 230
460 IF (A$ = "Y" OR A$ = "y") THEN 490
470 HOME : GOTO 440
480 REM READ PRICE FILE DATA
490 NN$ = NA$ +"B": PRINT D$;"RENAME";NA$;","NN$: PRINT NA$" HAS BEEN RENAMED "NN$: PRINT
500 PRINT D$;"OPEN";NN$;",L50
510 FOR W = R -51 TO R
520 N = N +1
530 PRINT D$;"READ";NN$",R";W
540 FOR F = 1 TO 7: INPUT U$(W,F)
550 V$(N,F) = U$(W,F)
560 NEXT : NEXT W
570 PRINT D$;"CLOSE": PRINT
580 REM STORES RECORDS
590 PRINT D$;"OPEN";NA$;",L50"
600 PRINT D$;"WRITE";NA$;",R0
610 R$ = "52": PRINT R$
620 FOR W = 1 TO 52
630 PRINT D$;"WRITE";NA$;",R";W
640 FOR F = 1 TO 7
650 PRINT V$(W,F)
660 NEXT F: NEXT W
670 PRINT D$;"CLOSE";NA$
680 PRINT "THE ORIGINAL FILE IS "NA$ +"B": PRINT : PRINT "THE SHORTENED FILE IS "NA$: PRINT : GOSUB 290: GOTO 230
690 HOME : END
700 PRINT D$;"CLOSE";NA$
710 IF PEEK(222) = 4 THEN VTAB 21: PRINT "DISK WRITE PROTECTED:GOTO10020
720 IF PEEK(222) = 5 THEN VTAB 21: PRINT "END OF DATA FOR FILE:GOTO10020
730 IF PEEK(222) = 6 THEN VTAB 21: PRINT "NO FILE BY THAT NAME": GOTO 810
740 IF PEEK(222) = 8 THEN VTAB 21: PRINT "DISK I/O ERROR": GOTO 810
750 IF PEEK(222) = 9 THEN VTAB 21: PRINT "DISK FULL.. SET UP A NEW DISK": GOTO 810
760 IF PEEK(222) = 10 THEN VTAB 21: PRINT "FILE LOCKED": GOTO 810
770 IF PEEK(222) = 13 THEN VTAB 21: PRINT "FILE TYPE MISMATCH": GOTO 810
780 IF PEEK(222) = 107 THEN VTAB 21: PRINT "BAD SUBSCRIPT": GOTO 810
790 IF PEEK(222) = 120 THEN VTAB 21: PRINT "REDIMENSIONED ARRAY": GOTO 810
800 VTAB 21: PRINT "ERROR#"; PEEK(222);" HAS OCCURRED IN LINE "; PEEK(218) + PEEK(219) *256".": PRINT "CHECK APPLE MANUAL ERROR CODES (DOS & APPLESOFT)": GOTO 810
810 CALL -868: INPUT "PRESS <RETURN> FOR MENU";A$
820 GOTO 230