0 'CLUB 100 Library - 415/939-1246 BBS, 937-5039 NEWSLETTER, 932-8856 VOICE 1 ' Greetings! (leave all rem (') lines in please) v. 1200a/pcm 2 ' BBS100 Program 1984 by Chuck Buchanan, Spokane, WA 509-534-2509(10p-6a WKNDS) 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! " 16 PRINT#1,:PRINT#1,:RETURN 17 PRINT#1,:PRINT#1,"* select or "; 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 <@> toQUIT":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 10sec..":FORX=1TO4000:NEXT:GOTO155 88 BEEP:GOSUB33:PRINT#1,:PRINT#1,"* Hello, "UI$" !! This":PRINT "* now in Chatwith "UI$:PRINT:PRINT#1," is SYSOP... You still there ?":PRINT#1, 90 GOSUB33:PRINT#1,"* your entry.. press 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 ":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" awaiting at: "TIME$:PRINT" free memory:"FRE(0):PRINT"last online: "LC$:GOSUB13:PRINT:PRINT"* BUSY !":BEEP:PRINT:PRINT:GOSUB33 139 PRINT"Chat Stop Caut Who?":PRINT:RESTORE1000:FORX=1TO32:READN$(X),P$(X):NEXT 141 GOSUB39:PRINT#1,"* PHOENIX INFO 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,"* =Hold =Flow":PRINT#1, 155 K$="Main":GOSUB20:GOSUB39:PRINT#1,"* INFOMail-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 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 CALLED PHOENIX INFO 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," Leavea <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 S&SOP",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 2000 ' Merge with BBS100.BA for test only keep copy of original program! 2010 ' Changes 'ERROR60' to '60' in lines 8 and 52 of version v 1200a/pcm. 2020 ' 2030 ' 8 IFZD=4500THEN60ELSEPRINT"<";:K$=INPUT$(1):IFK$=CHR$(8)THEN8ELSEZD=0:PRINTK$:IFASC(K$)>96ANDASC(K$)<123THENK$=CHR$(ASC(K$)-32):RETURNELSERETURN 2040 ' 10 GOSUB11:OPEN"lcd:"FOROUTPUTAS1:RETURN 2050 ' 13 PRINT#1,:PRINT#1,"* PRESS ASTERISK <*> TO GO ON":PRINT"<";:K$=INPUT$(1):PRINTK$:IFK$<>"*"THEN13ELSEPRINT#1,"> BRAVO! " 2060 ' 52 IFZD=4500THEN60ELSEK$=INPUT$(1):ZD=0:IFK$=CHR$(8)ANDLEN(TK$)>0THENPRINT#1,K$" "K$;:PRINTK$" "K$;:TK$=LEFT$(TK$,(LEN(TK$)-1)):GOTO52