1 REM Greetings! (leave this line in) v. 1200a/cis upl 4/11/86
2 REM BBS100 Program  <c> 1984 by Chuck Buchanan, Burkardt's MHP, Star Route E., Hwy 41, Spirit Lake, ID 83869  208-623-3971(non-mdm) or CIS 72335,1301
4 CLOSE:CLEAR1500:MAXFILES=4:ONERRORGOTO60:GOSUB10:GOSUB39:PRINT#1,"AT":GOSUB35:PRINT#1,"ATS2=92S0=2":GOSUB35:GOSUB39:GOSUB80
5 CLOSE:BEEP:CLEAR1500:POWER CONT:MAXFILES=4:ONERRORGOTO60:GOSUB10:ONKEYGOSUB88,120,125,128
6 KEYON:DEFINTA-Z:DEFSTRJ,W:DIM W(32),N$(32),P$(32):MN=10+VAL(RIGHT$(TIME$,2)):GOTO135
8 IFZD=4500THENERROR60ELSEZT=PEEK(65414):IFZT=0THENZD=ZD+1:GOTO8ELSEPRINT"< ";:K$=INPUT$(1,2):IFK$=CHR$(8)THEN8ELSEZD=0:PRINTK$:IFASC(K$)>96ANDASC(K$)<123THENK$=CHR$(ASC(K$)-32):RETURNELSERETURN
9 FORZ=1TOLEN(TK$):IFASC(MID$(TK$,Z,1))>96THENMID$(TK$,Z,1)=CHR$(ASC(MID$(TK$,Z,1))-32):NEXT:RETURNELSENEXT:RETURN
10 GOSUB11:OPEN"COM:38N1E"FOROUTPUTAS1:OPEN"COM:38N1E"FORINPUTAS2:RETURN
11 OPEN"SYSDFZ.DO"FORAPPENDAS4:RETURN
13 PRINT#1,:PRINT #1,"* press asterisk <*> to go on":PRINT"< ";:K$=INPUT$(1,2):PRINTK$:IFK$<>"*"THEN13ELSEPRINT#1,"> Bravo !":PRINT#1,:PRINT#1,:RETURN
17 PRINT#1,:PRINT#1,"* select <Y> or <N> ";
18 GOSUB8:IFK$="Y"ORK$="N"THENPRINT#1,:PRINT#1,:RETURNELSE17
20 PRINT:PRINT:PRINT"$ "K$" Menu":PRINTSTRING$(39,95):PRINT:RETURN
25 GOSUB33:PRINT#4,"# "LEFT$(UI$,3)" "DAY$" "LEFT$(TIME$,5):RETURN
26 PRINT#4,"< "EB$:RETURN
27 PRINT#4,"> "ID$:ID$="":DE=DE+1:RETURN
28 PRINT#4,"0 "EB$:DE=DE-1:RETURN
29 PRINT#4,"= "LEFT$(UI$,3)"-"K$" "LEFT$(DATE$,5)"  "MM(3):RETURN
30 PRINT#1,STRING$(31,61):RETURN
32 PRINT#1,STRING$(31,95):RETURN
33 PRINT#1,CHR$(7):RETURN
35 FORZ=1TO300:NEXT:RETURN
36 FORZ=1TO1000:NEXT:RETURN
39 FORX=1TO8:PRINT#1,:NEXT:RETURN
40 PRINT#1,"* 30 Lines by 32 Chars Max":GOSUB30:PRINT#1,"* Use the AT Key <@> to QUIT":PRINT#1,:PRINT#1,
41 IFLZ=31THENPRINT#1,:PRINT#1,"* buffer full":GOSUB36:LZ=LZ-1:A=LZ:RETURN
42 IFLZ=20THENGOSUB33:PRINT#1,:PRINT#1,"* only 10 lines left":PRINT#1,
43 K$=MID$(STR$(LZ),2):IFLZ<10THENK$="0"+K$
44 PRINT#1,LEFT$(K$,2);:GOSUB50:W(LZ)=TK$:IFK$="@"THENA=LZ:RETURN
46 IFLEN(W(LZ-2))<3ANDLEN(W(LZ-1))<3ANDLEN(W(LZ))<3THENLZ=LZ-1:A=LZ:RETURN
48 LZ=LZ+1:GOTO41 
50 K$="":TK$="":PRINT#1,"> ";:PRINT"+ ";
52 IFZD=4500THENERROR60ELSEZT=PEEK(65414):IFZT=0THENZD=ZD+1:GOTO52ELSEK$=INPUT$(1,2):ZD=0:IFK$=CHR$(8)ANDLEN(TK$)>0THENPRINT#1,K$" "K$;:PRINTK$" "K$;:TK$=LEFT$(TK$,(LEN(TK$)-1)):GOTO52
54 TK$=TK$+K$:IFK$=CHR$(13)ORK$="@"THEN58
55 IFLEN(TK$)>28ANDK$=CHR$(32)THEN58
56 PRINT#1,K$;:PRINTK$;:GOTO52
58 PRINT#1,:PRINT:TK$=LEFT$(TK$,(LEN(TK$)-1)):RETURN
60 PRINT:BEEP:PRINT"? Error"ERR"in"ERL:PRINT:IFERR=60THENGOSUB39:PRINT#1,"* overdue input...":PRINT#1,:K$="time":GOSUB75:GOSUB80:GOSUB29:RESUME1
61 IFERR=FKTHENFK=500:CLOSE:GOSUB10:PRINT#1,:PRINT#1,:PRINT#1,"* CLOSED ERROR LOOP":PRINT#4,"[ "LEFT$(UI$,3):PRINT#1,:GOSUB75:GOSUB80:GOSUB29:RESUME1
62 IFERR=52ORERR=55THENCLOSE3:GOSUB11:PRINT#1,:PRINT#1,"* note not found as spelled":EB$="":GOSUB33:PRINT#1,:RESUME155
63 IFERR=54THENFK=54:CLOSE:GOSUB10:RESUME
64 CLOSE:GOSUB10:PRINT#1,:PRINT#1,"* bbs error #"ERR"in "ERL:PRINT#4,"? BBS #"ERR"/"ERL:GOSUB33:PRINT#1,"> re-log necessary":PRINT#1,:FK=ERR:Y=0:RESUME137
65 PRINT#1,:PRINT#1,"* thank you, "UI$:GOSUB75:GOSUB80:GOSUB29:GOTO135
75 A$(2)=TIME$:PRINT#1,"* Log Off at "A$(2):PRINT#1,:PRINT#1,"* Elapsed time:";:IFA$(1)=""THENMM(3)=0:GOTO78ELSEFORZ=1TO2:MM(Z)=VAL(MID$(A$(Z),4,2)):NEXTZ
77 IFMM(2)=MM(1)THENMM(3)=1ELSEIFMM(2)>MM(1)THENMM(3)=MM(2)-MM(1)ELSEMM(3)=(60-MM(1))+MM(2)
78 PRINT#1,MM(3)"Minute";:IFMM(3)<>1THENPRINT#1,"s"
79 PRINT#1," ":RETURN
80 BEEP:PRINT"* hangup":PRINT#1,:PRINT#1,"* please hang up now...":PRINT#1,:PRINT#1,"> Off  \\\";:GOSUB36:GOSUB36:PRINT#1,"\\\";:GOSUB36:PRINT#1,"ATH":CLOSE:GOSUB10:RETURN
85 PRINT#1,:PRINT#1,"* Sysop Chat Mode":PRINT#1,:PRINT#1,"* now paging Sysop .. ":PRINT#1,:PRINT#1," ";:FORX=1TO10:BEEP:GOSUB36:PRINT#1,X;:NEXT:PRINT#1,:GOSUB30:PRINT#1,:PRINT:BEEP
86 PRINT#1,"* if SYSOP doesn't answer":PRINT:PRINT#1, "  in next TEN SECONDS then":PRINT#1,"  he's not in attendance":PRINT"* key 1 NOW !":PRINT#1,"* wait 10 sec..":FORX=1TO4000:NEXT:GOTO155
88 BEEP:GOSUB33:PRINT#1,:PRINT#1,"* Hello,  "UI$" !!  This":PRINT "* now in Chat with "UI$:PRINT:PRINT#1,"  is SYSOP... You still there ?":PRINT#1,
90 GOSUB33:PRINT#1,"* your entry.. press <enter> to":PRINT#1,"  send or <@> to exit Chat":PRINT#1,:PRINT
92 GOSUB50:IFK$=CHR$(13)THENPRINT:PRINT:GOTO100
94 IFK$="@"THENPRINT:PRINT"* exited...":GOTO115
96 GOTO92
100 BEEP:PRINT#1,:PRINT "* your turn <enter or @>":PRINT:PRINT#1,
102 GOSUB105:IFK$=CHR$(13)THENPRINT#1,:PRINT:GOTO90
103 IFK$="@"THENPRINT:PRINT#1,:GOTO115
104 GOTO102
105 K$="":TK$="":PRINT"> ";:PRINT#1,"$ ";
107 K$=INPUT$(1):IFK$=CHR$(8)ANDLEN(TK$)>0THENPRINT#1,K$" "K$;:PRINTK$" "K$;:TK$=LEFT$(TK$,(LEN(TK$)-1)):GOTO107
108 TK$=TK$+K$:IFK$=CHR$(13)ORK$="@"THEN112
109 IFLEN(TK$)>28ANDK$=CHR$(32)THEN112
110 PRINT#1,K$;:PRINTK$;:GOTO107
112 PRINT#1,:PRINT:RETURN
115 K$="":TK$="":PRINT#1,:PRINT#1,"* bye "UI$:PRINT#1,"> Please be sure to Log Off":RETURN
120 PRINT#1,:PRINT#1,"! HOST OFF...":GOSUB80:CLOSE:CLS:PRINT"* System off at "TIME$:GOSUB36:MENU
125 BEEP:GOSUB39:PRINT#1,"* WARNING: System Going":PRINT#1,"  DOWN in Two Minutes":PRINT#1,:PRINT"* warning done":RETURN
128 PRINT:PRINT"> User: "UI$:PRINT:RETURN
135 A=0:N=0:Y=0:LC$=UI$:UI$="":ID$="":RC=FRE(""):RC=0:A$(1)=""
137 CLS:FILES:PRINT:PRINT":RESTORE1000:FORX=1TO32:READN$(X),P$(X):NEXT
141 GOSUB39:PRINT#1,"* Welcome to the BBS-100 !!":GOSUB30:PRINT#1,"> Please Log on:":PRINT#1,:PRINT#1,"* if NEW, use NEW as Password":PRINT#1,:PRINT#1,:PRINT#1,"* enter password:"
143 GOSUB147:PRINT#1,:IFJ="NEW"THEN300ELSEFORX=1TO29:IFJ=P$(X)THENUI$=MID$(N$(X),4):X=29:GOTO153
145 NEXTX:Y=Y+1:GOSUB33:PRINT#1,"* access denied --"Y:IFY>2THENPRINT#1,:PRINT#1,"* log-on error ...":GOSUB33:GOSUB80:MM(3)=0:UI$="nle":GOSUB29:GOTO135ELSEGOTO141
147 J="":PRINT#1,:PRINT#1,"> ";:FORZ=1TO3:GOSUB8:PRINT#1,Z;:J=J+K$:NEXTZ:PRINT#1,:RETURN
153 PRINT#1,:PRINT#1,"* Log On: "DAY$" "DATE$"  "LEFT$(TIME$,5):PRINT#1,:PRINT#1,:PRINT#1,"* Welcome, ";UI$;" !!":GOSUB36:GOSUB25:A$(1)=TIME$:PRINT#1,:PRINT#1,"* <Ctrl-S>=Hold  <Ctrl-Q>=Flow":PRINT#1,
155 K$="Main":GOSUB20:GOSUB39:PRINT#1,"* SoftMail-100  EBBS: "DAY$" "LEFT$(TIME$,5):GOSUB32:PRINT#1,"* select first letter":PRINT#1,:PRINT#1,:PRINT#1,"> Chk Get Snd Dwn Tlk Hlp Off ";
157 GOSUB8:Z=INSTR("CGSDTHO@",K$):IFZ=0THEN157ELSEGOSUB39:ONZGOTO160,170,180,200,85,159,65,65
159 EB$="ALL01":GOTO174
160 DE=0:PRINT#1,"* Current Messages:":GOSUB30:PRINT#1,:FORZ!=63930!TO64139STEP11:B$="":IFPEEK(Z!)=0THEN166
162 FORZI=3TO10:B$=B$+CHR$(PEEK(Z!+ZI)):NEXTZI:IFINSTR(B$,"ZDO")<1THEN166
164 IFLEFT$(B$,5)<>"SYSDF"THENPRINT#1,"  "LEFT$(B$,5)"  ";:DE=DE+1:IFDE=3ORDE=6ORDE=9ORDE=12THENPRINT#1,
166 NEXTZ!:IFDE=0THENPRINT#1,"* none"
168 PRINT#1,:PRINT#1,:PRINT#1,"* Mem:"FRE(0)" Str:"FRE(A$)" Mgs:"DE:GOSUB30:PRINT#1,"* Copyright 1984 C. Buchanan":GOTO155
170 PRINT#1,"* Get Mail:":PRINT#1,:PRINT#1,"* enter TITLE or <enter> to abort":PRINT#1,:GOSUB50:IFLEN(TK$)>3THENGOSUB9
171 EB$=LEFT$(TK$,5):IFLEN(EB$)<5THEN155ELSEIFLEFT$(EB$,3)="ALL"THEN174
172 IFLEFT$(EB$,3)<>LEFT$(UI$,3)ANDLEFT$(UI$,3)<>"SYS"THENGOSUB33:PRINT#1,:PRINT#1,"* that's not yours !!":PRINT#1,:PRINT#1,:GOTO170
174 CLOSE4:GOSUB39:PRINT#1,"* now getting "EB$:OPENEB$+"Z.DO"FORINPUTAS3:PRINT#1,:GOSUB32:PRINT#1,
175 IFNOTEOF(3)THENLINEINPUT#3,W:PRINT#1,W:GOSUB35:GOTO175
176 CLOSE3:GOSUB11:GOSUB26:GOSUB32:IFLEFT$(EB$,3)<>"ALL"ANDLEFT$(EB$,3)<>"0:D"THENPRINT#1,:PRINT#1,"* TOSS "EB$" ?":GOSUB17:IFK$="Y"THENCLOSE:KILLEB$+"Z.DO":GOSUB10:PRINT#1,"* deleted":GOSUB28
178 EB$="":GOTO155
180 IFDE<15ANDFRE(0)>1400THENPRINT#1,:PRINT#1,"* Send Mail:":GOSUB196:IFK$="Y"THENRC=0:GOTO184ELSEGOTO155
182 PRINT#1,:PRINT#1,"* sorry, BBS temporarily full":GOTO157
184 PRINT#1,"* review address book ?":GOSUB17:IFK$="Y"THENPRINT#1,:PRINT#1,"* SEND TO:":PRINT#1,:FORX=1TO32:PRINT#1,"  "N$(X):GOSUB35:NEXTX
186 PRINT#1,:PRINT#1,"* elect 1-32:":GOSUB50:RC=VAL(TK$):IFK$="@"THEN155ELSEIFRC<1ORRC>32THEN186ELSEIFRC=31THENRC=0:GOTO184ELSEIFRC=32THENRC=0:GOTO155
188 PRINT#1,"* writing to: ";MID$(N$(RC),4):ID$=MID$(N$(RC),4,3)+MID$(STR$(MN),2):W(1)="* from: "+UI$:W(2)="        "+DAY$+" "+LEFT$(DATE$,5)+" at "+LEFT$(TIME$,5):W(3)=" ":LZ=4:GOSUB40:GOTO205
196 IFID$<>""THENPRINT#1,:PRINT#1,"* CAUTION: Abandon "ID$" ?":GOSUB17:IFK$="N"THENRETURN
198 K$="Y":RETURN
200 IFID$=""ORID$=" "ORID$="Z"ORID$="z"ORA=0THENPRINT#1,:PRINT#1,"* nothing there":GOTO155
205 PRINT#1,:K$="Work":GOSUB20:PRINT#1,:PRINT#1,"* Work Area Message:  "ID$:PRINT#1,"# lines:   ";A:PRINT#1,:PRINT#1, "> Read  Edit  Menu ";
207 GOSUB8:Z=INSTR("REM@",K$):IFZ=0THEN207ELSEPRINT#1,:PRINT#1,:ONZGOTO210,250,220,220
210 PRINT#1,:PRINT#1,:FORX=1TOA:PRINT#1,W(X):GOSUB35:NEXT:GOTO205
220 PRINT#1,"* Send "ID$" ?":GOSUB17:IFK$="Y"THEN222ELSE155
222 PRINT#1,:PRINT#1,"* now sending: ";ID$:OPENID$+"Z"+".DO"FOROUTPUTAS3:FORX=1TOA:PRINT#3,W(X):NEXTX:CLOSE3:MN=MN+1:GOSUB27:PRINT#1,:GOTO155
250 K$="Edit":GOSUB20:IFA>3THEN252ELSEPRINT#1,"* you ruined an eraser...":PRINT#1,"  begin again...":GOTO155
252 PRINT#1,"* select edit line # 4 -"A:GOSUB50:N=VAL(TK$):IFK$="@"THEN205ELSEPRINT#1,:PRINT#1,:IFA<4THEN200ELSEIFN<4 ORN>ATHEN252
254 PRINT#1,:PRINT#1,:PRINT#1,"> "W(N):PRINT#1,"#"N"of"A:PRINT#1,"*":PRINT#1,"? Fw Rv Ed Ad Dl To Qt ";
256 GOSUB8:PRINT#1,:IFK$="F"ANDN<>ATHENN=N+1:GOTO254
258 IFK$="T"THENPRINT#1,"* ";UI$;" to  "MID$(N$(RC),4):GOTO256
260 IFK$="R"ANDN>4THENN=N-1:GOTO254
262 IFK$="Q"ORK$="@"THEN200
264 IFK$="D"ANDN>3THENFORC=NTO(A-1):W(C)=W((C+1)):NEXTC:A=A-1:GOTO294
266 IFK$="A"ANDN<=A AND A<30THENA=A+1:FORC=ATO(N+2) STEP-1:W(C)=W(C-1):NEXTC:PRINT#1,:N=N+1:GOTO290
268 IFK$="E"THENPRINT#1,:PRINT#1,:PRINT#1,"* old";:GOSUB50:O$=TK$:PRINT#1,"> new";:GOSUB50:L1=LEN(O$):GOTO282
276 IFK$="R"ORK$="D"THENPRINT#1,:PRINT#1,"* can't enter masthead":GOTO256
280 GOTO256
282 FORZ=1TOLEN(W(N)):IFO$=MID$(W(N),Z,L1)THENZE=Z-1+L1:RS$=LEFT$(W(N),Z-1)+TK$+RIGHT$(W(N),LEN(W(N))-ZE):W(N)=RS$
284 NEXT:GOTO254
290 PRINT#1,"* input new line":GOSUB30:GOSUB50:W(N)=TK$:GOTO254
294 IFA=3THEN A=0:N=0:ID$="":PRINT#1,:PRINT#1,"* edited away...":GOTO155
296 IFN>ATHEN N=A:GOTO254
298 GOTO254
300 A$(1)=TIME$:UI$="NEW":GOSUB25:PRINT#1,:PRINT#1,"* HELLO !!":PRINT#1,"* you have dialed the BBS-100...":PRINT#1,:PRINT#1,"* to use service please give:":PRINT#1,
302 PRINT#1,"* name: ":GOSUB50:W(2)=TK$:IFLEN(W(2))<3THENPRINT#1,"* please respond ...":GOTO302
304 PRINT#1,"* thanks, ";W(2):PRINT#1,"* please continue ..."
306 PRINT#1,"* address:":GOSUB50:W(3)=TK$:PRINT#1,"* city, state, zip:":GOSUB50:W(4)=TK$:PRINT#1,"* phone: ":GOSUB50:W(5)=TK$
308 W(1)=DATE$+" "+TIME$:ID$="SYS"+MID$(STR$(MN),2)
310 PRINT#1,"* please state how we may":PRINT#1,"  be of assistance...":PRINT#1,:PRINT#1,"* If you intend to call back,":PRINT#1,"  Leave a <3> Letter Password"
311 PRINT#1,"  in Your Message, one that":PRINT#1,"  You will use for Future Access.":PRINT#1,:LZ=6:GOSUB40:PRINT#1,
312 UI$=W(2):PRINT#1,"* thank you for your message,":PRINT#1,"  ";W(2):PRINT#1,:PRINT#1,"* where pertinent, a Response":PRINT#1,"  will be put Online for the":PRINT#1,"  next 48 hours...":PRINT#1,
314 PRINT#1,"* now saving: ";ID$:OPENID$+"Z"+".DO"FOROUTPUTAS3:FORX=1TOA:PRINT#3,W(X):NEXTX:CLOSE3:MN=MN+1:GOSUB27:PRINT#1,:GOTO65
1000 DATA"01 SYSOP",PW1,"02 AAAAAA",PWA,"03 BBBBBB",PWB,"04 CCCCCC",PWC,"05 DDDDDD",PWD,"06 EEEEEE",PWE,"07 FFFFFF",PWF,"08 GGGGGG",PWG,"09 HHHHHH",PWH,10 IIIIII,PWI
1002 DATA11 JJJJJJ,PWJ,12 KKKKKK,PWK,13 LLLLLL,PWL,14 MMMMMM,PWM,15 NNNNNN,PWN,16 OOOOOO,PWO,17 PPPPPP,PWP,18 QQQQQQ,PWQ,19 RRRRRR,PWR,20 SSSSSS,PWS,21 TTTTTT,PWT
1004 DATA 22 UUUUUU,PWU,23 VVVVVV,PWV,24 WWWWWW,PWW,25 XXXXXX,PWX,26 YYYYYY,PWY,27 ZZZZZZ,PWZ,28 C28$$$,PW8,29 C29$$$,PW9,30 ALL the Gang,VFW,31 List Again,VFW,32 Cancel,ZND,ZND,ZND
1008 END