10 '          Source code for [XBBS] v2.3  Written By Robert Crump
20 '   -------------------------------------------------------------------
30 '    Please send any changes, suggestions, comments (in file form) to:
40 '           Norhtridge Systems RCP/M - [XBBS] v2.3
50 '           300/1200 Baud    818-708-3284
60 '           Sysop: Robert Crump
70 '   ------------------------------------------------------------------
80 ' Update history:
90 '
100 ' Included scan code by Norman Strassner
110 ' Removed copywrite. I would still like any changes sent to me, but
120 ' feel free to add to the source code for your own system.
130 '                               Robert Crump 01-JAN-85
140 '
150 ' Added the Q option for Xmodem.log display.
160 ' Added the A option for re-scanning of messages.
170 ' Changed SYSOP log on routine. Plus general code clean-up.
180 '                               Robert Crump 20-JAN-85
190 '   -------------------------------------------------------------------
200 '   You must do 2 things prior to using this program
210 '      1. Read the documentation completely
220 '      2. Remove the REMARK from line 320 (USER%)
230 '
240 '   This program is to be compiled with Microsofts (tm) Basic Compiler
250 '   using the O/X/Z switches. L80 link with XBBSUSER.REL
260 '   ------------------------------------------------------------------
270 '                  Begin Program
280 '   ------------------------------------------------------------------
290 DEFINT A-Z:H$="######":H1$="###":ABT$="++ABORTED++":INV$="Invalid message number..."
300 ABRT$="Use Ctl-S or S to Pause, Ctl-K or K to Abort"
310 DIM M$(16),M1$(16)
320 'USER%=0:CALL USER(USER%):POKE 0,&HCD
330 SYS1$="YOUR NAME HERE":P1$="ABCDEFG":P2$="ABCDEFGH":P3$="NOPASS":P4$="ABCDEF"
340 RT=&HFA10:RT1=(RT+1):RT2=(RT+5)
350 DSK$="A:":ERS$=CHR$(8)+" "+CHR$(8):GOTO 390
360 Z$=INKEY$:CY$=Z$:GOSUB 1790:Z$=CY$:IF Z$="Y" OR Z$="N" THEN RETURN ELSE 360
370 Z1$=INKEY$:CY$=Z1$:GOSUB 1790:Z1$=CY$:IF Z1$="C" OR Z1$="R" OR Z1$="N" OR Z1$="H" OR Z1$="?" THEN RETURN ELSE 370
380 Z2$=INKEY$:CY$=Z2$:GOSUB 1790:Z2$=CY$:IF Z2$="C" OR Z2$="M" OR Z2$="?" OR Z2$="K" OR Z2$="N" OR Z2$="H" THEN RETURN ELSE 380
390 FOR T9=1 TO 24:PRINT:NEXT T9
400 ON ERROR GOTO 2140
410 RFLG=PEEK(RT)
420 PRINT"YOUR SYSTEM NAME HERE RCP/M - [XBBS] Version 2.3";
430 OPEN"I",2,DSK$+"DATE. "+CHR$(160):INPUT #2,DT1$:CLOSE #2
440 IF RFLG<>&H24 THEN 490
450 FOR I=1 TO 6:C1=PEEK(RT1):PWD$=PWD$+CHR$(C1):RT1=RT1+1:NEXT I
460 OPEN "I",1,DSK$+"LASTCALR. "+CHR$(160):INPUT #1,NM$:CLOSE #1
470 IF NM$="SYSOP" THEN O$=NM$:GOTO 480:ELSE I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
480 PRINT:PRINT:PRINT"Welcome back to [XBBS], ";O$;".":T2=1:G3=1:GOTO 950
490 GOSUB 1240
500 GOSUB 1250
510 PRINT"Enter your First & Last Name or USER #: ";:C=1:T6=1:GOSUB 1450:N$=B$
520 IF N$="" THEN 510
530 CC=LEN(N$)
540 IF N$=P1$ THEN POKE 4,0:POKE 0,&HC3:SYSTEM
550 IF N$="SYSOP" THEN C=2:PRINT:PRINT"Password=> ";:GOSUB 1450:N$=B$:ELSE 580
560 IF N$=P2$ THEN NM$="SYSOP":PWD$=P4$:XPR=NOT XPR:T2=1:DTE$=DT1$:RFLG=&H24:GOTO 940
570 PRINT:PRINT"YOU ARE NOT THE SYSOP!":SYSTEM
580 IF ASC(LEFT$(N$,3))<&H40 THEN T=1
590 I=INSTR(B$,";"):IF I=0 THEN 600 ELSE 510
600 IF T=1 THEN 610 ELSE I=INSTR(N$," "):IF I=0 THEN 510 ELSE 610
610 PRINT:PRINT"Checking [XBBS] User File..."
620 GOSUB 1760:RN=2
630 GET #1,1:RN2=VAL(UR$):IF RN2<2 THEN RN2=2
640 IF T=0 GOTO 670
650 IF T=1 AND RN>1 THEN RN=VAL(B$):RN1=RN:ELSE RN=VAL(B$)
660 IF VAL(B$)=>RN2 OR VAL(B$)<=1 THEN PRINT"[INVALID USER #]":CLOSE #1:T=0:GOTO 510
670 GET #1,RN:GOSUB 4530
680 IF N$=NM$ OR RN1=UN THEN 690 ELSE RN=RN+1:GOTO 670
690 IF T=1 THEN PRINT:PRINT"Welcome back, ";NM$;".":GOTO 710
700 PRINT:PRINT"Welcome back, ";NM$;".":PRINT"For fast log on just enter your user number which is #";:PRINT USING H1$;UN;:PRINT "."
710 T1=0
720 IF T1=2 THEN PRINT"Too many errors, disconnecting...":SYSTEM:ELSE PRINT"Password=> ";:PRINT CHR$(7);
730 C=2:GOSUB 1450:N$=B$:IF N$="" THEN CLOSE #1:RN1=0:T=0:GOTO 510
740 IF PWD$<>N$ THEN T1=T1+1:GOTO 720:ELSE 890
750 IF RFLG=&H24 THEN 4020 ELSE PRINT:PRINT"Are you a new [XBBS] user? <Y/N> ";:GOSUB 360
760 IF Z$<>"N" THEN PRINT"Yes":GOTO 770:ELSE PRINT"No":PRINT"Ok, let's try again.":CLOSE #1:GOTO 510
770 T3=1:PRINT:PRINT"Your user number will be #";RN2
780 UN=RN2:NM$=N$:MH=0
790 PRINT:PRINT"Enter your City and State: ";:C=1:GOSUB 1450:CT$=B$
800 IF CT$="" THEN 790
810 CC=CC+LEN(CT$):IF CC=>30 THEN PRINT:PRINT"Please abbreviate your city and state.":CC=CC-LEN(CT$):CT$="":GOTO 790
820 PRINT:PRINT"Hello ";NM$;" From ";CT$
830 PRINT:PRINT"Do you wish to correct this entry? <Y/N>: ";:GOSUB 360
840 IF Z$<>"N" THEN :PRINT"Yes":CLOSE #1:PRINT:GOTO 510
850 PRINT"No":GOSUB 1850
860 RL=63:UR1$=STR$(RN2+1):GOSUB 4640:PUT #1,1
870 GOSUB 4610:PUT #1,RN:CLOSE #1
880 FIL$="NEWCOM. ":X=1:GOSUB 2060:GOTO 900
890 GOSUB 4610:PUT #1,UN:CLOSE #1
900 PRINT"Logging ";NM$;" to disk..."
910 OPEN"R",2,DSK$+"CALLERS. "+CHR$(160)+" ",45:FIELD #2,45 AS RR$:GET #2,1:RN=VAL(RR$):IF RN<2 THEN RN=2
920 RL=45:RR1$=STR$(RN+1):GOSUB 4680:PUT #2,1:RN=RN+1
930 RR1$=NM$+"~"+CT$+"~":GOSUB 4680:PUT #2,RN:CLOSE #2
940 OPEN"O",1,DSK$+"LASTCALR. "+CHR$(160):PRINT #1,NM$:CLOSE #1:I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
950 GOSUB 3930:GET #1,1:CN=CVI(CAL$)+1:GOSUB 960:M=CVI(MSG$):U=CVI(MNU$):LSET CAL$=MKI$(CN):PUT #1,1:CLOSE #1:GOTO 970
960 IF N$=P2$ OR G3=1 THEN CN=CN-1:RETURN ELSE RETURN
970 FOR I=1 TO 4:PRINT:NEXT I
980 PRINT"         [XBBS]"
990 PRINT"You are caller number: ";:PRINT USING H$;CN
1000 PRINT"Number of active msgs: ";:PRINT USING H$;M
1010 PRINT"Highest system msg. #: ";:PRINT USING H$;U
1020 IF MH<U AND MH<>0 THEN PRINT"High msg. # retrieved: ";:PRINT USING H$;MH
1030 PRINT:PRINT"Today's date is:  ";DT1$
1040 IF T2=1 OR T3=1 THEN 1060
1050 PRINT"You were last on: ";DTE$
1060 PRINT"Message numbers for you...":GOSUB 1920
1070 IF T2=1 OR T3=1 THEN 1090
1080 '**********MAIN COMMAND DISPATCHER*************
1090 B$="":SAV$="":G=0:T6=0:IF XPR THEN PRINT:PRINT"[COMMAND]: ";:C=1:GOSUB 1450:GOTO 1120:ELSE 1100
1100 PRINT"[XBBS]"
1110 PRINT"A,B,E,R,S,K,G,I,C,X (OR <H>ELP): ";:C=1:GOSUB 1450
1120 IF B$="" THEN 1090
1130 FF=INSTR("ABERH?SKGICX",B$):GOSUB 1140:GOTO 1090
1140 IF FF=0 THEN 1160
1150 ON FF GOTO 950,1250,2220,3290,1260,1260,2990,3720,1270,1240,1310,1230
1160 IF NM$<>"SYSOP" THEN 1220
1170 IF B$="L" THEN 4030
1180 IF B$="Z" THEN 4340
1190 IF B$="D" THEN 1890
1200 IF B$="P" THEN 3940
1210 IF B$="Q" THEN 4870
1220 PRINT"There is no '";B$+"', ";O$+".":SAV$="":RETURN
1230 XPR=NOT XPR:GOTO 1090
1240 FIL$="INFO. ":X=1:GOSUB 2060:RETURN
1250 FIL$="BULLETIN. ":X=0:GOSUB 2060:RETURN
1260 FIL$="MENU. ":X=0:GOSUB 2060:GOTO 1090
1270 IF NM$="SYSOP" THEN NM$=NM$+" ":GOTO 1290:ELSE PRINT:PRINT"Enter comments for the Sysop <Y/N>? ";:GOSUB 360
1280 IF Z$<>"Y" THEN PRINT"No":GOTO 1290:ELSE PRINT"Yes":GOSUB 4140
1290 I=INSTR(NM$," "):O$=LEFT$(NM$,I-1)
1300 PRINT:PRINT O$+", thanks for calling [XBBS]...";:SYSTEM
1310 '*********EXIT TO CPM**********
1320 G=RT2:PRINT:T=0:IF NM$="SYSOP" THEN 1410
1330 IF P3$="NOPASS" THEN 1380
1340 PRINT"Enter the name of DRI's file copy program.":PRINT
1350 IF T=2 THEN 1370 ELSE PRINT"Password=> ";:PRINT CHR$(7);:C=2:GOSUB 1440
1360 IF B$<>P3$ THEN T=T+1:GOTO 1350:ELSE PRINT:GOTO 1380
1370 PRINT:PRINT"++ACCESS DENIED++":PRINT:GOTO 1080
1380 PRINT"Enter comments for the Sysop <Y/N>? ";:GOSUB 360
1390 IF Z$<>"Y" THEN PRINT"No":GOTO 1400:ELSE PRINT"Yes":PRINT:GOSUB 4140
1400 IF XPR THEN 1410 ELSE PRINT:FIL$="ENTERCPM. ":X=0:GOSUB 2060
1410 FOR I=1 TO LEN(PWD$):POKE G,ASC(RIGHT$(PWD$,I)):G=G-1:NEXT I
1420 PRINT"Exiting [XBBS] and Entering CP/M":PRINT
1430 POKE RT,&H24:POKE 4,0:POKE 0,&HC3:SYSTEM
1440 '******ACCECPT A STRING INTO B$******
1450 B$=""
1460 IF SAV$="" THEN GOSUB 1550:IF C<>3 THEN PRINT
1470 IF T6=1 THEN 1490 ELSE SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 1500
1480 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1):GOTO 1500
1490 B$=SAV$:SAV$="":GOTO 1510
1500 IF LEN(B$)=0 THEN C=0:RETURN
1510 IF C=0 THEN 1530
1520 CY$=B$:GOSUB 1800:B$=CY$
1530 C=0:RETURN
1540 '******************************
1550 CHC=0:SAV$="":DC=0
1560 NCH=ASC(INPUT$(1))
1570 IF NCH=13 THEN RETURN
1580 IF NCH=127 THEN NCH=8:GOTO 1670
1590 IF NCH<32 THEN 1670
1600 IF CHC>=62 THEN PRINT CHR$(7);:GOTO 1560
1610 SAV$=SAV$+CHR$(NCH):CHC=CHC+1
1620 IF DC THEN PRINT CHR$(10);
1630 IF C<>2 THEN PRINT CHR$(NCH); ELSE PRINT CHR$(35);
1640 IF CHC=58 THEN PRINT CHR$(7);
1650 DC=0:GOTO 1560
1660 CHC=CHC-1:SAV$=LEFT$(SAV$,CHC):GOTO 1560
1670 IF CHC=0 THEN 1560
1680 IF NCH=8 THEN PRINT ERS$;:DC=0:GOTO 1660
1690 IF NCH<>24 THEN 1560
1700 GOSUB 1720
1710 GOTO 1550
1720 FOR BCC=1 TO CHC:PRINT ERS$;:NEXT BCC:RETURN
1730 IF C<>2 THEN PRINT SAV$;
1740 DC=0:GOTO 1560
1750 '**********************************
1760 OPEN"R",#1,DSK$+"USERS. "+CHR$(160)+" ",64
1770 FIELD#1,64 AS UR$
1780 RETURN
1790 '**********************************
1800 FOR ZZ=1 TO LEN(CY$)
1810 ZA=ASC(MID$(CY$,ZZ,1)):IF ZA<&H61 OR ZA>&H7A THEN 1830
1820 MID$(CY$,ZZ,1)=CHR$(ZA-&H20)
1830 NEXT ZZ
1840 RETURN
1850 '******NEW USER PASSWORD*******
1860 PRINT:PRINT"Enter 6 (ONLY) alphanumeric characters for your password.":PRINT:PRINT"Your password=> ";:C=2:GOSUB 1450
1870 IF B$="" OR LEN(B$)<6 OR LEN(B$)>6 THEN 1860 ELSE PWD$=B$:PRINT"Enter it again: ";:C=2:GOSUB 1450:PAS$=B$
1880 IF PWD$<>PAS$ THEN PRINT"No match, try again.":GOTO 1860:ELSE RETURN
1890 '************SYSOP DATE LOADER******************
1900 PRINT:PRINT"Enter today's date [DD-MMM-YY]: ";:GOSUB 1450
1910 IF B$="" THEN RETURN ELSE OPEN"O",#2,DSK$+"DATE. "+CHR$(160):PRINT #2,B$:CLOSE #2:RETURN
1920 '*******INITIAL SUMMARY SEARCH*******
1930 GOSUB 3900
1940 SR=2:SR1=0
1950 GET #1,SR:SU$=SUN$:SM=VAL(SUM$)
1960 I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1)
1970 IF SM=0 THEN SR=SR+1:GOTO 1950
1980 IF T4=1 THEN 1990 ELSE SC=SM:T4=1
1990 IF SU$="SYSOP" AND NM$=SYS1$ OR SU$=SYS1$ AND NM$="SYSOP" THEN 2010 ELSE 2000
2000 IF SU$<>NM$ THEN SR=SR+1:GOTO 1950:ELSE 2010
2010 PRINT SM;:SR=SR+1:SR1=SR1+1:GOTO 1950
2020 IF SR1=0 THEN 2050 ELSE 2030
2030 IF SR1=1 THEN PRINT:PRINT"Please retrieve and kill this message...":CLOSE #1:PRINT:GOTO 1090
2040 IF SR1=>2 THEN PRINT:PRINT"Please retrieve and kill these messages...":CLOSE #1:PRINT:GOTO 1090
2050 CLOSE #1:PRINT"Sorry, there are none today.":PRINT:GOTO 1090
2060 '*******FILE PRINT SECTION********
2070 OPEN"I",2,DSK$+FIL$:COUNT=0
2080 IF X THEN 2090 ELSE PRINT:PRINT ABRT$
2090 COUNT=COUNT+1:IF EOF(2) THEN 2130 ELSE LINE INPUT#2,A$:IF COUNT=21 THEN GOSUB 4780:IF Z$="N" THEN 2130 ELSE 2100
2100 IF X THEN PRINT A$:GOTO 2090
2110 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840
2120 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN GOSUB 4820:GOTO 2130:ELSE NEXT J3:PRINT:GOTO 2090
2130 CLOSE #2:PRINT:RETURN
2140 '*****ON ERROR TRAPPING*****
2150 IF ERL=1960 THEN RESUME 2020
2160 IF ERL=2070 THEN RESUME 4510
2170 IF ERL=3360 THEN RESUME 3710
2180 IF ERL=3070 THEN RESUME 3280
2190 IF ERL=4080 THEN RESUME 4120
2200 IF ERL=4540 THEN RESUME 750
2210 RESUME NEXT
2220 '******MESSAGE STORAGE*******
2230 T6=1:GOSUB 3930:GET #1,1:EM=CVI(MNU$)+1:PRINT "Message #";EM
2240 PRINT"To: (Or <CR> For All): ";:C=1:GOSUB 1450:A$=B$
2250 IF A$="" THEN A$="ALL"
2260 PRINT"<CR> TO ABORT"
2270 PRINT"Subject: ";:C=0:GOSUB 1450:C$=B$
2280 IF LEN(C$)>20 THEN PRINT:PRINT"Subject length too long, 20 characters max.":C$="":PRINT:GOTO 2260
2290 IF C$="" THEN CLOSE 1:GOSUB 4820:GOTO 1090
2300 IF A$="ALL" THEN PV$="PUBLIC":GOTO 2320:ELSE PRINT"Private <Y/N>: ";:GOSUB 360
2310 IF Z$<>"Y" THEN PV$="PUBLIC":PRINT"No":ELSE PV$="PRIVATE":PRINT"Yes"
2320 FOR T9=1 TO 24:PRINT:NEXT T9:PRINT"Msg.#";EM;"   Date: ";DT1$
2330 PRINT"To: ";A$
2340 PRINT"Subject: ";C$
2350 PRINT"Message is ";PV$;"."
2360 PRINT:PRINT"Enter up to 16 lines of text. Simicolons are accepted."
2370 PRINT"When finished, hit 2 returns in a row.
2380 PRINT"The  . =5 characters left."
2390 F=0:GOSUB 4810
2400 IF F=16 THEN PRINT"Message full.":GOTO 2480
2410 F=F+1
2420 IF F=15 THEN PRINT"(2 Lines left)"
2430 IF F=16 THEN PRINT"(Last line)"
2440 PRINT USING H1$;F;:PRINT "> ";
2450 GOSUB 1450:M$(F)=B$
2460 IF B$="" THEN F=F-1:IF F=0 THEN 2530 ELSE 2480
2470 GOTO 2400
2480 IF XPR THEN PRINT:PRINT"H,L,E,A,C,S: ";:C=1:GOSUB 1450:GOTO 2500
2490 PRINT:PRINT"SELECT: <H>eader, <L>ist, <E>dit, <A>bort, <C>ontinue, <S>ave: ";:C=1:GOSUB 1450
2500 IF B$="" THEN 2480
2510 FF=INSTR("HLEACS",B$):IF FF=0 THEN 2480
2520 ON FF GOTO 2630,2540,2700,2530,2400,2780
2530 CLOSE #1:GOSUB 4820:GOTO 1090
2540 '******MESSAGE LIST SECTION*******
2550 PRINT:PRINT"Msg #";EM;"   Date: ";DT1$
2560 PRINT"To: ";A$
2570 PRINT"Subject: ";C$
2580 PRINT"Message is ";PV$;".":PRINT
2590 FOR I=1 TO F
2600 PRINT USING H1$;I;:PRINT ": ";M$(I)
2610 NEXT I
2620 GOTO 2480
2630 '******HEADER CHANGE*******
2640 PRINT"Enter Replacement (Or <CR> for NO Change.)":PRINT"To: ";A$
2650 PRINT"TO: ";:C=1:GOSUB 1450:IF B$<>"" THEN A$=B$:GOTO 2660:ELSE A$=A$:GOTO 2680
2660 IF A$="ALL" THEN PV$="PUBLIC":GOTO 2680:ELSE PRINT"Private <Y/N>?: ";:GOSUB 1450
2670 IF B$<>"Y" THEN PV$="PUBLIC" ELSE PV$="PRIVATE"
2680 PRINT"Subject: ";C$
2690 PRINT"Subject: ";:C=0:GOSUB 1450:IF B$<>"" THEN C$=B$:GOTO 2480:ELSE C$=C$:GOTO 2480
2700 '******MESSAGE EDIT*******
2710 PRINT"Line number to change (Or <CR> To End): ";:GOSUB 1450
2720 F1=VAL(B$):IF F1=0 THEN 2480
2730 PRINT"Enter Replacement (Or <CR> for NO change)"
2740 PRINT"Line";F1;"was:"
2750 PRINT">";:PRINT M$(F1)
2760 PRINT">";:C=0:GOSUB 1450
2770 IF B$<>"" THEN M$(F1)=B$:GOTO 2480:ELSE M$(F)=M$(F):GOTO 2480
2780 '******MESSAGE SAVE******
2790 PRINT"Updating counters...";
2800 M=M+1:LSET MSG$=MKI$(M):LSET MNU$=MKI$(EM)
2810 PUT #1,1:CLOSE #1
2820 PRINT"Summary...";
2830 GOSUB 3900
2840 GET #1,1:SR=VAL(SUN$):IF SR<2 THEN SR=2
2850 LSET SUN$=STR$(SR+1):PUT #1,1
2860 LSET SUN$=A$+"~":LSET SUM$=STR$(EM):LSET SPR$=PV$:LSET SUP$=PWD$:LSET SUB$=C$+"~":LSET SFR$=NM$+"~":LSET SDT$=DT1$
2870 PUT #1,SR:CLOSE #1
2880 PRINT"Saving msg...";
2890 GOSUB 3920
2900 GET #1,1:MR=VAL(RR$):IF MR<2 THEN MR=2
2910 RR1$=STR$(MR+2+F):GOSUB 4660:PUT #1,1
2920 CM$=STR$(F)+"~"+PV$+"~"+PWD$+"~"+C$+"~"+DT1$
2930 CM1$=STR$(EM)+"~"+A$+"~"+NM$+"~"
2940 RR1$=CM$:GOSUB 4660:PUT #1,MR:MR=MR+1:RR1$=CM1$:GOSUB 4660:PUT #1,MR:MR=MR+1
2950 FOR I=1 TO F
2960 RR1$=M$(I):GOSUB 4660:PUT #1,MR:MR=MR+1
2970 NEXT I
2980 CLOSE #1:PRINT"Message #";EM;"saved.":PRINT:U=EM:GOTO 1090
2990 '********MESSAGE SCAN***********
3000 IF SAV$<>"" THEN 3010 ELSE PRINT:PRINT"Start scan at msg.#";" (";SC;"-";U;")";" or <CR> to quit: ";
3010 C=1:GOSUB 1450:SR=VAL(B$):IF B$="" THEN PRINT:GOTO 1080
3020 IF ASC(B$)>&H40 THEN 3000
3030 IF SR>U THEN PRINT:PRINT INV$:GOTO 3000
3040 PRINT:PRINT ABRT$:PRINT
3050 GOSUB 4800:GOSUB 3900:T=0:MR=2
3060 GET #1,MR:SU$=SUN$:SM=VAL(SUM$):PM$=SPR$:SPD$=SUP$:SUJ$=SUB$:FR$=SFR$:DT2$=SDT$:T=T+1
3070 I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1)
3080 I=INSTR(FR$,"~"):FR$=LEFT$(FR$,I-1)
3090 I=INSTR(SUJ$,"~"):SUJ$=LEFT$(SUB$,I-1)
3100 IF SM=0 THEN MR=MR+1:T=T-1:GOTO 3060
3110 IF SM<SR THEN MR=MR+1:T=T-1:GOTO 3060
3120 IF PWD$=P4$ OR NM$=SYS1$ THEN 3140
3130 IF PWD$<>SPD$ AND NM$<>SU$ AND PM$="PR" THEN MR=MR+1:T=T-1:GOTO 3060
3140 IF PM$="PR" THEN SUJ$="[PRIVATE]"
3150 IF LEN(SUJ$)>19 THEN SUJ$=LEFT$(SUJ$,19)
3160 A$=DT2$+"  "+SU$+STRING$(22-LEN(SU$),32)+FR$+STRING$(22-LEN(FR$),32)+SUJ$
3170 Z$=MID$(STR$(SM),2):PRINT Z$;STRING$(5-LEN(Z$),32);
3180 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840
3190 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN CLOSE #1:GOSUB 4820:GOTO 1080:ELSE NEXT J3:PRINT
3200 IF T=19 THEN 3210 ELSE MR=MR+1:GOTO 3060
3210 PRINT:PRINT"Select: (C,R,N,H) ";:GOSUB 370
3220 FF=INSTR("CRNH?",Z1$):IF FF=0 THEN 3220
3230 ON FF GOTO 3240,3250,3260,3270,3270
3240 PRINT Z1$:PRINT:MR=MR+1:T=0:GOSUB 4800:GOTO 3060
3250 PRINT Z1$:PRINT:PRINT"Message #? ";:C=1:GOSUB 1450:RE=VAL(B$):MR=2:CLOSE #1:PRINT:GOTO 3330
3260 PRINT Z1$:GOTO 3280
3270 PRINT Z1$:FIL$="MSH. ":X=1:GOSUB 2070:GOTO 3210
3280 CLOSE #1:PRINT:PRINT"End of [XBBS] survey...":PRINT:GOTO 1090
3290 '*********MESSAGE RETRIEVE**********
3300 IF SAV$<>"" THEN G=1:GOTO 3310:ELSE PRINT:PRINT"Retrieve from msg.#";" (";SC;"-";U;")";" or <CR> to quit: ";
3310 G2=0:T6=0:T8=0:C=1:GOSUB 1440:RE=VAL(B$):IF B$="" THEN PRINT:GOTO 1080
3320 PRINT:PRINT ABRT$;",";" ";"Ctl-X or X to Skip."
3330 M1=0:IF ASC(B$)>&H40 THEN 3300
3340 IF RE>U THEN PRINT:PRINT INV$:GOTO 3300
3350 GOSUB 3920:MR=2:PRINT
3360 GET #1,MR:I=INSTR(RR$,"~"):LE=VAL(LEFT$(RR$,I-1))
3370 J=INSTR(I+1,RR$,"~"):PA$=MID$(RR$,I+1,J-I-1)
3380 J1=INSTR(J+1,RR$,"~"):PA1$=MID$(RR$,J+1,J1-J-1)
3390 J2=INSTR(J1+1,RR$,"~"):PA2$=MID$(RR$,J1+1,J2-J1-1)
3400 J3=INSTR(J2+1,RR$," "):PA3$=MID$(RR$,J2+1,J3-J2-1)
3410 MR=MR+1:GET #1,MR:I=INSTR(RR$,"~"):EM=VAL(LEFT$(RR$,I-1))
3420 J=INSTR(I+1,RR$,"~"):PA4$=MID$(RR$,I+1,J-I-1)
3430 J1=INSTR(J+1,RR$,"~"):PA5$=MID$(RR$,J+1,J1-J-1):IF T5=1 THEN 3870 ELSE 3440
3440 IF EM=>RE THEN 3450 ELSE MR=MR+LE+1:GOTO 3360
3450 IF PWD$=P4$ OR NM$=SYS1$ THEN 3500 ELSE 3460
3460 IF PA4$<>NM$ THEN 3470 ELSE 3490
3470 IF PA$="PUBLIC" THEN 3490 ELSE 3480
3480 IF PA1$<>PWD$ THEN PRINT EM;+"[Private Message]";:PRINT:PRINT:MR=MR+LE+1:GOTO 3360
3490 IF T8=1 THEN 3500 ELSE IF MH<EM THEN MH=EM:T8=1:GOTO 3500
3500 PRINT"Msg.#";EM;"  Date: ";PA3$
3510 PRINT"To: ";PA4$
3520 PRINT"From: ";PA5$
3530 IF PA$="PRIVATE" THEN PA2$=PA2$+" *"
3540 PRINT"Subject: ";PA2$:PRINT
3550 MR=MR+1
3560 GET #1,MR:M1=M1+1
3570 GOSUB 4700:FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4410:NEXT J3:PRINT
3580 IF M1=LE THEN 3590 ELSE MR=MR+1:GOTO 3560
3590 PRINT:PRINT"Select: (C,M,K,N,H) ";:GOSUB 380
3600 FF=INSTR("CMKNH?",Z2$):IF FF=0 THEN 3600
3610 ON FF GOTO 3620,3630,3660,3680,3700,3700
3620 PRINT Z2$:MR=MR+1:RE=RE+1:M1=0:T8=0:PRINT:GOTO 3360
3630 GOSUB 1470:IF LEN(B$)=0 THEN 3650 ELSE 3640
3640 PRINT Z2$:RE=VAL(B$):MR=MR+1:M1=0:T8=0:PRINT:PRINT:GOTO 3360
3650 CLOSE #1:PRINT Z2$:PRINT:PRINT"Message number? ";:C=1:GOSUB 1440:IF B$="" THEN 1080 ELSE RE=VAL(B$):M1=0:GOTO 3330
3660 PRINT Z2$:CLOSE 1:MS=EM:IF T8=1 THEN 3670 ELSE 3760
3670 GOSUB 4490:GOTO 3760
3680 PRINT Z2$:M1=0:CLOSE 1:IF T8=1 THEN 3690 ELSE PRINT:PRINT:GOTO 1080
3690 GOSUB 4490:PRINT:GOTO 1080
3700 PRINT Z2$:FIL$="MRH. ":X=1:GOSUB 2070:GOTO 3590
3710 PRINT"End of [XBBS] messages...":PRINT:CLOSE #1:MH=EM:GOSUB 4490:PRINT:GOTO 1080
3720 '***********MESSAGE KILL*************
3730 IF SAV$<>"" THEN 3740 ELSE PRINT:PRINT"Message number to kill? ";"(";SC;"-";U;") : ";
3740 GOSUB 1450:MS=VAL(B$):IF B$="" THEN 1080
3750 IF MS=0 OR ASC(B$)>&H40 THEN 3730
3760 GOSUB 3900:SR=2
3770 GET #1,SR:SM=VAL(SUM$):SU$=SUN$:I=INSTR(SU$,"~"):SU$=LEFT$(SU$,I-1):PA$=SUP$
3780 IF EOF(1) THEN 3810 ELSE 3790
3790 IF SM<>MS THEN SR=SR+1:GOTO 3770:ELSE 3820
3800 PRINT:GOTO 1080
3810 PRINT:PRINT INV$:CLOSE #1:GOTO 1090
3820 IF PWD$=P4$ THEN 3850 ELSE 3830
3830 IF PA$<>PWD$ THEN 3840 ELSE 3850
3840 IF SU$=NM$ THEN 3850 ELSE PRINT:PRINT"You cannot kill this message...";:CLOSE #1:PRINT:PRINT:GOTO 1090
3850 LSET SUM$=STR$(0):PUT #1,SR:CLOSE #1
3860 GOSUB 3920:MR=2:T5=1:GOTO 3360
3870 IF EM<>MS THEN MR=MR+LE+1:GOTO 3360:ELSE T5=0
3880 CM1$=" 0"+":"+STR$(EM)+"~"+PA4$+"~"+PA5$+"~":RR1$=CM1$:GOSUB 4660:PUT #1,MR:CLOSE 1
3890 GOSUB 3930:LSET CAL$=MKI$(CN):M=M-1:LSET MSG$=MKI$(M):LSET MNU$=MKI$(U):PUT #1,1:PRINT:PRINT"Message #";MS;"killed...":CLOSE #1:SAV$="":PRINT:GOTO 1080
3900 OPEN"R",1,DSK$+"SUMMARY. "+CHR$(160)+" ",92
3910 FIELD #1,24 AS SUN$,6 AS SUM$,2 AS SPR$,6 AS SUP$,21 AS SUB$,24 AS SFR$,9 AS SDT$:RETURN
3920 OPEN"R",1,DSK$+"MESSAGES. "+CHR$(160)+" ",64:FIELD #1,64 AS RR$:RETURN
3930 OPEN"R",1,DSK$+"COUNTERS. "+CHR$(160)+" ",12:FIELD #1,4 AS CAL$,4 AS MSG$,4 AS MNU$:RETURN
3940 '*************PASSWORD CHANGE***************
3950 NP$=NM$:GOSUB 1760
3960 PRINT"Enter Users name: ";:C=1:T6=1:GOSUB 1460:N$=B$:RN=2
3970 IF B$="" THEN 1080
3980 I=INSTR(B$,";"):IF I=0 THEN 3990 ELSE 3960
3990 GET #1,RN:GOSUB 4530
4000 IF NM$<>N$ THEN RN=RN+1:GOTO 3990
4010 GOSUB 1860:GOSUB 4610:PUT #1,UN:CLOSE #1:NM$=NP$:GOTO 1080
4020 PRINT:PRINT"Not a current user...":CLOSE #1:NM$=NP$:GOTO 1080
4030 '*********CALLER LISTING F/SYSOP*********
4040 OPEN"R",2,DSK$+"CALLERS. "+CHR$(160)+" ",45:FIELD #2,45 AS RR$:CA=2:LU=CN:PRINT
4050 GET #2,1:SIZ=VAL(RR$):CA=CN
4060 FOR I=SIZ TO 2 STEP -1
4070 GET #2,I
4080 J=INSTR(RR$,"~"):CL$=LEFT$(RR$,J-1)
4090 J1=INSTR(J+1,RR$,"~"):LC$=MID$(RR$,J+1,J1-J-1)
4100 A$=STR$(CA)+" "+CL$+" "+LC$
4110 GOSUB 4890:CA=CA-1:NEXT I
4120 CLOSE #2:PRINT"Kill callers file <Y/N>? ";:GOSUB 360
4130 IF Z$<>"Y" THEN PRINT"No":GOTO 1080:ELSE PRINT"Yes":KILL"CALLERS. ":PRINT:GOTO 1080
4140 '*******COMMENTS ENTRY SECTION**********
4150 F=0:PRINT"Enter up to 16 lines of text. When finished enter 2 blank lines."
4160 PRINT:GOSUB 4810
4170 IF F=16 THEN PRINT"Message Full..": GOTO 4220
4180 F=F+1
4190 PRINT USING H1$;F;:PRINT"> ";:C=0:GOSUB 1440:M1$(F)=B$
4200 IF B$="" THEN F=F-1:IF F=0 THEN 4270 ELSE 4220
4210 GOTO 4170
4220 IF XPR THEN PRINT"S,A: ";:C=1:GOSUB 1440:GOTO 4240
4230 PRINT"<S>ave, <A>bort: ";:C=1:GOSUB 1440
4240 IF B$="" THEN 4220
4250 FF=INSTR("SA",B$):IF FF=0 THEN 4220
4260 ON FF GOTO 4280,4270
4270 GOSUB 4820:RETURN
4280 OPEN"R",1,DSK$+"COMMENTS. "+CHR$(160)+" ",64:FIELD #1,64 AS CO$
4290 GET #1,1:CR=VAL(CO$):IF CR<2 THEN CR=2
4300 LSET CO$=STR$(CR+1+F):PUT #1,1
4310 LSET CO$=NM$+"  "+DT1$+"~":PUT #1,CR:CR=CR+1
4320 FOR I=1 TO F:LSET CO$=M1$(I):PUT #1,CR:CR=CR+1:NEXT I
4330 CLOSE #1:PRINT"Comment saved....":PRINT:RETURN
4340 '************COMMENT LIST SECTION***************
4350 OPEN"R",1,DSK$+"COMMENTS. "+CHR$(160)+" ",64:FIELD #1,64 AS CO$:LI=2
4360 GET #1,LI:I=INSTR(CO$,"~"):RR$=CO$:GOSUB 4700:IF I=0 THEN 4370 ELSE PRINT
4370 IF EOF(1) THEN 4390
4380 GOSUB 4890:LI=LI+1:GOTO 4360
4390 CLOSE #1:PRINT:PRINT"Kill comments file <Y/N>? ";:GOSUB 360
4400 IF Z$<>"Y" THEN PRINT"No":PRINT:GOTO 1080:ELSE PRINT"Yes":KILL"COMMENTS. ":PRINT:GOTO 1080
4410 '**************MESSAGE CONTROL SECTION*************
4420 GOSUB 4840:IF BI=&H18 OR BI=&H58 OR BI=&H78 THEN 4440
4430 IF BI=&HB OR BI=&H4B OR BI=&H6B THEN 4480 ELSE RETURN
4440 IF G2=1 THEN 4460 ELSE 4450
4450 IF LEN(SAV$)=>1 THEN G2=1:GOTO 4460:ELSE PRINT:PRINT:PRINT"++SKIP++":MR=MR+(LE-M1)+1:RE=RE+1:M1=0:PRINT:GOTO 3360
4460 GOSUB 1470:IF LEN(B$)=0 THEN 3650 ELSE 4470
4470 RE=VAL(B$):MR=MR+(LE-M1)+1:M1=0:PRINT:PRINT:PRINT"++SKIP++":PRINT:GOTO 3360
4480 GOSUB 4820:CLOSE #1:M1=0:PRINT:GOTO 1090
4490 '***********HIGH MSG ENTER*************
4500 IF RFLG=&H24 THEN RETURN ELSE GOSUB 1750:GOSUB 4610:PUT #1,UN:CLOSE #1:RETURN
4510 '***** ON ERROR CLOSE *****
4520 CLOSE:PRINT:RETURN
4530 '***** USER SEPERATOR *****
4540 I=INSTR(UR$,"~"):UN=VAL(LEFT$(UR$,I-1))
4550 I1=INSTR(I+1,UR$,"~"):NM$=MID$(UR$,I+1,I1-I-1)
4560 I2=INSTR(I1+1,UR$,"~"):PWD$=MID$(UR$,I1+1,I2-I1-1)
4570 I3=INSTR(I2+1,UR$,"~"):DTE$=MID$(UR$,I2+1,I3-I2-1)
4580 I4=INSTR(I3+1,UR$,"~"):MH=VAL(MID$(UR$,I3+1,I4-I3-1))
4590 I5=INSTR(I4+1,UR$,"~"):CT$=MID$(UR$,I4+1,I5-I4-1)
4600 RETURN
4610 '***** USER FILE LSET *****
4620 RL=63
4630 UR1$=STR$(UN)+"~"+NM$+"~"+PWD$+"~"+DT1$+"~"+STR$(MH)+"~"+CT$+"~"
4640 LSET UR$=LEFT$(UR1$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
4650 RETURN
4660 '***** MESSAGES FILE LSET *****
4670 RL=64
4680 LSET RR$=LEFT$(RR1$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
4690 RETURN
4700 '**** MESSAGE UNPACKING *****
4710 ZZ=LEN(RR$)-2
4720 WHILE MID$(RR$,ZZ,1)=" "
4730 ZZ=ZZ-1:IF ZZ=1 THEN 4750
4740 WEND
4750 A$=LEFT$(RR$,ZZ)
4760 IF MID$(A$,ZZ,1)="?" THEN A$=A$+" "
4770 RETURN
4780 '**** FILE AND SCAN SUBROUTINES *****
4790 PRINT"More (Y/N)";:GOSUB 360:FOR I=1 TO 11:PRINT ERS$;:NEXT I:RETURN
4800 PRINT"Msg#| Date:    | To:                 | From:               | Subject:":PRINT:RETURN
4810 PRINT"     <--------------------MAX LINE LENGTH---------------------.--->":RETURN
4820 '***** ABORT PRINT SUB *****
4830 PRINT:PRINT:PRINT ABT$:PRINT:RETURN
4840 '**** CONTROL ^S CHARACTER TRAP ****
4850 BI=ASC(INKEY$+" ")
4860 IF BI=&H13 OR BI=&H53 OR BI=&H73 THEN BI=ASC(INPUT$(1)):GOTO 4850:ELSE RETURN
4870 '****XMODEM.LOG READ SECTION*****
4880 FIL$="XMODEM.LOG":X=0:GOSUB 2060:RETURN
4890 '****MID$ PRINT SECTION****
4900 FOR J3=1 TO LEN(A$):PRINT MID$(A$,J3,1);:GOSUB 4840:NEXT J3:PRINT:RETURN
10000 +++"You didn't read the documentation did you?! Read it now"+++