10 COM Y1,F1,A,M,C,U,T,U1,Q,E1 20 COM A$[80],B$[80],C$[80],D$[80],E$[80],F$[80],G$[80],H$[80],I$[80] 30 COM J$[80],K$[80],L$[80],S$[80],T$[80],V$[80] 40 COM A1$[80],C1$[80],D1$[35],E1$[12],F1$[80],H0$[80],S1$[80] 45 COM G1$[10],K1$[10],L1$[12],M1$[6],O1$[10] 46 COM P1$[4] 47 DIM A[14] 50 Y1=BRK(0) 55 F1=T=R9=Z1=0 60 E1=9 90 SYSTEM S1$,"TIM" 100 IF SYS(3)=1 THEN 2070 110 REM *** BBS1 *** 120 FILES *,*,*,*,*,*,* 145 SYSTEM X,"PAU-5" 150 ASSIGN "BBS04F.A002",4,R4, NR 160 IF SYS(3)=1 THEN 2070 170 IF R4=0 THEN 180 174 PRINT "STAND BY..." 175 ASSIGN "BBS04F.A002",4,R4, NR 176 IF SYS(3)=1 THEN 2070 177 IF R4#0 THEN 175 180 GOSUB 3720 190 GOSUB 4200 195 PRINT "CRISIS TIMESHARE BBS" 200 PRINT H0$ 210 C1$=UPS$(B$) 220 IF POS(C1$,"SAT") THEN 300 230 IF POS(C1$,"SUN") THEN 300 240 ENTER #P 250 IF P=18 AND TIM(1)>7 AND TIM(1)<18 THEN 280 260 IF P=19 AND TIM(1)>7 AND TIM(1)<18 THEN 280 270 GOTO 300 280 PRINT "PORT ";P;" NOT ALLOWED 8:00 AM TO 6:00 PM." 290 GOTO 2110 300 C1=X=0 310 C1$="" 320 I$="" 330 PRINT 340 IF ERROR THEN 2070 350 REM * LOG ON * 360 ASSIGN *,3 370 IF S1$[1,4]#"A000" THEN 410 380 C1$="SYSOP" 390 K1$="1" 410 PRINT "Please log on" 420 I$="" 430 PRINT ":"; 440 Y1=BRK(0) 444 IF S1$[1,4]#"A000" THEN 450 445 LINPUT S$ 446 IF S$='26'1'17 THEN 730 447 PRINT ":"; 450 ENTER 120,C,C1$ 460 IF C=-256 THEN 2070 470 B$="**********************************" 480 A$="XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" 490 PRINT A$[1,LEN(C1$)+1];CHR$(13);B$[1,LEN(C1$)+1] 500 IF C1$[1,1]="?" THEN 2140 510 IF LEN(C1$)>20 THEN 3700 520 IF LEN(C1$)<6 THEN 3680 530 IF POS(C1$,",") THEN 550 540 GOTO 3670 550 D=POS(C1$,",") 560 K1$=C1$[D+1,LEN(C1$)] 570 C1$=C1$[1,D-1] 580 CONVERT C1$ TO C1,620 590 IF C1=1 THEN 2070 600 CONVERT C1 TO I$ 610 GOTO 720 620 C1$=UPS$(C1$) 630 V$=UPS$(K1$) 640 IF LEN(C1$)>20 OR LEN(C1$)<5 THEN 350 650 IF C1$[1,5]="SYSOP" THEN 2070 660 IF SYS(3)=1 THEN 2070 670 IF ERROR THEN 2070 680 PRINT "Hello ";C1$;", is the spelling correct ?"; 690 LINPUT J$ 700 J$=UPS$(J$) 710 IF J$[1,1]="N" THEN 10 720 IF SYS(3)=1 THEN 2070 730 REM * CK FILE STATUS * 740 ASSIGN "BBS05F.A002",5,R5,'25, NR 750 READ #5,1;M1$ 760 ASSIGN *,5 770 IF V$="NEW" THEN 1100 850 Z1=1 880 IF ERROR THEN 2070 890 SYSTEM X,"ECH-ON" 900 IF SYS(3)=1 THEN 2070 910 READ #4,1 920 IF END #4 THEN 1060 930 IF SYS(3)=1 THEN 2070 940 REM * FN/LN/CTY-ST/CODE/USER/EX-NOV * 950 READ #4;A$,B$,T$,F1$,G1$,C$ 960 IF B$[1,1]="!" THEN 920 970 X1=REC(4) 980 X2=ITM(4) 990 IF I$=F1$ THEN 1020 1000 IF C1$=A$ THEN 1020 1010 GOTO 920 1020 IF T$=K1$ THEN 1690 1030 GOTO 1040 1040 PRINT "Invalid code"'7 1050 GOTO 410 1060 REM * ADD NEW USER * 1070 IF SYS(3)=1 THEN 2070 1080 PRINT "Cant find a record of ";C1$ 1090 GOTO 2100 1100 IF ERROR THEN 2070 1101 IF C1$#"BBS KILLER" THEN 1110 1103 GOTO 2070 1110 PRINT "Enter city,state :"; 1120 R9=1 1130 LINPUT F$ 1140 F$=UPS$(F$) 1150 IF LEN(F$)>20 OR LEN(F$)<5 THEN 1110 1160 IF ERROR THEN 2070 1170 PRINT "Enter a personal code or type '?' "; 1180 SYSTEM X,"ECH-OFF" 1190 LINPUT F1$ 1200 PRINT CHR$(13) 1210 IF F1$="" THEN 2350 1220 IF SYS(3)=1 THEN 2070 1230 IF F1$[1,1]="?" THEN 2350 1240 IF LEN(F1$)#4 THEN 1310 1250 FOR I=1 TO LEN(F1$) 1260 IF F$[I,I]=CHR$(31) THEN 1290 1270 IF F1$[I,I]CHR$(91) THEN 1330 1290 NEXT I 1300 GOTO 1350 1310 PRINT "Must be exactly 4 characters long."'7 1320 GOTO 1160 1330 PRINT "Upper case A-Z only." 1340 GOTO 1160 1350 PRINT "Type the code again to make sure it is O.K. "; 1360 LINPUT B$ 1370 IF SYS(3)=1 THEN 2070 1380 PRINT CHR$(13) 1390 IF B$=F1$ THEN 1430 1400 PRINT "Sorry it does not match ... try again"'7 1410 PRINT CHR$(13) 1420 GOTO 1160 1430 PRINT "O.K. don't forget the code." 1440 PRINT "Are you an expert with this system (Y/N or ?) "; 1450 SYSTEM X,"ECH-ON" 1460 LINPUT E$ 1470 E$=UPS$(E$) 1480 IF E$[1,1]="?" THEN 2290 1490 IF E$="" THEN 2290 1500 IF E$[1,1]="N" THEN 1550 1510 IF E$[1,1]="Y" THEN 1520 1520 E$="X" 1530 F1=1 1540 GOTO 1570 1550 E$="N" 1560 F1=0 1570 PRINT "Wait..." 1572 ASSIGN "BBS04F.A002",4,R4, RR 1573 IF SYS(3)=1 THEN 2070 1574 IF R4#0 THEN 1572 1580 IF ERROR THEN 2070 1590 IF SYS(3)=1 THEN 2070 1600 READ #4,1 1610 IF TYP(4)=3 THEN 1690 1620 READ #4;A$ 1630 IF A$=C1$ THEN 2420 1640 READ #4;A$,A$,A$,A$,A$ 1650 A$="" 1660 GOTO 1610 1670 REM * 5 ITEMS ALLOWED * 1680 IF END #1 THEN 1900 1690 ASSIGN "BBS01F.A002",1,R1,M1$, NR 1700 IF SYS(3)=1 THEN 2070 1710 IF R1=6 THEN 2050 1720 IF R1#0 THEN 1690 1730 READ #1,1;A,M,C,U 1740 IF R9=1 THEN 1780 1750 PRINT #1,1;A,M+1,C,U, END 1760 IF T$=K1$ THEN 1900 1770 IF C1$=A$ THEN 1900 1780 PRINT #1,1;A,M+1,C,U+1, END 1790 CONVERT U+1 TO C$ 1800 L$="" 1810 CONVERT TIM(3)*1000+TIM(2) TO L$[1,5] 1820 I$="0000 New user *00000+ " 1830 I$[33,35]=L$[1,3] 1840 E$=E$[1,3] 1850 E$[2,3]="ML" 1860 PRINT #4;C1$,F$,F1$,C$,E$,I$, END 1870 C$="0000" 1880 G1$=E$ 1890 CONVERT U+1 TO F1$ 1900 CONVERT C1$ TO C1,1920 1910 C1$=A$ 1920 T=1 1930 IF G1$[1,1]#"X" THEN 1950 1940 F1=1 1950 GOSUB 2480 1960 IF G1$[2,2]="M" THEN 2000 1970 IF G1$[3]="L" THEN 2020 1980 CHAIN C1,"BBS02P.A002",90 1990 IF C1#0 THEN 2050 2000 CHAIN C1,"BBS06P.A002",90 2010 IF C1#0 THEN 2050 2020 U1=1 2030 CHAIN C1,"BBS07P.A002",110 2040 IF C1#0 THEN 2050 2050 PRINT "Sorry the BBS is down... call back later."'7 2060 GOTO 2090 2070 REM ** LOG OFF ** 2080 PRINT "Error";SYS(0);"in line";SYS(1) 2090 PRINT "Code # 001" 2100 IF S1$[1,4]="A000" THEN 2130 2110 SYSTEM X,"BYE" 2120 GOTO 2110 2130 STOP 2140 ASSIGN "BBS02F.A002",3,R3, NR 2150 IF R3#0 THEN 2140 2160 C$="++++++" 2170 READ #3,1 2180 IF END #3 THEN 10 2190 IF SYS(3)=1 THEN 2070 2200 READ #3;B$ 2210 IF B$=C$ THEN 2230 2220 GOTO 2180 2230 READ #3;D$ 2240 IF SYS(3)=1 THEN 2070 2250 IF END #3 THEN 10 2260 IF D$[1,1]="+" THEN 10 2270 PRINT D$ 2280 GOTO 2230 2290 PRINT 2300 REM 2310 PRINT " time you log in. Typing an 'N' or hitting will" 2320 PRINT " keep command prompts in their original configuration." 2330 PRINT 2340 GOTO 1440 2350 PRINT 2360 PRINT "Type a four letter code that will be your password and" 2370 PRINT " protection code. The code must be upper case characters" 2380 PRINT " A-Z only, and must be exactly four characters long." 2390 PRINT " *** REMEMBER YOUR CODE !! ***" 2400 PRINT 2410 GOTO 1160 2420 READ #4;A$ 2430 IF A$[1,1]#"!" THEN 2460 2440 READ #4;A$,A$,A$,A$ 2450 GOTO 1650 2460 PRINT C1$;" already exists."'7 2465 ASSIGN *,4 2470 GOTO 410 2480 REM *** PORT LOCK SUB *** 2490 ENTER #P 2500 ASSIGN "BBSF32.A002",6,R6, NR 2510 PRINT #6,P+1; END 2520 PRINT #6,P+32; END 2530 PRINT #6,P+64; END 2540 ASSIGN *,6 2550 CONVERT P TO T$ 2560 L1$="BBSFXX.A002" 2570 IF P<10 THEN 2600 2580 L1$[5,6]=T$ 2590 GOTO 2620 2600 L1$="BBSF0X.A002" 2610 L1$[6,6]=T$ 2620 ASSIGN L1$,5,R5, WR 2630 IF R5#0 THEN 2550 2640 FOR I=1 TO 25 2650 PRINT #5,I; END 2660 NEXT I 2670 PRINT #5,1;C1$, END 2675 IF C1$="DAVE PACKARD" THEN 2685 2680 O1$="ONQ*" 2684 GOTO 2690 2685 O1$="HIDE*" 2690 PRINT #5,2;O1$, END 2700 GOTO 2720 2710 T$=B$ 2720 REM ** UPDATE LOG FILE ** 2730 READ #4,1 2740 IF END #4 THEN 2980 2750 X1=REC(4) 2760 X2=ITM(4) 2770 READ #4;B$,C$ 2780 IF C$[1,1]="!" THEN 2830 2790 READ #4;C$,C$,C$,C$ 2800 D$=C$ 2810 IF C1$=B$ THEN 2850 2820 GOTO 2740 2830 ADVANCE #4;4,A4 2840 GOTO 2740 2850 READ #4,X1 2860 ADVANCE #4;X2+5,A4 2870 B$=H0$ 2880 READ #1,1;A,M,C,U 2890 CONVERT C TO A$ 2900 C$=A$[1,5] 2910 B$[LEN(B$)+1]="*" 2920 C$[LEN(C$)+1]=B$ 2930 B$="" 2940 CONVERT TIM(3)*1000+TIM(2) TO B$[1,5] 2950 B$[LEN(B$)+1]="+" 2960 C$[LEN(C$)+1]=B$ 2970 UPDATE #4;C$ 2971 ASSIGN "RAT.A000",7,Z9 2972 READ #7,1 2973 ADVANCE #7;5000,R9 2974 PRINT #7;C1$,C$, END 2975 ASSIGN *,7 2980 REM ** GREETINGS ** 2990 ASSIGN "ZCATF.B200",2,R2, NR 3000 IF SYS(3)=1 THEN 2070 3010 IF R2#0 THEN 2990 3020 FOR I=1 TO 999 3030 IF TYP(2)=3 THEN 3080 3040 READ #2;L$ 3050 R2=I 3060 NEXT I 3070 ASSIGN *,2 3080 B=TIM(1) 3090 CONVERT R2 TO L$ 3100 IF B<12 THEN 3130 3110 IF B<18 THEN 3150 3120 GOTO 3170 3130 PRINT "Good morning "; 3140 GOTO 3180 3150 PRINT "Good afternoon "; 3160 GOTO 3180 3170 PRINT "Good evening "; 3180 D=POS(C1$," ") 3190 C$=D$ 3200 CONVERT C$[1,POS(C$," ")-1] TO P1 3210 P2=C 3220 P2=P2-P1 3230 CONVERT P2 TO A$ 3240 IF F1#0 THEN 3500 3250 IF D<4 THEN 3380 3260 PRINT C1$[1,D] 3270 PRINT "You are user # ";F1$;", and caller # ";M+1 3280 PRINT "Last on ";C$[5,POS(C$,"*")-1] 3290 PRINT L$[1,4];"Letters currently on file." 3300 PRINT "Last message at that time was #";D$[1,POS(D$," ")-1] 3310 IF POS(C$,"*")<1 THEN 3490 3320 CONVERT A$ TO A1 3330 IF A1#1 THEN 3360 3340 PRINT A$;" - New message entered since last log on." 3350 GOTO 3490 3360 PRINT A$;" Messages added since last log on." 3370 GOTO 3490 3380 PRINT C1$ 3390 PRINT "You are user # ";F1$;", and caller # ";M+1 3400 PRINT "Last on ";C$[5,POS(C$,"*")-1] 3410 PRINT L$[1,4];"Letters currently on file." 3420 PRINT "Last message at that time was #";D$[1,POS(D$," ")-1] 3430 IF POS(C$,"*")<1 THEN 3490 3440 CONVERT A$ TO A1 3450 IF A1#1 THEN 3480 3460 PRINT A$;" - Message entered since last log on." 3470 GOTO 3490 3480 PRINT A$;" Messages added since last log on." 3490 RETURN 3500 REM ** EXPERT PREAMBLE 3510 IF D<4 THEN 3540 3520 PRINT C1$[1,D] 3530 GOTO 3550 3540 PRINT C1$ 3550 CONVERT C TO G$ 3560 PRINT "User - ";F1$;", caller - ";M+1 3570 PRINT L$[1,4];" - Letters on file." 3580 PRINT G$[1,4];" - Last entered." 3590 PRINT D$[1,POS(D$," ")-1];" - Last read." 3600 CONVERT A$ TO A1 3610 IF A1#1 THEN 3640 3620 PRINT A$[1,4];" - New messages added." 3630 GOTO 3650 3640 PRINT A$[1,4];" - New messages added." 3650 IF POS(C$,"*")<1 THEN 3490 3660 GOTO 3490 3670 REM ** ERROR MESSAGES ** 3680 PRINT "Illegal format, type '?' for help"'7 3690 GOTO 410 3700 PRINT "Too many chr's"'7 3710 GOTO 410 3720 REM **** CALENDAR STARTS HERE **** 3730 IF ERROR THEN 2070 3740 DATA 0,31,60,91,121,152,182,213,244,274,305,335,366,999 3750 DATA 0,31,59,90,120,151,181,212,243,273,304,334,365,999 3760 S=TIM(0) 3770 H=TIM(1) 3780 D=TIM(2) 3790 Y=TIM(3) 3800 G$="0123456789000000000000000" 3810 H0$=" - - : AM" 3820 Q=H 3830 IF (H*100+S)<1200 THEN 3870 3840 H0$[16,17]="PM" 3850 IF H<13 THEN 3870 3860 Q=H-12 3870 GOSUB 4140 3880 H0$[10,11]=H$ 3890 Q=S 3900 GOSUB 4140 3910 H0$[13,14]=H$ 3920 IF Y/4=INT(Y/4) THEN 4120 3930 RESTORE 3750 3940 MAT READ A 3950 FOR I=1 TO 14 3960 IF D>A[I] THEN 4110 3970 IF I<14 THEN 4010 3980 D=D-A[13] 3990 Y=Y+1 4000 GOTO 3820 4010 Q=I-1 4020 GOSUB 4140 4030 H0$[1,2]=H$ 4040 Q=D-A[I-1] 4050 GOSUB 4140 4060 H0$[4,5]=H$ 4070 Q=Y 4080 GOSUB 4140 4090 H0$[7,8]=H$ 4100 RETURN 4110 NEXT I 4120 RESTORE 3740 4130 GOTO 3940 4140 REM NUMBER-TO-STRING 4150 N=INT(Q/10) 4160 H$[1,1]=G$[N+1,N+1] 4170 N=Q-N*10 4180 H$[2,2]=G$[N+1,N+1] 4190 RETURN 4200 REM *** PORT CHECK *** 4205 DIM Z[12] 4210 GOSUB 4250 4220 REM C$ = DATE -- B$ = DAY 4230 PRINT B$;". - "; 4240 RETURN 4250 MAT Z=CON 4260 MAT Z=(31)*Z 4270 LET Z[4]=Z[6]=Z[9]=Z[11]=30 4280 LET Z[2]=29 4290 LET B$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" 4300 LET A$="0123456789" 4310 LET Z1=TIM(3) 4320 IF Z1/4=INT(Z1/4) THEN 4340 4330 LET Z[2]=28 4340 LET Z8=TIM(2) 4350 FOR Z2=1 TO 12 4360 IF Z8 <= Z[Z2] THEN 4390 4370 LET Z8=Z8-Z[Z2] 4380 NEXT Z2 4390 LET Z3=INT(Z8/10) 4400 LET C$=" " 4410 IF Z3=0 THEN 4430 4420 LET C$=A$[Z3+1,Z3+1] 4430 LET Z3=Z8-Z3*10+1 4440 LET C$[2]=A$[Z3,Z3] 4450 LET C$[3]=" " 4460 LET C$[4]=B$[3*Z2-2,3*Z2] 4470 LET C$[7]=" " 4480 LET Z3=INT(Z1/10) 4490 LET C$[8]=A$[Z3+1,Z3+1] 4500 LET Z3=Z1-Z3*10+1 4510 LET C$[9]=A$[Z3,Z3] 4520 LET B$="SUNMONTUEWEDTHUFRISAT" 4530 LET Z3=TIM(2)+Z1+INT((Z1-1)/4) 4540 LET Z3=Z3-INT(Z3/7)*7 4550 LET B$=B$[3*Z3+1,3*Z3+3] 4560 RETURN 4570 END