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$=UOS$(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$=UOS$(C1$)
630  V$=UOS$(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$=UOS$(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$=UOS$(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$(64) THEN 1330
1280  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$=UOS$(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, PR 
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 <CR> 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 
