home *** CD-ROM | disk | FTP | other *** search
GW-BASIC | 1982-03-13 | 3.5 KB | 155 lines |
- 10 COMMON DRIVEID$,FILEID$
- 15 DIM CATARRY$(100)
- 20 CLS
- 30 PRINT " "
- 40 PRINT " EASY-File Copy Files"
- 50 PRINT " "
- 60 PRINT " "
- 70 INPUT " File to be copied"; FROMFILE$
- 80 PRINT " "
- 90 INPUT " File to be created"; TOFILE$
- 100 I=0
- 110 PRINT " Enter up to 100 categories to be"
- 120 PRINT " copied."
- 130 FOR I= 1 TO 100
- 135 IF ENDSW <=> 0 THEN 190
- 140 INPUT " Category ==>";CATARRY$(I)
- 150 IF LEN(CATARRY$(I)) > 40 THEN PRINT " Too Long -- Reenter" ELSE 180
- 160 GOTO 140
- 180 IF LEN(CATARRY$(I))= 0 THEN ENDSW=I-1
- 190 NEXT
- 200 CLS
- 210 PRINT " "
- 220 PRINT " EASY-File Copy Files "
- 230 PRINT " "
- 240 PRINT " Place "+FROMFILE$+" in appropriate drive"
- 250 PRINT " "
- 260 PRINT " Place "+TOFILE$+" in appropriate drive"
- 270 PRINT " "
- 280 INPUT " Do you want to COPY or CREATE file?
- 290 INPUT " Enter option";OPTION$
- 291 IF OPTION$="Copy" THEN 300
- 292 IF OPTION$="Create" THEN 300
- 293 GOTO 290
- 300 GOSUB 330
- 305 IF OPTION$= "COPY" THEN 600
- 310 IF OPTION$="CREATE" THEN 400
- 320 PRINT " Invalid Response"
- 330 OPEN FROMFILE$ AS #1 LEN = 128
- 331 FIELD #1, 2 AS FBUCKET1$, 2 AS FBUCKET2$, 2 AS FBUCKET3$, 2 AS FBUCKET4$, 40 AS FLINE1$, 40 AS FLINE2$, 40 AS FLINE3$
- 340 OPEN TOFILE$ AS #2 LEN = 128
- 341 FIELD #2, 2 AS TBUCKET1$, 2 AS TBUCKET2$, 2 AS TBUCKET3$, 2 AS TBUCKET4$, 40 AS TLINE1$, 40 AS TLINE2$, 40 AS TLINE3$
- 350 RETURN
- 400 LSET TBUCKET1$ = MKI$(2)
- 410 LSET TBUCKET2$ = MKI$(2)
- 420 LSET TBUCKET3$ = MKI$(2)
- 430 LSET TBUCKET4$ = MKI$(1)
- 440 PRINT " "
- 450 INPUT " Company Name==>";NAM$
- 460 INPUT " Purpose ==>";PURP$
- 470 LSET TLINE1$ = NAM$
- 480 LSET TLINE2$ = PURP$
- 490 LSET TLINE3$ = " "
- 495 LOCATE 23,$
- 500 COLOR 31, 0, 14
- 510 PRINT "File Being Built"
- 520 COLOR 15,9,4
- 530 LOCATE 23,8
- 540 PUT #2,1
- 550 TFIRSTCAT=2
- 555 TLASTCAT=2
- 560 TLASTREC=2
- 565 TNUMCAT = 1
- 570 FIRSTSW = 1
- 571 LSET BUCKET1$=MKI$(0)
- 572 LSET BUCKET2$=MKI$(0)
- 573 LSET BUCKET3$=MKI$(0)
- 574 LSET BUCKET4$=MKI$(3)
- 575 LSET LINE1$=" "
- 577 LSET LINE3$=" "
- 578 FOR I=2 TO 1003
- 579 PUT #2,I
- 580 NEXT
- 585 PRINT " File has been Built"
- 600 GET #1,1
- 620 FLASTCAT=CVI(FBUCKET2$)
- 630 FRECNUM=CVI(FBUCKET1$)
- 640 IF FIRSTSW=1
- 650 GET #2,1
- 655 TFIRSTCAT=CVI(TBUCKET1$)
- 660 TLASTCAT=CVI(TBUCKET2$)
- 665 TLASTREC=CVI(TBUCKET3$)
- 670 TNUMCAT=CVI(TBUCKET4$)
- 675 LSET LINE2$=" "
- 680 FIRSTSW=0
- 700 IF FRECNUM = 0 THEN GOTO 1500
- 710 GET #1,FRECNUM
- 720 GOSUB 900
- 725 FRECNUM=CVI(BUCKET2$)
- 730 IF FOUND=1 THEN GOSUB 1000
- 735 GOTO 700
- 900 FOUND=0
- 910 FOR I=1 TO ENDSW
- 915 IF FOUND=1 THEN 950
- 920 LFLINE1 = LEN(CATARRY$(I)
- 925 IF CATARRY$(I) = LEFT$ (FLINE1$, LFLINE1) THEN FOUND =1
- 950 NEXT
- 960 RETURN
- 1000 IF FIRSTSW = 1 THEN 1050
- 1005 TLASTSAVE = TLASTCAT
- 1008 GOSUB 1300
- 1010 TLASTCAT = TLASTREC+1
- 1020 TLASTREC = TLASTREC +1
- 1030 TNUMCAT=TNUMCAT+1
- 1050 FIRSTSW=0
- 1060 TRECNUM=TLASTREC
- 1070 IF TRECNUM > 1000 THEN GOTO 1400
- 1080 LSET TBUCKET1$= MKI$(TLASTSAVE)
- 1090 LSET TBUCKET2$=MKI$(0)
- 1100 LSET TBUCKET4$=MKI$(2)
- 1110 LSET TLINE1$=FLINE1$
- 1120 LSET TLINE2$=FLINE2$
- 1130 LSET TLINE3$=FLINE3$
- 1135 PRINT " "+CATARRY#I(I)" being copied"
- 1140 LSET TBUCKET3$=MKI$(0)
- 1150 IF CVI(FBUCKET3$) <> 0 THEN LSET TBUCKET3$= MKI$(TRECNUM+1)
- 1160 PUT #2,TRECNUM
- 1170 FRECNUM2=CVI(FBUCKET3$)
- 1180 TFROMSUB=0
- 1200 IF FRECNUM2=0 THEN 1290
- 1205 GET #1,FRECNUM2
- 1210 TLASTREC=TLASTREC+1
- 1211 LSET TBUCKET1$=MKI$(TLASTCAT)
- 1212 LSET TBUCKET2$=MKI$(0)
- 1213 IF CVI(FBUCKET2$) <> 0 THEN LSET TBUCKET2$=MKI$(TLASTREC+1)
- 1214 LSET TBUCKET3$=MKI$(TFROMSUB)
- 1215 LSET TBUCKET4$=MKI$(3)
- 1216 LSET TLINE1$=FLINE1$
- 1217 LSET TLINE2$=FLINE2$
- 1218 LSET TLINE3$=FLINE3$
- 1219 TRECNUM=TLASTREC
- 1220 IF TRECNUM > 1000 THEN GOTO 1400
- 1225 PUT #2,TRECNUM
- 1230 FRECNUM2=CVI(FBUCKET2$)
- 1240 TFROMSUB=TRECNUM
- 1250 GOTO 1200
- 1290 RETURN
- 1300 GET #2,TLASTCAT
- 1310 LSET TBUCKET2$=MKI$(TLASTREC+1)
- 1320 PUT #2,TLASTCAT
- 1330 RETURN
- 1400 REM File Overflow Routine
- 1410 PRINT "File "+TOFILE$+" if Full"
- 1420 PRINT "Category Copy Aborted"
- 1430 GOTO 1510
- 1500 PRINT "Copy is Complete"
- 1510 GET #2,1
- 1520 LSET TBUCKET1$=MKI$(TFIRSTCAT)
- 1525 LSET TBUCKET2$=MKI$(TLASTCAT)
- 1530 LSET TBUCKET3$=MKI$(LASTREC)
- 1540 LSET TBUCKET4$=MKI$(TNUMCAT)
- 1545 PUT #2,1
- 1550 CLOSE #1
- 1560 CLOSE #2
- 1570 CHAIN DRIVEID$+"FileMenu"
-