10 '**VARIABLES** 25 'FTL$= FILE TO LOAD 26 'FTS$= FILE TO SAVE 50 'W$ 60 'Y$ 70 'D$ 80 'E$ 90 'F$ 100 'YN$ = TEMP STRING, USE ANYTIME 110 'NN$ = INPUT 120 'DT$ = DATE STRING (YY/MM/DD) 130 'LEXT = LENGTH OF EXTENTION 140 'SF$ = STRING TO FIND 150 'N$ 160 'NN$ 170 ' 179 '**DEFINES** 180 WT$="WAIT" 181 CG$="COLLECT GARBAGE" 182 S$=" ," 183 P$=STRING$(7,42) '*$ 184 C=1 'RECORD # 190 DEFSTR M 195 LMX=600 'MAX # LOG ENTRIES 200 DIM M(LMX,2) 210 EXT$="000" 220 I=1 'CONTACT # 225 CLS$=CHR$(26) 'CLEAR SCREEN 230 PF = 0 'PRINT FLAG 235 BEL$=CHR$(7) 'console bell 240 DUP = -1 270 ' 1000 PRINT CLS$ 1100 PRINT:PRINT "LIST/LOG.BAS p.p.p." 1103 GOSUB 26000 1110 PRINT "ENTER A LIST OF TWO FIELDS:" 1112 PRINT:PRINT "FIELD ONE: 18 CHARS (255 MAX) - NO COMMAS!" 1115 PRINT "FIELD TWO: 55 CHARS (255 MAX) - COMMAS OK, NO ";CHR$(34) 1200 GOTO 3000 1250 GOSUB 17800 1300 PF=0:GOSUB 26000:PRINT TAB(3) "-MENU:" C-1 "RECORDS IN LOG --"FRE(0)" BYTES FREE--" 1305 ON ERROR GOTO 17010 1310 IF FRE(0) < 1000 THEN GOSUB 27000 1400 PRINT 1500 PRINT TAB(5) "1 - CREATE LOG 6 - SEARCH FIELD 1" 1600 PRINT TAB(5) "2 - VIEW LOG 7 - SEARCH FIELD 2" 1700 PRINT TAB(5) "3 - EDIT LOG 8 - READ LOG FROM DISK" 1800 PRINT TAB(5) "4 - SORT ON FIELD 1 9 - WRITE LOG TO DISK" 1900 PRINT TAB(5) "5 - CHANGE DISKS 0 - EXIT" 1910 PRINT SPC(24)"G - "CG$ 2000 PRINT "CHOICE: ? "; 2100 A$=INPUT$(1) 2210 IF A$=CHR$(13) GOTO 1300 2215 IF A$="G" OR A$="g" THEN GOSUB 27000 2220 IF A$= CHR$(&H30) THEN GOTO 1250 2300 A=VAL(A$) 2400 ON A GOSUB 2700,9200,10800,17100,25000,5600,7400,14600,12700 2500 IF A > 9 OR A < 1 THEN GOTO 2800 2600 IF A <> 1 GOTO 1300 2700 RETURN 2800 PRINT:PRINT " ENTER 1 - 7" 2900 GOTO 2100 3000 PRINT:PRINT "ENTER FOR MENU - - D FOR 'DUPLICATE CHECK ON'" 3050 PRINT 3100 GOSUB 26000: PRINT FRE(0)" BYTES FREE" 3110 IF FRE(0) < 1000 THEN GOSUB 27000 3130 PRINT:PRINT "RECORD #"C" ENTER M FOR MENU" 3150 PRINT SPC(17);STRING$(17,45);"*" 3200 INPUT "ENTER FIELD 1: ";N$ 3300 IF N$="D" OR N$="d" THEN GOSUB 20000:GOTO 3100 3400 IF N$="M" OR N$="m" THEN GOTO 5200 3450 IF N$="" THEN N$= M(C-1,1):PRINT SPC(17);N$ 3500 IF DUP < 1 GOTO 3900 3600 FOR I = 1 TO C 3700 IF N$ = M(I,1) THEN GOTO 4000 3800 NEXT I 3900 GOTO 4200 4000 GOSUB 26000:PRINT P$;P$"DUPE RECORD #";I;P$;P$ 4100 GOTO 3100 4200 PRINT SPC(17);STRING$(54,45);"*" 4300 PRINT"ENTER FIELD 2: ? "; 4310 LINE INPUT F$ 4320 IF F$="" THEN F$=M(C-1,2):PRINT SPC(17);F$ 4340 IF LEN(N$) > 18 THEN PRINT:PRINT P$;P$; "LENGTH FIELD 1 > 18";P$;P$ 4350 IF LEN(F$) > 55 THEN PRINT:PRINT P$;P$;"LENGTH FIELD 2 > 55";P$;P$ 4360 GOSUB 26000:PRINT "RECORD # "C" OK ?" 4400 PRINT "ENTER TO ACCEPT AND CONTINUE "; 4500 GOSUB 18000 4600 IF YN=(-1) GOTO 3100 4700 PRINT:PRINT 4750 IF N$="" AND F$= "" THEN GOTO 3100 4760 IF LEFT$(F$,1)=" " THEN GOTO 3100 4800 M(C,1)=N$ 4900 M(C,2)=F$ 5000 C=C+1 5100 GOTO 5300 5200 GOSUB 1300 5300 GOTO 3100 5600 PRINT CLS$ 5700 GOSUB 26000:PRINT "SEARCH FIELD 1" 5800 PRINT:INPUT "ENTER STRING TO FIND";SF$ 5900 PRINT:PRINT "PRINTER ON " 6000 GOSUB 18000 6100 IF YN=1 THEN PF=1 ELSE PF = 0 6200 PRINT CLS$:PRINT "SEARCHING" 6300 GOSUB 18600 6400 SFL=LEN(SF$) 6500 FOR I = 1 TO C 6600 IF SF$ = LEFT$(M(I,1),SFL) THEN GOSUB 18900 6700 NEXT I 6800 PRINT:PRINT "DONE "; 6900 GOSUB 18000 7000 IF YN=1 OR YN=0 GOTO 7300 7100 IF YN=(-1) GOTO 5700 7200 GOTO 6900 7300 RETURN 7400 PRINT CLS$ 7500 GOSUB 26000:PRINT "SEARCH FIELD 2" 7600 PRINT:INPUT "ENTER STRING TO FIND";SF$ 7700 PRINT:PRINT "PRINTER ON "; 7800 GOSUB 18000 7900 IF YN=1 THEN PF=1 ELSE PF = 0 8000 PRINT CLS$:PRINT "SEARCHING" 8100 GOSUB 18600 8200 SFL=LEN(SF$) 8300 FOR I = 1 TO C 8400 IF SF$ = LEFT$(M(I,2),SFL) THEN GOSUB 18900 8500 NEXT I 8600 PRINT:PRINT "DONE "; 8700 GOSUB 18000 8800 IF YN=1 OR YN=0 GOTO 9100 8900 IF YN=(-1) GOTO 7500 9000 GOTO 6900 9100 RETURN 9200 PRINT CLS$:INPUT "STARTING AT WHAT RECORD #";K 9300 IF K<1 OR K> LMX THEN K=1 9500 PRINT CLS$:PRINT "LIST LOG" 9600 PRINT:PRINT "PRINTER ON "; 9700 GOSUB 18000 9800 IF YN=1 THEN PF=1 ELSE PF = 0 9900 PRINT 10000 GOSUB 18600 10100 FOR I=K TO K+19 10200 GOSUB 18900 10300 NEXT I 10400 PRINT "MORE ? CONTINUES "; 10500 GOSUB 18000 10600 IF YN=1 OR YN=0 THEN K=K+20:PRINT:GOTO 10100 10700 RETURN 10800 PRINT CLS$:PRINT "EDIT LOG" 10900 INPUT "CHANGE RECORD #";L 10910 IF L<1 OR L> LMX THEN L=1 10950 GOSUB 26000:PRINT:PRINT "RECORD "L 10975 IF M(L,1)="" THEN GOSUB 26000:PRINT "RECORD #"L" BLANK":GOTO 12600 11000 PRINT:PRINT "FIELD 1: "M(L,1) 11050 PRINT "FIELD 2: "M(L,2) 11100 PRINT 11150 PRINT:PRINT "RE-ENTER FIELD - CR TO LEAVE UNCHANGED - * TO DELETE" 11200 PRINT:PRINT "FIELD 1: "M(L,1) 11205 PRINT SPC(9);STRING$(17,45);"*" 11210 INPUT " ";N$ 11250 IF N$=CHR$(42) THEN N$="*"+M(L,1):NN$=M(L,2):PRINT:PRINT:PRINT "DELETED":GOTO 11700 11300 IF N$="" THEN N$=M(L,1) 11400 PRINT:PRINT 11500 PRINT "FIELD 2: "M(L,2)" 11510 PRINT SPC(9);STRING$(54,45);"*" 11520 LINE INPUT " ";NN$ 11600 IF NN$="" THEN NN$=M(L,2) 11700 PRINT 11750 PRINT "RECORD "L" OK ? CONTINUES "; 11900 GOSUB 18000 12000 IF YN=1 OR YN=0 GOTO 12400 12100 IF YN=(-1) THEN PRINT:GOTO 10950 12200 PRINT:PRINT "ENTER Y OR N "; 12300 GOTO 11900 12400 M(L,1)=N$ 12500 M(L,2)=NN$ 12550 IF YN=0 THEN L=L+1:PRINT:GOTO 10950 12600 RETURN 12700 ON ERROR GOTO 16300 12800 GOSUB 26000:PRINT "ENTER FILENAME TO SAVE:" 12810 INPUT " RETURNS TO MENU";FTS$ 13000 IF FTS$="" THEN GOTO 14200 13100 NAME FTS$ AS FTS$ 13200 ON ERROR GOTO 16700 13300 KILL FTS$+".BAK" 13400 NAME FTS$ AS FTS$+".BAK" 13500 PRINT:PRINT FTS$ 13600 OPEN "O",#1,FTS$ 13700 FOR I=1 TO ( C - 1 ) 13750 IF LEFT$(M(I,1),1)=CHR$(42) GOTO 13900 13800 PRINT #1,M(I,1);" ,";CHR$(34);M(I,2);CHR$(34) 13900 NEXT I 14000 CLOSE#1 14100 PRINT "DATA SENT TO DISK" 14150 GOSUB 26000 14200 RETURN 14300 FOR C = 1 TO 400 14400 NEXT 14500 RETURN 14600 GOSUB 26000:PRINT "ENTER NAME OF FILE TO LOAD:" 14610 INPUT " RETURNS TO MENU";FTL$ 14700 IF FTL$="" THEN GOTO 15900 14710 GOSUB 26000 14800 PRINT FTL$ " TO LOAD" 14900 ON ERROR GOTO 16100 15000 OPEN "I",#1,FTL$ 15100 I=C 15200 INPUT #1,M(I,1),M(I,2) 15300 I=I+1 15400 IF M(I,1)= "0" AND M(I,2)= "0" THEN 15700 15500 IF EOF(1) THEN 15700 15600 GOTO 15200 15700 CLOSE 15800 C=I 15900 RETURN 16000 '*** ERROR ROUTINES *** 16100 PRINT "ERROR # " ERR 16110 IF ERR=53 THEN PRINT "FILE NOT ON DISK":CLOSE 16112 IF ERR=62 THEN PRINT "NO DATA IN FILE":CLOSE 16200 RESUME 14600 16300 IF ERR=53 THEN RESUME 13500 16400 IF ERR=58 THEN RESUME 13200 16500 PRINT "ERROR # "ERR 16600 RESUME 16700 IF ERR=53 THEN GOTO 17000 16750 PRINT "ERROR(2) #"ERR 16800 IF ERR= 61 THEN PRINT " DISK FULL !!": RESUME 14500 16900 IF ERR= 57 THEN PRINT "DISK READ/WRITE ERROR": RESUME 14500 17000 RESUME NEXT 17010 GOSUB 26000:PRINT P$;"ERROR #"ERR;" LOG MAY BE LOST"P$;BEL$ 17020 PRINT:PRINT P$;"SAVE LOG TO DISK NOW!";P$:RESUME 1300 17100 PRINT 17125 PRINT "SORTING HIT ANY KEY TO STOP" 17150 SF=0 17200 FOR I=1 TO C 17250 IF M(I+1,1)="" GOTO 17400 17299 IF M(I,1) > M(I+1,1) THEN SWAP M(I,1),M(I+1,1):SWAP M(I,2),M(I+1,2):SF=1 17300 YN$=INKEY$ 17310 IF YN$ <> "" THEN GOTO 17700 17400 NEXT 17500 IF SF=1 GOTO 17125 17700 RETURN 17800 GOSUB 26000:PRINT "EXIT TO BASIC AND ERASE LOG "; 17810 GOSUB 18000 17820 IF YN=(-1) THEN GOTO 17890 17830 IF YN=1 THEN GOTO 17895 17890 RETURN 17895 ON ERROR GOTO 0 17899 END 17900 '***SUBROUTINE AREA*** 18000 PRINT " (Y/N) ?"; 18100 YN$=INPUT$(1) 18200 IF YN$=CHR$(13) THEN YN=0:GOTO 18500 18300 IF YN$="N" OR YN$="n" THEN YN=(-1):GOTO 18500 18400 IF YN$="Y" OR YN$="y" THEN YN=1:GOTO 18500 18450 YN=255 18500 RETURN 18600 PRINT " # ";TAB(7);"FIELD ONE";TAB(26);"FIELD TWO" 18700 PRINT 18800 RETURN 18900 IF I < 10 THEN PRINT " ";I; 19000 IF I > 9 AND I < 100 THEN PRINT " ";I; 19100 IF I > 99 THEN PRINT I; 19200 PRINT TAB(7);M(I,1);TAB(26);M(I,2) 19300 IF PF=1 GOTO 19500 19400 RETURN 19500 IF M(I,1) = "" GOTO 19900 19550 IF I < 10 THEN LPRINT " ";I; 19600 IF I > 9 AND I < 100 THEN LPRINT " ";I; 19700 IF I > 99 THEN LPRINT I; 19800 LPRINT TAB(7);M(I,1);TAB(26);M(I,2) 19900 RETURN 20000 DUP=DUP*(-1) 20100 RETURN 25000 PRINT CLS$ 25100 PRINT "REPLACE DISK IN DRIVE" 25200 PRINT "READY " 25300 GOSUB 18000 25400 RESET 25500 RETURN 26000 PRINT:PRINT:PRINT:PRINT:RETURN 27000 PRINT:PRINT P$;P$;CG$;P$;P$ 27010 GOSUB 18000 27020 IF YN=1 THEN PRINT WT$:PRINT FRE(X$) 27030 RETURN