1 Fast :Set 5,1:Set 12,1:Set 15,1:Poke 82,0:Rem Version 5.4x 11/30/92
2 O=0:I=1:C2=I+I:C3=C2+I:C4=C3+I:C5=C4+I:C6=C5+I:C7=C6+I:C8=C7+I:C10=C8+C2:C12=C10+C2:C14=C12+C2:C16=C14+C2
3 C17=C14+C3:C20=C17+C3:C32=C16+C16:C50=C10*C5:C64=C32*C2:C128=C64*C2:C256=C128*C2
4 Ccon=O:Reply=100:Om=400:Clm=500:Ma=3000:Etr=6900:Goto 32000
10 Trap 11:If Pw$(C32+C6,C32+C6)=Cr$:? ;Cr$;:Trap Etr:Return :Endif 
11 Trap Etr:? ;"";:Return 
30 Rem All mod line numbers in here  
31 Rem Birthday (1100),,Pause (1900) 10/02/90, New Prompt (3040) 02/13/91
32 Rem 10/31/90 -Survey mod (2300)
33 Rem 2/4/91 - Added # to commands for Adults only (3095)
34 Rem 02/17/91 - added HELP file section at (3700),(3070,3100,3160)
35 Rem 
36 Rem 
37 Rem 
38 Rem 
39 Rem 
40 Rem 
100 Rem     Get reply with caps      
110 Gosub 300:Goto 700
200 Rem      Get One Character       
205 Poke 77,O:L=O
207 X=Usr(1591,C10*C20*C3)
210 X=Peek(53279):If X<>C7 Then Goto 6000
215 If Peek(764)<>255:Get #C5,X:Goto 250:Endif :If Sy Then Goto 210
220 Status #C2,X:If Peek(747) Then Get #C2,X:Goto 250
225 If Peek(556):Goto 210:Endif :Gosub 400:L=L+I:If L>C8:Goto 230:Endif :Goto 207
230 If L=C12:If Bpar(C14+I):Bpar(C14+I)=C3:Endif :Goto 31000:Endif 
235 ? Cr$;"Auto Logoff in ";(C12-L)*C10;" seconds":Goto 207
250 If Bpar(C16) And X<>155:X=X&127:If X>96 And X<123:X=X-C32:Endif :Endif :X$=Chr$(X):Return 
300 Rem        Input 1 Line          
301 Call "RESET_COLOR"
305 L$="":Poke 766,O
310 Gosub 200:If X=155 Then ? :Return 
330 If (X<27 And X<>C8 And X<>24) Or (X>C128 And X<155) Then Goto 310
335 If ((X=C8 Or X=126) Or (X=127 And  Not At)) And L$>"" Then ? ;" ";:L$(Len(L$))="":Goto 310
340 If (X=156 Or X=24) And L$>"" Then For X=I To Len(L$):? ;" ";:Next X:Goto 305
345 If X$<>"":L$=L$,X$:Endif :If Len(L$)=Zll Then Return 
355 If X=C3 Then Goto Ma
360 If Pw$="" And X$<>"":? ;"*";:Else :? ;X$;:Endif 
370 If Len(L$)=Bpar(C17):Return :Endif :Goto 310
400 Rem         Open Modem           
415 If Spc:Return :Endif :If  Not Sy Then 435
430 Trap Etr:Return 
435 Gosub Clm:Xio 36,#C2,Baud,O,"R:":Xio 34,#C2,240,O,"R:"
455 Open #C2,13,O,"R:":Poke 1551,At+Lf:Xio 38,#C2,At+Lf,O,"R:"
460 If  Not Wr2:Status #C2,X:If (Peek(747)&C12)=O Then 6950
465 Endif :Xio 40,#C2,O,O,"R:":Trap Etr:Return 
500 Rem         Close Modem          
510 If Sy Then Return 
530 Trap 530:Close #C2:If Peek(864)<>255:Goto 530:Endif :Trap Etr:Return 
600 Rem    Calculate value of IDX$   
610 Y=Asc(Idx$(Bbs;C3))*65536+Asc(Idx$(Bbs;C2))*C256+Asc(Idx$(Bbs;I)):Return 
700 Rem  CAPS - Insure reply is caps 
705 Gosub 709:Return 
709 Local Y
710 If L$>"":For Y=I To Len(L$):X=Asc(L$(Y))&127:If X>96 And X<123:L$(Y,Y)=Chr$(X-C32):Endif 
720   Next Y:Endif :Exit 
800 Rem      Save Config File        
810 A$=F$:F$="D1:CONFIG.DAT":Gosub 6500:Close #I:Open #I,C8,O,F$:F$=A$
820 ? #I;Nbbs;Cr$;Bpar(C4);Cr$;Bpar(C5):For X=I To Nbbs:? #I;Bbna$(X*C16-15,X*C16):Next X
830 For X=O To 27:? #I;Hz(X):Next X:For X=I To 28:Bput #I,Adr(Idx$(X;)),C3:Next X
840 For X=O To 111:? #I;Optn(X):Next X:Close #I:Return 
900 Rem      Update SysOp Screen     
910 If Out$>"":Y=Usr(1598,Adr(Out$),Dpeek(1539)-I+X,Len(Out$)):Endif :Return 
1000 Rem  Get Current Time and Date  
1010 Close #C7:Open #C7,C4,O,"Z:":Xio 35,#C7,O,O,"Z:":Td$="00/00/00"
1020 Get #C7,X:Td$(C4+(X<C10),C5)=Str$(X)
1025 Get #C7,X:Td$(I+(X<C10),C2)=Str$(X)
1030 Get #C7,X:Td$(C7+(X<C10),C8)=Str$(X)
1035 Xio 33,#C7,O,O,"Z:":Ti$=" 0:00 AM":Get #C7,X:Poke 706,X:If X>11 Then Ti$(C7)="PM"
1040 If X>C12 Then X=X-C12
1045 Ti$(I+(X<C10),C2)=Str$(X):If  Not X Then Ti$(I,C2)="12"
1050 Get #C7,X:Ti$(C4+(X<C10),C5)=Str$(X):Close #C7:Return 
1100 Rem    Birthday announcements   
1110 Close #I:Trap 1150:Open #I,C4,O,"Z:":Xio 35,#I,O,O,"Z:":Get #I,Wk1:Get #I,Wk2:Close #I
1120 Trap 1140:Z$="D1:BIRTHDAY>MONTH",Str$(Wk2),">DAY",Str$(Wk1):Open #I,C4,O,Z$
1125 Call "COLOR" Using 33,5,1:? Cr$;"Happy birthday to the following users:":Rem 02/21/91 -blinking text
1130 Trap 1150:Input #I,L$:? L$:Call "RESET_COLOR":Goto 1130
1140 ? Cr$;"No Birthday Wishes for Today"
1150 Close #I:Trap Etr:Return 
1160 Rem This mod courtesy of Len Spencer at Moonbase Alpha in Orlando, Florida (407)578-2811
1200 Rem        F-net Receiver       
1205 Gosub Clm:Close #I:Close #C3:Close #C5
1210 Poke 1549,I:Poke 1582,Baud:X=Usr(1557,I):Run "D1:FNETRECV"
1220 Set 15,I:Pop :Pop :Pop :Pop 
1230 Gosub 1600:Wr2=I:Gosub 1400:Gosub 9400:L$="G;Y":Goto 31000
1300 Rem         F-net Caller        
1310 Gosub Clm:Close #I:Close #C3:Close #C5
1320 Poke 1549,I:X=Usr(1557,I):Run "D1:FNETSEND"
1330 Set 15,I:Pop :Pop :Pop :Pop 
1340 Gosub 1600:Gosub 1400
1350 If Peek(1590)=C5 Or Peek(1590)=O
1360   Poke 1590,O:Gosub 9400:Endif :Goto 31000
1400 Rem      Read Config File       
1410 Close #I:Open #I,C4,O,"D:CONFIG.DAT":Input #I,Nbbs:Trap 1420:Dim Bbna$(Nbbs*16)
1420 Trap 1430:Input #I,Bpar(C4),Bpar(C5):Bpar(C5)=O
1430 Trap 1470:For X=I To Nbbs:Input #I,Bbna$(X*C16-15,X*C16):Next X
1440 For X=O To 27:Input #I,Hz(X):Next X
1450 For X=I To 28:Idx$(X;)="":Bget #I,Adr(Idx$(X;)),C3:Next X
1460 For X=O To 111:Input #I,Optn(X)
1470   Trap Etr:Next X:Close #I:Return 
1500 Rem      F-net Packet Prep      
1510 Gosub Clm:Close #I:Close #C3:Close #C5
1520 Poke 1549,I:X=Usr(1557,I):Run "D1:FNETPREP"
1530 Set 15,I:Pop :Pop :Pop :Pop 
1540 Gosub 1600:Bpar(11)=O:Goto 31000
1600 Rem      Return from AMP        
1610 Gosub Clm:Close #I:Close #C3:Close #C5
1620 If Bpar(C8):Open #C3,9,O,"D1:USRLOG.DAT":Else :Open #C3,C8,O,"P:":Endif 
1630 Open #C5,C4,O,"K:"
1640 Poke 1549,O
1650 Return 
1700 Rem         F-net Post          
1710 Gosub Clm:Close #I:Close #C3:Close #C5
1720 Poke 1549,I:X=Usr(1557,I):Run "D1:FNETPOST"
1730 Set 15,I:Pop :Pop :Pop :Pop 
1740 Gosub 1600:Bpar(11)=O:Goto 31000
1745 Rem Final Frontier BBS Mod
1750 Rem        Emulate Routine      
1752 ? Cr$;Cr$;"Terminal Emulation";Cr$;Cr$;"[0] - Atari";Cr$;"[1] - Ascii";Cr$;"[2] - Ansi";Cr$;"[3] - VT52";
1755 ? ;Cr$;Cr$;" Select--> ";
1758 Gosub 200:Trap 1755:If X$="":Ansi=I:Goto 1762:Endif :Ansi=Val(X$(I,I))
1760 If Ansi=O Then At=C32:Par(79)=O:Out$="Atari Mode"
1762 If Ansi=I Then At=O:Par(79)=I:Out$="Ascii Mode":Poke 9832,C32
1764 If Ansi=C2 Then At=O:Par(79)=I:Out$="Ansi Mode":Poke 9832,27
1766 If Ansi=C3 Then At=O:Par(79)=I:Out$="VT-52 Mode":Poke 9832,27
1768 If Ansi>C3 Or Ansi<O Then 1755
1769 Poke 1024,Ansi:? ;Out$:Out$(C6)="":X=73:Goto 900
1770 Rem     Send Graphic Screens    
1775 If Ansi=O Then F$(Len(F$)-C2,Len(F$))="ATA":Gosub 7000:Return 
1780 If Ansi=I Then F$(Len(F$)-C2,Len(F$))="ASC":Gosub 7000:Return 
1785 If Ansi=C2:F$(Len(F$)-C2,Len(F$))="ANS"
1786   Poke 1551,C32+Lf:At=C32:Gosub 6600:Gosub 7020:Poke 1551,Lf:At=O:Return :Endif 
1788 If Ansi=C3:F$(Len(F$)-C2,Len(F$))="V52"
1789   Poke 1551,C32+Lf:At=C32:Gosub 6600:Gosub 7020:Poke 1551,Lf:At=O:Return :Endif 
1792 Return 
1800 Rem COLOR PROCEDURE
1805 Procedure "COLOR" Using Colr,Bright,Vt52
1810   If Ansi<C2 Then Exit 
1815 If Ansi<C3 Then ? "[";Bright;";";Colr;"m";:Exit 
1820 ? "b";Vt52;
1825 Exit 
1830 Exit 
1840 Rem RESET COLOR
1845 Procedure "RESET_COLOR"
1850   On Ansi+I Goto 1855,1860,1865,1870,1870
1855 Exit 
1860 Exit 
1865 ? "[0m";:Exit 
1870 ? "b3";"c4";
1875 Exit 
1880 Rem Msg Base COLOR
1885 Procedure "MSG_COLOR" Using Colr,Bright,Vt52
1887   If Ansi<C2 Then Exit 
1889 If Ansi<C3 Then Z$=Z$,"[",Str$(Bright),";",Str$(Colr),"m":Exit 
1891 Z$=Z$,"b",Str$(Vt52)
1893 Exit 
1897 Rem The above mods courtesy of Clyde from the Final Frontier in Philadelphia Pennsylvania (215)624-6347
1900 Rem        Pause routine        
1905 Call "COLOR" Using 32,1,2:? ;Cr$;"Press any key to continue":Gosub 200:Call "RESET_COLOR":Return 
2000 Rem    <C>rewmember Listing     
2001 F$="D1:NAMES.DAT":Gosub 6600:Any=Zll
2002 For X=I To Len(M$) Step Zll:If X+Zll>Len(M$):Pop :Goto 2006:Endif :M$(Any,Any)=Chr$(155)
2003   Any=Any+Zll
2004 Next X
2006 Gosub 9300:Goto Ma
2099 Rem     Print Saved Password    
2100 Gosub Clm:? #C3;"Saved Password":Return 
2150 Rem     Run FNETCNTL from $     
2160 X=Usr(1557,I):Run "D:FNETCNTL":Rem PATHNAME
2170 Set 15,I:Pop :Pop :Pop :Pop 
2175 Gosub 32310
2180 Gosub 1600:Gosub 400:Gosub C10
2190 Goto Ma
2195 Rem This mod courtesy of The Final           Frontier BBS (215)624-6347
2200 Rem      Run SIGUTIL from $     
2210 X=Usr(1557,I):Run "D:SIGUTIL.BXE"
2220 Set 15,I:Pop :Pop :Pop :Pop 
2230 Gosub 1600:Gosub 400:Gosub C10
2240 Goto Ma
2245 Rem This mod courtesy of The Final           Frontier BBS (215)624-6347
2250 Rem        Toggle E-mail        
2260 Optn(112)= Not Optn(112)
2270 ? "Sysop mail going to ";:If  Not Optn(112):? "Printer/Log":Else :? "Email":Endif 
2280 Goto Ma
2290 Rem      New User Leave Email   
2292 ? "Please Leave a note to the SysOp"
2293 Trap Etr:Gosub 1000:Gosub 5600:Gosub 5500:Gosub 5000:F$="":Par(81)=O
2294 Bpar(C20)=O:Dl=O:Bf=O:Email=O:Par(9)=Asc(Pw$(C50+I))&C2:Par(19)=O:Par(36)=O:Par(71)=O:Par(78)=O:Bpar(34)=O:Pm=O
2295 Poke 1551,At+Lf:Poke 1550,Ccon:Poke 766,O:If Ansi=C2 Then ? "[0m[1;33m"
2296 Bpar(C16)=I:Bpar(C17)=I:Zll=Asc(Pw$(37)):Bpar(C17)=Zll
2297 Gosub 3600:Gosub 1000:Gosub 5600:Gosub 5500:Gosub 5000:F$="":Return 
2298 Rem The above mods are courtesy of Clyde at the Final Frontier (215)624-6347
2600 Rem    Edit Game Control File   
2610 F$="D1:ONLINE1.DAT":Gosub 6600
2620 ? Pw$(38,38):For Any=I To Int(Len(M$)/31)
2630   ? Any;" ";M$((Any-I)*31+I,(Any-I)*31+31)
2640 Next Any
2650 ? Cr$;Cr$;" # TO CHANGE OR ENTER TO EXIT-A TO ADD "
2660 Gosub Reply:If L$=""
2670   Close #1:Open #1,8,0,"D1:ONLINE1.DAT":? #1;M$;:Close #1
2675   Goto Ma
2678 Endif :If L$="A" Or L$="a":? "Enter ":? Any;" ";:Gosub Reply:While Len(L$)<31:L$=L$," ":Endwhile :M$=M$,L$(I,31)
2679   Goto 2620:Endif 
2680 Trap 2650:Any=Val(L$):Trap Etr
2690 ? M$((Any-I)*31+I,(Any-I)*31+31)
2695 ? "1........1.........2.........31";Cr$:Gosub Reply
2697 While Len(L$)<31:L$=L$," ":Endwhile :M$((Any-I)*31+I,(Any-I)*31+31)=L$
2698 Goto 2620
2699 Rem This mod courtesy of Clyde at The Final Frontier (215)624-6347
3000 Rem   Entry for Main Processing 
3010 Trap Etr:Pop :Pop :Pop :Pop :Gosub 1000:Gosub 5600:Gosub 5500:Gosub 5000:F$=""
3020 Bpar(C20)=O:Dl=O:Bf=O:Email=O:Par(9)=Asc(Pw$(C50+I))&C2:Par(19)=O:Par(36)=O:Par(71)=O:Par(78)=O:Bpar(34)=O:Pm=O
3025 Par(81)=O
3030 Poke 1551,At+Lf:Poke 1550,Ccon:Poke 766,O:Call "COLOR" Using 33,I,I
3031 If Ansi<4:? Cr$;:Endif :? "Main=> ";:Goto 3060
3040 Rem 
3050 Call "COLOR" Using 32,I,I:? ;Cr$;Cr$;"(ABDEFGHILMOPQRTUXYZ*+)";Cr$;"(?=Menu) Main=> ";
3060 Bpar(C16)=I:Bpar(C17)=I:Gosub 300:Zll=Asc(Pw$(37)):Bpar(C17)=Zll
3070 If Find("ZG*H",L$,O):Gosub 310:Endif :X$=L$:Bpar(C16)=O
3080 If Pw>C4:Xm=Find("IM+",X$,O):If Xm:Gosub 310:X$=L$:Gosub 8000:On Xm Goto 13100,2000,7300:Endif :Endif 
3090 Xm=Find("TQXVBH",X$,O):If Xm:Gosub 8000:On Xm Gosub 5200,18020,24500,15000,5300,3700:Goto Ma:Endif 
3100 Xm=Find("?*AYLDUFRE+GZP$O",X$,O):Y=Xm:M=O:If  Not Xm Then Goto 3040
3110 While Y>C8:Y=Y-C8:M=M+I:Endwhile 
3120 If  Not (Int(C2^(Y-I)+0.5)&Asc(Pw$(C50+C2-M))):? ;Cr$;"Priviledge not authorized":Goto Ma:Endif 
3140 Gosub 8000:Gosub C10
3150 If Xm=I:F$=Cfile$(C4;),"FUNCTION.XXX":Gosub 1770:Goto Ma:Endif 
3160 On Xm-I Gosub 7500,1750,12000,3600,25000,26000,25000,19000,18000,7300,31000,18120,24000,17000,14000:Goto Ma
3600 ? ;Cr$;E$(Cst(C2,O),Cst(C2,I)):If Optn(112):Goto 3610:Endif :Pm=I:Zll=C20*C4:Goto 21330
3610 Email=C3:Par(81)=I:If Bbs<27:Par(C5)=Bbs:Bbs=C20+C7:Endif :Gosub 8100:Goto 19040
3700 Rem  FUNCTION <H> - HELP FILES  
3710 Gosub C10:Out$="ABDEFGHILMOPQRTUVXYZ+*?"
3720 If Len(L$)>C2 Then L$=L$(C3):Goto 3750
3730 ? " Help with what command ? ";Cr$;Out$;:Gosub Reply
3740 If Len(L$)=O Then Goto Ma
3750 Trap Ma:X=Find(Out$,L$(I,I),O):If  Not X Then ? "Function not implemented.":Goto Ma
3760 F$="D1:HELP>","HELP",Str$(X):Gosub 7050:Goto Ma
5000 Rem       Display Stats         
5010 If Len(Pw$)<48:Return :Endif 
5030 Upar(O)=(Int(1000*(I+Upar(I)+25*Asc(Pw$(48)))/(I+Upar(C2))))/1000
5040 If Upar(O)>9.999:Upar(O)=9.999:Endif :If Upar(O)<0.01:Upar(O)=0.01:Endif 
5050 Out$=Str$(Upar(I)),"     ":Out$=Out$(I,C6):X=84:Gosub 900
5060 Out$=Str$(Upar(C2)),"     ":Out$=Out$(I,C6):X=93:Gosub 900
5070 Out$=Str$(Asc(Pw$(48))),"   ":Out$=Out$(I,C4):X=102:Gosub 900
5080 Out$=Str$(Upar(O)),"    ":Out$=Out$(I,C5):X=116:Goto 900
5200 Rem        Display Time         
5210 Gosub 7600:Y=Y-Par(C64):T=Int(Y/60):Xm=Peek(1536):Edit$="---# "
5220 ? Cr$;"Connected     : ";:?  Using Edit$,T;:? ;"minutes"
5240 ? "Time remaining: ";:?  Using Edit$,Xm-T;:? ;"minutes":Return 
5300 Rem         Function [B]        
5305 Call "COLOR" Using 36,1,2
5310 F$=Cfile$(C4;),"BULLETIN":If Pw<C5:F$=Cfile$(C4;),"BULLITLO":Endif :Gosub 7050:Call "RESET_COLOR":Return 
5400 Rem   Search Drives for File    
5410 Se=O:For X=I To Optn(O):F$(C2,C2)=Str$(X):Ll$=F$(I,C3):Trap 5417
5415   Close #I:Open #I,C4,O,F$:Se=I:Trap Etr:Pop :Return 
5417 Next X
5420 Gosub Clm:? #3;F$;" Not found":Gosub Om
5445 Return 
5500 Rem    Update Time Remaining    
5510 Gosub 7600:Y=Y-Par(C64):T=Int(Y/60):Xm=Peek(1536)
5512 Edit$="00",Str$(Xm-T):Out$="/",Right$(Edit$,C3):X=C64:Gosub 900
5515 If Len(Pw$)<53:Return :Endif :If Asc(Pw$(53))&C2 Then 5525
5520 If T<Xm-C6 Then Return 
5525 Gosub 5200:If Xm<=T And Pw<>25 Then Bpar(C14+I)=C2:Goto 31000
5535 Return 
5600 Rem   Save Message Index File   
5610 Close #I:If Par(11):F$=Mif$:Open #I,C8,O,F$
5620   If Len(M$)>O:Bput #I,Adr(M$),Len(M$):Endif :Close #I:Par(11)=O:Endif :Return 
5700 Rem     Auto Switch Msg Base    
5710 If Bbs<>Par(C5):Z$=Str$(Par(C5)),";",X$:If Len(L$)>C2 Then Z$=Z$,L$(C2)
5720   L$=Z$:Pop :Goto 18250:Endif :Return 
5800 Rem     Pack Message Base(s)    
5805 If Mflag:Gosub 7600:Par(65)=Y:Gosub 5820:Gosub 7600:Par(C64)=Par(C64)+Y-Par(65):Return :Endif 
5810 Bpar(C5)=O:For Bbs=I To Nbbs:Gosub 5820:Next Bbs:Bbs=C20+C7:Gosub 5820:Mflag=I:Return 
5820 Spc=I:Gosub 8100:Spc=O:If Mflag=I Then For X=I To Optn(39+Bbs):Gosub 5900:Next X
5825 ? #C3;"Packing: ";Bbs:Idx$(Bbs;)="":If Len(M$)<C7 Then Goto 800
5835 M=Int(Len(M$)/C7):For X=I To M:Y=Usr(1576,C6,Adr(M$)+C7*X-C3)
5846   Wk1=Dpeek(Adr(M$)+C7*X-C5):Msg$(Wk1)=" ":Bget #C6,Adr(Msg$),Wk1
5855   Y=Usr(1576,C6,Adr(Idx$(Bbs;))):Bput #C6,Adr(Msg$),Wk1:M$(C7*X-C2,C7*X)=Idx$(Bbs;)
5870   Y=Usr(1573,C6,Adr(Idx$(Bbs;))):Next X
5875 If  Not Mflag Then Bpar(C5)=Bpar(C5)+M
5880 Close #I:Open #I,C8,O,Mif$:? #I;M$;:Gosub 7700:Goto 800
5900 Rem    Delete Oldest Message    
5910 M$=M$(C8):Bpar(C5)=Bpar(C5)-I:Xm=Xm-I:Am=Am-I:Return 
6000 Rem     <Select> Functions      
6002 If X=C3:If Peek(1596)=I:Poke 1596,C5:Dpoke 560,Dpeek(1537)
6004   Else :Poke 1596,I:Dpoke 560,Dpeek(1594):Endif :For X=I To C256*C2:Next X:Goto 200:Endif 
6005 If Peek(53279)=C7:? #C3;"===> Auto Chat <===":Goto 200:Endif 
6007 For X=I To C256*C2:Next X:If Peek(53279)=C7 Then Goto 200
6009 Poke 1550,O:? ;Cr$;Cr$;"  Chat  Hang-up  Time  Mask  Blacklist";Cr$:Input X$
6010 X=Asc(X$):If X>96 And X<123 Then X$=Chr$(X-C32)
6015 X=Find("CHTMB",X$,0):On X Goto 6060,6070,6025,6030,30000
6020 Poke 1550,Ccon:Goto 200
6025 ? "Time: ";:Input X:Poke C256*C6,X:Goto 6020
6030 Gosub 6032:Gosub Om:Goto 6020
6032 ? "Mask #: ";:Input F
6035 Close #C7:Open #C7,C4,O,"D:VALIDATE.DAT":D$(C8+I)=" "
6040 Input #C7,X:If X<F Then Goto 6032
6050 For X=I To F:Bget #C7,Adr(D$),C8+I:Next X:Pw$(49,56)=D$:Pw=Asc(D$):Return 
6060 Poke 1550,Ccon:Goto 12080
6070 Poke 1550,Ccon:Bpar(C14+I)=C2:Goto 31000
6100 Rem      Yes/No Selection       
6110 Gosub 200:If X$="Y" Or X$="y" Then ? ;"Yes":Return 
6120 ? ;"No":X=O:Return 
6200 Rem      Print USRLOG.DAT       
6210 Cfile$(I;)="D1:USRLOG.DAT":Cfile$(C2;)="P:":Goto 8900
6300 Rem      "Your choice is"       
6310 ? Cr$;"Your choice is ";:Gosub Reply:Return 
6400 Rem      Terminal Settings      
6410 ? Cr$;"Do you require Line feeds? (Y/N) ";:Gosub 6100:Lf=C64*(X>O)
6415 Gosub Om:If Usg$="" Then Return 
6420 If At And Usg$="" Then Zll=40:X$="":Goto 6490
6425 ? Cr$;"Max line length  20-80 [default=40]: ";:Gosub 300
6430 Trap 6485:Zll=40:Zll=Val(L$)
6485 X$=""
6490 Trap Etr:Pw$(37,37)=Chr$(Zll):Pw$(38,38)=X$:Return 
6500 Rem      Display File Read      
6510 Out$=F$:X=Find(Out$,".",O):If X:Out$(X)="":Endif 
6520 X=Find(Out$,":",O):If X:Out$=Out$(X+I):Endif 
6530 X=Find(Out$,">",O):If X:Out$=Out$(X+I):Endif 
6540 Out$=Out$,"        ":Out$(C8+I)="":X=153:Goto 900
6600 Rem    RF - Read File Routine   
6610 Gosub 6500:Bf=I:Close #I:Open #I,C4,O,F$
6620 Trap 6640:M$(B)=" ":Bget #I,Adr(M$),B
6630 X=Dpeek(856):If X<B:M$(X+I)="":Endif :Goto Om
6640 Trap Etr:If Err(O)=136 Then Bf=O:Goto 6630
6650 If Err(O)=144:? #C3;"ERROR 144 - ",F$:Goto 6630:Endif :Goto Etr
6700 Rem          Send Z$            
6705 Summ=I
6710 If  Not Summ Then Gosub C10
6720 Poke 1549,I:X=O:? ;Z$:Poke 1549,O:Return 
6800 Rem          Send M$            
6805 Summ=I
6810 If  Not Summ Then Gosub C10
6820 Poke 1549,I:X=O:? ;M$;:Poke 1549,O:Return 
6900 Rem      ETR - Error Trap       
6910 Trap Etr:Close #C2:Wk1=Err(O):Wk2=Err(I):Poke 1549,O
6915 If Wk1=177:X=C3:Return :Endif :If Wk1=178:X=C14:Return :Endif 
6920 If Wk1=C128+C12 Then Goto 6960
6930 If Wk1=C17*C10 Or Wk1=C128+C32+C7:? ;Cr$;"File not found...":? #C3;"Couldn't find... ";F$
6935   If Par(71)<>O:Pop :Return :Endif :Goto 6980:Endif 
6940 If Wk1<>154 And Wk1<>139 Then 6970
6950 If  Not Wr2:Gosub 1000:? #C3;Cr$;"Hung up at ";Ti$:If Usg$>"":? #C3;Usg$:Endif :Endif 
6960 If Bpar(C14+I):Bpar(C14+I)=C4:Endif :Goto 31000
6970 Bpar(C7)=Bpar(C7)+I:Print #C3;Cr$;"Error-";Wk1;" LINE # ";Wk2;Cr$
6980 If Len(Pw$)<124:Goto 31000:Endif :Gosub Om:Goto Ma
7000 Rem       SF - Send File        
7010 Gosub C10:Gosub 6600
7020 If Par(78):Gosub 9300:Else :Gosub 6800:Endif :If X=C3 Then Return 
7030 If Bf Then Gosub 6620:If Ww:Goto 7060:Else :Goto 7020:Endif 
7040 Ww=O:Return 
7050 Ww=I:Gosub 6600:Trap 7070
7060 M$(Len(M$)+1)=Chr$(255):X=Usr(1541,Adr(M$),Zll):M$(Len(M$))=""
7070 Trap Etr:Goto 7020
7100 Rem        One Moment...        
7110 Restore :For Any=I To Random(I,C20-C2):Read Moment$:Next Any
7112 ? Cr$;Moment$;" ";Nick$:Gosub Clm:Return 
7120 Data "Lemme check...","One minute...","Wait a sec...","Don't move...","Stand by...","Hang loose..."
7122 Data "Working on it...","Searching...","Checking...","Please hold..."
7124 Data "Searching Data Banks...","Patience is a virtue...","Hang in there..."
7126 Data "Relax...","Chill out...","Be right back...","Take it easy...","Slow, isn't it?..."
7300 Rem        Function [+]         
7310 ? ;Cr$;"Loading BBS List...":Gosub Clm:Close #I:Close #C3:Close #C4:Close #C5
7330 Poke 1549,O:X=Usr(1557,I):Run "D1:BBS.BAS"
7340 Set 15,I:Pop :Pop :Pop :Pop :Gosub 1600:Gosub 400:? "":Goto Ma
7350 Rem This mod courtesy of Lee Dillon from Boss Board in Houston Texas (713)479-1967
7400 Rem     Switch Console Log      
7410 Bpar(C8)=I-Bpar(C8):Poke 1589,Bpar(C8):Close #C3
7420 If Bpar(C8):Open #C3,9,O,"D1:USRLOG.DAT":Else :Open #C3,C8,O,"P:":Endif :Return 
7500 Rem    Function [*] Data Base   
7505 Hold$=L$:Par(78)=O:If Par(77)>O:? ;Cr$;"Page break ? ";:Gosub 6100:If X:Par(78)=I:Endif :Endif 
7510 L$=Hold$:Bf=O:If Len(L$)>C2 Then L$=L$(C3):Goto 7540
7520 Dl=O:M$=E$(Par(21),Par(22)-I)
7530 Gosub 7020:Gosub 6300
7535 If Len(L$)=O Then Goto Ma
7540 Trap Ma:X=Val(L$):Ll$=Str$(X)
7550 F$="D1:DATABASE>DBFIL",Ll$:Bpar(C14)=I:Gosub 5400:Bpar(C14)=O
7555 If L$(Len(L$))="D" Then Gosub 6600:Goto 7530
7560 Gosub 7050:? Cr$;"<Cr> to continue ";:Gosub Reply:Goto 7520
7600 Rem      Obtain Timer Value     
7610 Y=Int((Peek(18)*65536+Peek(19)*C256+Peek(C20))/(60)):Return 
7700 Rem   Display Message Counters  
7710 Out$=Str$(Bpar(C5)),"-",Str$(Bpar(C3)),"     ":Out$=Out$(I,C8):X=193:Goto 900
7800 Rem        Format Date          
7810 D$="00/00/00":T=Asc(Pw$(X)):D$(I+(T<C10),C2)=Str$(T)
7820 T=Asc(Pw$(X+I)):D$(C4+(T<C10),C5)=Str$(T)
7830 D$(C7)=Str$(Asc(Pw$(X+C2))):Gosub 8400:Return 
7900 Rem       Place Date in PW$     
7910 Pw$(X,X)=Chr$(Val(Td$)):Pw$(X+I,X+I)=Chr$(Val(Td$(C4))):Pw$(X+C2,X+C2)=Chr$(Val(Td$(C7)))
7920 Return 
8000 Rem    Update USG$ - User Log   
8010 If Len(Usg$)>17 Then For Y=O To 18:Poke Dpeek(1539)+123+Y,O:Next Y:? #C3;Usg$:Usg$=""
8020 Usg$=Usg$,X$:Out$=Usg$:X=124:Goto 900
8100 Rem   Read Message Index File   
8110 If Bbs=C20+C7:Mif$="D1:EMAIL.ISM":Mdf$="D1:EMAIL.DAT":Goto 8140:Endif 
8120 X$=Chr$(Bbs+C64):Mif$="D1:BASES>MESSAGE.IS",X$:Mdf$="D1:BASES>MESSAGE.DA",X$
8130 X$=Ms$(Bbs):Mif$(C2,C2)=X$:Mdf$(C2,C2)=X$
8140 Close #C6:Open #C6,C12,O,Mdf$
8150 F$=Mif$:Gosub 6600:Am=Int(Len(M$)/C7):Return 
8200 Rem    Determine Free Sectors   
8210 Close #I:L$=" "
8220 Trap Etr:Sec=O:Close #I:Open #I,C6,C128,A$
8230 Trap 8230:Input #I,L$:Sec=Int(Val(L$)*(Optn(Val(A$(C2))))):Trap Etr:If A$(C2,C2)="1" Then Sec=Sec-C32
8240 Return 
8300 Rem      Open Password File     
8310 A$=F$:F$="D1:PAS.DAT":Gosub 6500:Close #I:Open #I,C12,O,F$:F$=A$:Return 
8400 Rem    Format Date Long Form    
8410 M=Val(D$):Out$=Mt$(M*C3-2,M*C3)
8420 Out$=Out$," ",D$(C4,C5),",19",D$(C7):D$=Out$:Return 
8500 Rem     Get Message Record      
8515 Par(62)=Dpeek(Adr(M$)+(C7*F)-C5):Msg$(Par(62))=" ":Bget #C6,Adr(Msg$),Par(62)
8520 Mn=Dpeek(Adr(Msg$)):Tcl$=Msg$(40):From$=Msg$(60):X=Asc(Msg$(C5))
8525 Subj$=Msg$(80):D$=Msg$(110,117):Ti$=Msg$(118,125):Li=Asc(Msg$(126)):Return 
8800 Rem  Multi-File Copy Routine 
8810 For Wk4=Len(Cfile$(I;)) To I Step -I:If Cfile$(I;Wk4,Wk4)=">" Or Cfile$(I;Wk4,Wk4)=":":Wk4=Wk4+I:Pop :Goto 8820
8815   Endif :Next Wk4:? "Invalid source filemask!":Return 
8820 Wk5=Len(Cfile$(C2;)):If Cfile$(C2;Wk5)<>":" And Cfile$(C2;Wk5)<>">" Then ? "Invalid destination path!":Return 
8830 Open #C7,C6,128,Cfile$(I;)
8840 Input #C7,L$:Trap 8840:If Find(L$,"FREE SECT",O) Then Close #C7:Cfile$(C2;Wk5+1)="":Return 
8850 If (L$(35)<>"a" And L$(35)<>"p") Or L$(15,17)="DIR" Then 8840
8860 Cfile$(I;Wk4)=L$(I,C8):For Wk3=Wk4 To Wk4+C7:If Cfile$(I;Wk3,Wk3)=" " Then Pop :Goto 8870
8865 Next Wk3
8870 Cfile$(I;Wk3)=".",L$(C10,C12):Wk3=Dpeek(C10)+19:Poke Wk3,Val(L$(24,25)):Poke Wk3+I,Val(L$(21,22))
8871 Poke Wk3+C2,Val(L$(27,28)):Poke Wk3+C4,Val(L$(33,34)):Y=Val(L$(30,31)):If L$(35)="p" Then Y=Y+C12
8872 Poke Wk3+C3,Y
8880 Cfile$(C2;Wk5+I)=Cfile$(I;Wk4)
8890 ? "Copying: ";Cfile$(I;);"...";:Wk3=Dpeek(10)+25:Poke Wk3,255:Gosub 8900:? "Done!":Goto 8840
8900 Rem     File Move processing    
8910 Bf=I:Close #I:Close #C6:Open #I,C4,O,Cfile$(I;):Open #C6,C8,O,Cfile$(C2;)
8920 Trap 8960:M$(B)=" ":Bget #I,Adr(M$),B
8930 X=Dpeek(856):If X<B:M$(X+I)="":Endif :If X=O:Goto 8950:Endif 
8940 Bput #C6,Adr(M$),Len(M$):If Bf Then Goto 8920
8950 Close #I:Close #C6:Return 
8960 Trap Etr:Poke Wk3,O:If Err(O)=136:Bf=O:Goto 8930:Endif :Close #C7:Goto Etr
9100 Rem   Message Move processing   
9105 If Pw<24:Return :Endif :? Cr$;"ZAP! It's history...":Wk1=Usr(1576,C6,Adr(M$)+C7*F-C3)
9110 Gosub 23020:Par(72)=Flo:Par(73)=Bbs:Par(74)=Xm:Par(76)=F-Flo:Gosub 5600
9120 For X=I To C10:Dpoke Adr(Msg$)+C17+C2*X,O:Next X
9145 ? Cr$;"To message base ? ";:Gosub 300
9150 Trap 9145:Bbs=Int(Val(L$)):If Bbs<I Or Bbs>Nbbs:Goto 9145:Endif 
9152 Trap Etr:Par(C5)=Bbs:Gosub 8100
9155 Par(75)=I:Gosub 22000:Par(75)=O
9160 Gosub 5600:Flo=Par(72):Bbs=Par(73):Par(C5)=Bbs:Xm=Par(74):F=Par(76)
9165 Par(72)=O:Par(73)=O:Par(74)=O:Par(76)=O:Gosub 8100:Return 
9200 Rem      Send Z$ Page-break     
9210 Wk2=O
9220 Trap 9299:X=Usr(1544,Adr(Z$)+Wk2,Len(Z$)-I-Wk2,Par(77),Sy,Par(79)):Poke 1550,Ccon
9225 If X=I:Wk2=Dpeek(203)-Adr(Z$):? ;"More..";:Gosub 200
9227   For Wk1=I To C6:? ;" ";:Next Wk1:Else :Return :Endif 
9230 Goto 9220
9299 Trap Etr:Return 
9300 Rem      Send M$ Page-break     
9310 Wk2=O
9320 Trap 9399:X=Usr(1544,Adr(M$)+Wk2,Len(M$)-I-Wk2,Par(77),Sy,Par(79)):Poke 1550,Ccon
9325 If X=I:Wk2=Dpeek(203)-Adr(M$):? ;"More..";:Gosub 200
9327   For Wk1=I To C6:? ;" ";:Next Wk1:Else :Return :Endif 
9330 Goto 9320
9399 Trap Etr:Return 
9400 Rem  Create Message Base Control
9410 Bpar(C5)=O:Bbs=27:Gosub 9440
9420 For Bbs=I To Nbbs:F$="D1:BASES>MESSAGE.IS",Chr$(Bbs+C64):Gosub 5400:Ms$(Bbs,Bbs)=F$(C2,C2)
9430   Gosub 9440:Next Bbs:Gosub 7700:Return 
9440 Gosub 8100:Bpar(C5)=Bpar(C5)+Am:If Am:Hz(Bbs)=Dpeek(Adr(M$(Len(M$)))-C6):Endif :Return 
12000 Rem   Yell for SysOp & Chat    
12020 If  Not Bpar(9) Then ? Cr$;E$(Cst(C3,O),Cst(C3,I)):Goto Ma
12030 Par(C17)=Par(C17)+I:Poke 712,68:Poke 710,148:Poke 709,206
12040 If Par(C17)=I:Z$=E$(Par(24),Par(25)-I):Gosub 6700:? "":Goto Ma:Endif 
12050 If Par(C17)=C2:? Cr$;Cr$;" ";Nick$:Summ=I
12060   Z$=E$(Par(25),Par(26)-I):Gosub 6700:Summ=O:Goto Ma:Endif 
12070 Bpar(C14+I)=C3:Goto 31000
12080 ? Cr$;Cr$;E$(Cst(C4,O),Cst(C4,I));Cr$;Cr$:Goto 12090
12090 ? "Hi ";Nick$
12100 Gosub 7600:Par(65)=Y:Par(C16)=O:Par(C17)=O:Poke 712,O:Poke 710,148:Poke 709,202
12110 If Peek(53279)<>C6 Then 12150
12120 L$="*":L$(80)="*":L$(C2)=L$:? #C3;Cr$;L$;Cr$
12130 Position O,C5:While Peek(84)<>23:Input #C4,L$:? #C3;L$:Endwhile 
12140 L$="*":L$(80)="*":L$(C2)=L$:? #C3;Cr$;L$;Cr$:Gosub Om
12150 If Peek(764)=C256-I Then 12200
12160 Get #C5,X
12180 If X=C20+C7 Then Close #C2:Gosub 7600:Par(C64)=Par(C64)+Y-Par(65):Goto Ma
12185 If Ansi=C2 Then ? #C2;"[1;33m";
12190 ? ;Chr$(X);
12200 Status #C2,X:L=Peek(747):If  Not L Then 12110
12205 If Ansi=C2 Then ? #C2;"[0m";
12210 For Y=I To L:Get #C2,X:If X=C8 Then X=C128-C2
12230   ? ;Chr$(X);:Next Y:Goto 12110
13100 Rem   Function [I] - Inventory 
13110 ? Pw$(38,38)
13115 ? ;Cr$;"Display file names that";Cr$;"begin with letter => ";:Gosub Reply
13125 X$=L$:If X$<"A" Or X$>"Z" Then Goto 13115
13130 F$=Cfile$(C8;),"FILES",L$(I,I):? Pw$(38,38):Gosub 6600:Gosub 9300:Goto Ma
14000 Rem     On-line Game Support   
14010 F$=Cfile$(C4;),"ONLINE1":Gosub 7000:? " Select: ";:X=Usr(1563,Adr(Pw$))
14020 F$="D1:ONLINE1.DAT":Gosub 6600:Bpar(16)=I:Gosub 200:Bpar(16)=O:Trap Ma:Wk1=(X-65)*31
14030 F$=M$(Wk1+13,Wk1+30):Close #I:Open #I,C4,O,F$:Close #I:Gosub 8000
14035 Wk2=Find(F$,">",O):X=Usr(1583,Adr(F$),Wk2)
14040 If M$(Wk1+C4,Wk1+C7)<>"NONE":? Cr$;" Game code = ";:Gosub 100
14050   If L$(I,C4)<>M$(Wk1+C4,Wk1+C7):Goto 3000:Endif :Endif 
14060 ? Cr$;" Game load in progress....";
14065 Poke 1549,Asc(M$(Wk1+11))-48:X=Usr(1557,Asc(M$(Wk1+9))-48):Run F$
14080 Set 15,I:Pop :Pop :Pop :Pop 
14100 Gosub 1600:Gosub 400:Gosub C10:Goto Ma
15000 Rem       Vote Processing      
15010 Rem : F$=Cfile$(C4;),"VOTEGRPH":Gosub 7000
15020 F$="D1:VOTEFOR.DAT":Gosub 6600:Z$=M$:Wk1=Int(Len(Z$)/C20)
15030 F$="D1:VOTEAGN.DAT":Gosub 6600:Msg$=M$:Wk2=Int(Len(Msg$)/C20)
15040 From$=" ":From$(C20-I)=" ":From$(C2)=From$:For X=I To 500:Next X
15050 F$=Cfile$(C4;),"VOTEISUE":Gosub 7050:X=Asc(Pw$(100))
15060 If X=O Or X=C3:? "Vote [F]or or [A]gainst ?";:Bpar(C16)=I:Gosub 200:Bpar(C16)=O:X=C3
15070   If X$="F":X=I:Z$(Wk1*C20+I)=Name$:Wk1=Wk1+I:Endif 
15080   If X$="A":X=C2:Msg$(Wk2*C20+I)=Name$:Wk2=Wk2+I:Endif :Endif :Pw$(100,100)=Chr$(X)
15090 If X=C3:Goto 15130:Endif :? ;Cr;"Your vote is registered as being"
15100 If X=I:? "for";:Else :? "against";:Endif 
15120 ? " the issue.....":For Wk4=I To C256*C10:Next Wk4:Goto 15140:Endif 
15130 ? Cr$;"You may vote later by using the";Cr$;"[V]ote function......":Goto 15210
15140 Gosub C10:Wk3=I:? "Displaying results.........";Cr$;"  For                Against"
15150 If Wk3>Wk1:Out$=From$:Else :Out$=Z$(Wk3*C20-19,Wk3*C20-I):Endif 
15160 If Wk3>Wk2:Out$=Out$,From$:Else :Out$=Out$,Msg$(Wk3*C20-19,Wk3*C20-I):Endif 
15170 ? Out$:Wk3=Wk3+I:If Wk3>Wk1 And Wk3>Wk2
15180   ? Cr$;"Press any key to continue":Gosub 200:Goto 15190:Endif :Goto 15150
15190 Close #I:Open #I,C8,0,"D1:VOTEFOR.DAT":Bput #I,Adr(Z$),Len(Z$)
15200 Close #I:Open #I,C8,0,"D1:VOTEAGN.DAT":Bput #I,Adr(Msg$),Len(Msg$)
15210 Return 
17000 Rem    Function [$] - Sysop    
17010 Trap 17000:If  Not Asc(Pw$(C50))&I Then Return 
17020 F$=Cfile$(C4;),"SOPFUNC1":Gosub 7000:Trap 17000:? "Select=> ";:Gosub 100:X=Find("SVPLBCDFOGETA",L$,O):A=O
17030 On X+I Goto Ma,17130,17150,17155,17240,17280,17290,17060,17040,17340,2600,2200,2250,2150
17040 F$=Cfile$(C4;),"SOPFUNC2":Gosub 7000:Trap 17000:? "Select=> ";:Gosub 100:X=Find("REPUC",L$,O)
17050 On X+I Goto 17000,17090,17110,17300,17320,17360
17060 ? Cr$;"Dn:[path>]*.*";Cr$;Cr$;"Dir=> ";:Gosub Reply:If L$="":Goto 17000:Endif :Trap 17000
17070 Trap 17000:Close #I:Open #I,C6,C128,L$
17071 Trap 17079:Input #I,Z$:? Z$:Goto 17071
17079 Close #I:? "Press a key....";:Gosub 200:Goto 17000
17080 Goto 17000
17090 ? Cr$;"Dn:[path>]Oldname,Newname";Cr$;Cr$;"Rename=> ";
17100 Gosub Reply:If L$="":Goto 17000:Endif :Trap 17000:Rename L$:Goto 17000
17110 ? Cr$;"Dn:[path>]filename";Cr$;Cr$;"Erase=> ";
17120 Gosub Reply:If L$="":Goto 17000:Endif :Trap 17000:Erase L$:Goto 17000
17130 ? Cr$;"Cal: ";Bpar(O);Cr$;"Mis: ";Bpar(C5);"-";Bpar(C3);Cr$;"D/U: ";Bpar(C2);"-";Bpar(I)
17140 ? "Err: ";Bpar(C7);Cr$;"Fre: ";Bpar(C6);Cr$;"Buf: ";B;Cr$;"Bel: ";Bpar(9);Cr$;"Log: ";Bpar(C8):Return 
17150 ? Cr$;"Pw: ";:Gosub Reply:A=I
17155 Gosub 8300:Z$=Pw$:Pw$(125)=" "
17160 Trap 17230:Wk1=Usr(1573,I,Adr(Idx$(29;)))
17170 Bget #I,Adr(Pw$),125:If Pw$(1,1)=Cr$ Or Pw$(1,4)="" Then Goto 17230
17180 If ( Not A And Asc(Pw$(49))) Or (A And Pw$(I,C4)<>L$) Then 17160
17190 ? Cr$;Pw$(I,C4);" ";Pw$(C5,C32+C4);Cr$;"Mask: ";:Gosub Reply:Trap 17220
17200 F=Val(L$):If  Not F Then Gosub 24000:Gosub 8300:Goto 17190
17210 M=Pw:Gosub 6035:Pw=M
17220 Wk1=Usr(1576,I,Adr(Idx$(29;))):? #I;Pw$(I,124):If  Not A Then Goto 17160
17230 Trap Etr:? "EOF":Pw$=Z$:Nick$=Pw$(107,116):Goto Ma
17240 If  Not Bpar(C8) Then ? Cr$;"Inactive":Return 
17250 Close #C3:F$="D1:USRLOG.DAT":Gosub 7000
17260 ? Cr$;"Print? ";:Gosub 6100:If X Then Gosub 6200
17270 ? Cr$;"Restart? ";:Gosub 6100:Close #C3:If X:Erase F$:Endif :Open #C3,9,O,F$:Return 
17280 Bpar(9)=I-Bpar(9):Goto 17130
17290 Gosub 7400:Goto 17130
17300 ? Cr$;"Dn:[path>]filename";Cr$;Cr$;"Protect=> ";
17310 Gosub Reply:If L$="":Goto 17000:Endif :Protect L$:Goto 17000
17320 ? Cr$;"Dn:[path>]filename";Cr$;Cr$;"Unprotect=> ";
17330 Gosub Reply:If L$="":Goto 17000:Endif :Unprotect L$:Goto 17000
17340 ? Cr$;"FoReM-XEP Remote Control";Cr$;"Enter FAST:GOTO 3000 when changes";Cr$;"are complete."
17350 Trap O:Poke 17,O
17360 ? Cr$;"Dn:[path>]filemask";Cr$;"From=> ";:Gosub Reply:Cfile$(I;)=L$
17370 ? Cr$;Cr$;"Dn:[path>]";Cr$;"To  => ";:Gosub Reply:Cfile$(C2;)=L$:Gosub 8800:Goto 17000
18000 ? ;Cr$;"Electronic Mail":Email=C3
18010 If Bbs<27:Par(C5)=Bbs:Bbs=C20+C7:Endif :Gosub 8100:Goto 19040
18020 Par(19)=O
18030 ? Cr$;"Quick-scan Message Bases"
18040 Par(19)=Par(19)+I
18050 If Par(19)>Nbbs:? "Quick-Scan Processing Complete...":Goto Ma:Endif 
18060 Y=Par(19):M=O:While Y>C8:Y=Y-C8:M=M+I:Endwhile 
18070 If Int(C2^(Y-I)+0.5)&Asc(Pw$(C50+C6-M))=O Then Goto 18040
18080 If Asc(Pw$(106))&C64:M=O:Y=Par(19):While Y>C8:Y=Y-C8:M=M+I:Endwhile 
18090   If Int(C2^(Y-I)+0.5)&Asc(Pw$(104-M))=O:Goto 18040:Endif :Endif 
18100 If Dpeek(Adr(Pw$)+Par(19)*C2+57)=Hz(Par(19)) Then Goto 18040
18110 L$="Z/",Str$(Par(19)),"/R/N":X$=L$:Gosub 8000
18120 Gosub 5600:Email=O:If Len(L$)>C2:L$=L$(C3):Else :? Cr$;"FoReM-XE Pro Communications Center"
18130   ? " * = New messages":If Asc(Pw$(106))&64:? "#  = Quick-scan selected":Endif :? 
18140   For M=I To Nbbs
18142     Y=M:X=O:While Y>C8:Y=Y-C8:X=X+I:Endwhile 
18143     If Int(C2^(Y-I)+0.5)&Asc(Pw$(C50+C6-X))
18144       If Asc(Pw$(106))&64 And Int(C2^(Y-I)+0.5)&Asc(Pw$(104-X)):? "#";:Else :? " ";:Endif 
18150       Par(40)=Dpeek(Adr(Pw$)+M*C2+57):If Par(40)<Hz(M):? " * ";:Else :? "   ";:Endif 
18160       ?  Using "##",M;:? ") ";Bbna$(M*C16-(C16-I),M*C16)
18200     Endif :Next M
18210   ? Cr$;"   A) Read All new messages":If Asc(Pw$(106))&64
18220     ? "      on quick-scan selected bases":Endif 
18230   Gosub 6300:Endif 
18240 If L$="A" Then Goto 18020
18250 M=O:Trap Ma:Bbs=Int(Val(L$)):Y=Bbs:If Bbs<I Or Bbs>Nbbs Then Goto 18120
18260 While Y>C8:Y=Y-C8:M=M+I:Endwhile :If Int(C2^(Y-I)+0.5)&Asc(Pw$(C50+C6-M))=O Then Goto 18120
18280 Bbs$=Bbna$(Bbs*C16-(C16-I)):? Cr$;"Switching to base #";Bbs;" ";Bbs$
18290 Hold$=Str$(Bbs):X$=Hold$:Gosub 8000
18295 If Bbs>9:X$=Hold$(C2):Gosub 8000:Endif :Par(C5)=Bbs
18300 L$=L$(I+(Bbs>9)):Gosub 8100
18320 If Len(L$)<C3 Then Goto 19000
18330 If L$(C3)="E" Then L$="E":Goto 3040
18340 If L$(C3)="M" Then Goto Ma
18350 L$=L$(C3):Goto 19000
19000 Rem     Message Main Process   
19010 X$="R":Gosub 5700:Gosub 8100:Par(61)=O
19040 Summ=O:Par(C7)=O
19050 Wk1=32767:If Bbs<27:Wk1=Dpeek(Adr(Pw$)+Bbs*C2+57)
19070   If Wk1>Hz(Bbs):Wk1=Hz(Bbs):Dpoke Adr(Pw$)+Bbs*C2+57,Wk1:Endif :Endif :Par(40)=Wk1
19080 If Par(81) Then Summ=O:Mn1=O:Tcl$="SYSOP":L$=Tcl$:Subj$="Letter to Sysop":Goto 21330
19090 If  Not Am And  Not Email:M$="":F=O:T=O:Goto 19140:Endif 
19100 If  Not Par(C4) And Email Then ? Cr$;"No mail waiting.":Goto 19170
19110 L=Am*C7:F=Dpeek(Adr(M$)):T=Dpeek(Adr(M$)+L-C7):If Len(L$)>C2 Then 20000
19120 If Email Then ? Cr$;"You have ";Par(C4);" message";:If Par(C4)-I:? "s";:Endif :? " waiting.":Goto 19170
19130 If Par(61)=C2:Par(61)=O:Flo=Par(72):L$="R ",Str$(Mn1),"-"
19135   If Flo=I:L$=L$,"65535":Else :L$=L$,"0":Endif :Goto 19040:Endif 
19140 Gosub C10:? Cr$;"Message base is ";Bbs$;Cr$;Cr$;T-Par(40);" of the ";Am;" messages are new"
19150 ? :? "Numbered from ";F;" to ";T;" . ":? :? "High message read is # ";Par(40)
19170 ? Cr$;"Continuous scroll is ";:If Asc(Pw$(C50+C3))&C4:? "on":Else :? "off":Endif 
19200 Summ=O:? Cr$;Cr$;"(RCSMZ)(?=Menu)Msg Cmd: ";:Gosub Reply:Trap Ma:Goto 19270
19210 ? Cr$;"(R)ead  ";Cr$;"(C)ont  ":If Par(9):? "(S)end  ":Endif 
19240 If Asc(Pw$(C50+I))&C4 And  Not Email:? "(D)elete":Endif :Goto 19200
19270 X$=L$:X=Find("RSCD?Z",X$,O)
19280 On X+I Goto Ma,20000,20035,19290,20050,19210,Ma+100
19290 X=Asc(Pw$(53)):If X&C4:X=X&251:Else :X=X!C4:Endif :Pw$(53,53)=Chr$(X):Goto 19120
20000 Rem   Message Read Processing  
20002 If Email And Len(L$)>C2 Then If L$(C3,C3)<>"+" Then L$=L$(I,I)
20005 If Len(L$)>C2 Then L$=L$(C3):Goto 20070
20010 If Email:If  Not Am Or ( Not Par(C4) And  Not Asc(Pw$(C50))&C32):Goto Ma
20015   Else :? Cr$;"[T]o you  ";Cr$;"[F]rom You";Cr$;"[A]ll :    ";Cr$;Cr$;"Select--> ";:Gosub 100:Email=I
20020     If L$="F" Then Email=C2
20025     If L$="A" Then Email=C3
20030     L$="+":Goto 20070:Endif :Endif :Goto 20060
20035 If Par(9) Then Gosub 21020
20040 Goto 19090
20050 If Email Then 20565
20055 Summ=C2:? Cr$;"Delete Msg# <RETURN>=Exit : ";:Gosub Reply:Goto 20085
20060 ? Cr$;"Search [From]-[To] [N]=NEW ";Cr$;"[+ / -] = Full For/Rev read";Cr$;"OR <RETURN> For Main Menu:  ";
20065 Gosub Reply
20070 If L$="+" Then L$="1-65535"
20075 If L$="-" Then L$="65535-1"
20080 If L$="N" Then L$=Str$(Par(40)+I),"-65535"
20085 A$=L$:If L$="" Then Return 
20090 Gosub 23090
20095 If Flo<>O Then Goto 20125
20100 ? :If Summ=C2 Then ? "Msg not found"
20105 If Par(61)=I:? "Ref message has been deleted":Goto 20400:Endif 
20110 If  Not Par(61) And Par(9) And Bbs<27:If Asc(Pw$(106))&C32
20115     ? Cr$;"Enter message this base ? ";:Gosub 6100:If X:Gosub 21020:Endif :Endif :Endif 
20120 If Par(19) And Par(61)=O:Goto 18040:Endif :L$="":Goto 19090
20125 Gosub 23200:If Flo<O Then Wk1=Tu:Tu=From:From=Wk1
20135 If F<I Or F>Am:Goto 20090:Endif :Mn=Dpeek(Adr(M$)+F*C7-C7):Xm=Mn
20140 If Xm<From Or Xm>Tu Then Goto 20090
20145 Idx$(29;)=M$(C7*F-C2):Wk1=Usr(1576,C6,Adr(Idx$(29;))):Gosub 8500:Par(O)=X
20150 If Name$=Tcl$ And  Not Par(O) And  Not Summ:Wk1=Usr(1576,C6,Adr(Idx$(29;)))
20155   Y=Asc(Msg$(C5))!I:Msg$(C5,C5)=Chr$(Y):Bput #C6,Adr(Msg$),C5:Par(O)=I:Endif 
20160 If Email:If  Not (Asc(Pw$(C50))&C32)
20165     If Tcl$<>Name$ And From$<>Name$:Goto 20180:Endif :Endif 
20170   If (Email=I And Tcl$<>Name$) Or (Email=C2 And From$<>Name$):Goto 20180:Endif :Endif 
20175 Gosub 20185
20180 F=F+Flo:Goto 20135
20185 Z$="":Call "MSG_COLOR" Using 32,0,2
20187 If Email:Z$=Z$,"Electronic Mail ":Else :Z$=Z$,"Msg# : ",Str$(Mn)," - ",Bbs$:Endif 
20190 Z$=Z$,Cr$,"Sent : ",D$," at ",Ti$,Cr$,"To   : ",Tcl$:If Par(O)&I:Z$=Z$,"(Received)":Endif 
20200 Z$=Z$,Cr$,"From : ",From$,Cr$:Wk1=Dpeek(Adr(Msg$)+C5)
20205 Trap 20210:If Wk1<>Optn(90):Z$=Z$,"F-net: ",Fnetname$(Wk1-9000;),Cr$:Endif 
20210 Trap Etr:Z$=Z$,"Subj : ",Subj$
20215 Wk1=Dpeek(Adr(Msg$(18))):If Wk1:Z$=Z$,Cr$,"Ref# : ",Str$(Wk1):Endif 
20220 Out$=Cr$,"Rep# : "
20225 For X=I To C5:Y=Dpeek(Adr(Msg$(18))+C2*X):If  Not Y:Pop :Goto 20230:Endif :Out$=Out$,Str$(Y)," ":Next X
20230 If Len(Out$)=C8:Goto 20245:Endif :Z$=Z$,Out$:Out$=Cr$,"       "
20235 For X=C6 To C10:Y=Dpeek(Adr(Msg$(18))+C2*X):If  Not Y:Pop :Goto 20240:Endif :Out$=Out$,Str$(Y)," ":Next X
20240 If Len(Out$)>C8:Z$=Z$,Out$:Endif 
20245 Trap 20255:Call "MSG_COLOR" Using O,I,C3:Z$=Z$,Cr$,Cr$,Msg$(129)
20250 X=Usr(1541,Adr(Z$),Asc(Pw$(37))):Z$(Len(Z$))=""
20255 Gosub C10:Trap Etr:Poke 1549,I:If Par(77)=O:X=O:? Z$
20260 Else :Gosub 9200:Endif :Poke 1549,O:If X=C3:Pop :Goto 20100:Endif 
20265 If X=C14 Or Summ=I Then Return 
20270 If Par(61)=O And Xm>Par(40) And Summ=O:Par(40)=Xm
20275   If Bbs<27 Then Dpoke Adr(Pw$)+Bbs*C2+57,Par(40):Endif 
20280 Gosub 5500:If  Not (Asc(Pw$(53))&C4) Or Summ=C2 Then 20295
20285 For X=I To C128:Status #C2,Y:If (Peek(747) And  Not Sy) Or Peek(764)<>C256-I Then Pop :Gosub 200:Goto 20295
20290 Next X:Return 
20295 Bpar(C16)=I:Bpar(C17)=I:If Summ<>C2 Then 20320
20300 M=O:If ((Name$=Tcl$ Or Name$=From$) And Pw) Or Asc(Pw$(C50))&C16 Then M=I
20305 If M Then 20315
20310 ? Cr$;"Priviledge not authorized":Goto Ma
20315 ? Cr$;"[M]ain Menu  [D]elete: ";:Goto 20345
20320 If Par(61)=I:? Cr$;"[A]gain [<]Ref Msg [M]ain <Cr>Return: ";:Goto 20345:Endif 
20325 If Par(61)=C2:? Cr$;"[A]gain [>]Thread [M]ain <Cr>Next: ";:Goto 20345:Endif 
20330 If Email:? Cr$:If Pw>24:? "[C]opy ";:Endif :? "[A]gain [R]eply <Cr>Next: ";:Gosub 300
20332   If ( Not Find("XARDPMC",L$,O)) And L$<>"" Then 20330
20335   If (L$="" Or L$="R") And Name$=Tcl$:Edit$=L$:L$="D;",Edit$:Endif :Goto 20350:Endif 
20340 If Ansi=C2:? "[36m ";:Endif :? "[";F;"\";Am;"] [RAB<>+-DSEM?] Msg Cmd: ";
20345 Gosub Reply
20350 Bpar(C16)=O:Bpar(C17)=Zll:Xm=F:D$=L$:X$=L$
20355 If  Not Par(61):If Len(X$)=O:Goto 20570:Endif 
20360   X=Find("DRPMAB<>EC?+-S",X$,O):If X Then ? 
20365   On X Goto 20415,20515,20560,3000,20255,20440,20450,20455,20510,20500,20595,20600,20630,20650
20367   Bpar(C16)=I:Bpar(C17)=I:Goto 20345
20370 Endif 
20375 If Par(61)=C2:X=Find("AM>",X$,O):On X Goto 20185,20380,20385
20377   If Len(X$)=O:Goto 20570:Endif :Bpar(C16)=I:Bpar(C17)=I:Goto 20345
20380   Par(61)=O:Goto 3000
20385   L$="R ":For X=I To C10:Y=Dpeek(Adr(Msg$)+C17+C2*X):If Y:L$=L$,Str$(Y)," ":Endif :Next X
20390   L$=L$,A$:Goto 19040:Endif 
20395 If Par(61)=I:X=Find("AM<",X$,O):On X Goto 20185,20405,20410
20397   If Len(X$)=O:Goto 20400:Endif :Bpar(C16)=I:Bpar(C17)=I:Goto 20345
20400   Par(61)=O:Flo=Par(72):If Flo=I:Mn=Mn1+I:Else :Mn=Mn1-I:Endif :Goto 20440
20405   Par(61)=O:Goto 3000
20410   L$="R ",Str$(Dpeek(Adr(Msg$)+C17)):Goto 19270:Endif 
20415 If  Not Asc(Pw$(C50+I))&C4 Then 20505
20420 M=O:If ((Name$=Tcl$ Or Name$=From$) And Pw) Or Asc(Pw$(C50))&C16 Then M=I
20425 If M Then ? Cr$;"Delete this message? ";:Gosub 6100:If X Then ? Cr$;"Vaporized...":Gosub 23020:L$="K"
20430 If Summ=C2 Then Goto Ma
20435 Goto 20580
20440 If Flo=I:L$="R ",Str$(Mn-I),"-65535":Goto 19270:Else 
20445   L$="R ",Str$(Mn+I),"-0000":Goto 19270:Endif 
20450 L$="R ",Str$(Dpeek(Adr(Msg$)+C17)):Par(61)=I:Mn1=Mn:Par(72)=Flo:Goto 19270
20455 L$="R "
20460 For X=I To C10
20465   Y=Dpeek(Adr(Msg$)+C17+C2*X)
20470   If Y:L$=L$,Str$(Y)," ":Endif :Next X
20475 Par(61)=C2:Mn1=Mn:Par(72)=Flo:Goto 19040
20480 Rem 
20485 Rem 
20490 If Email:Par(71)=O:L$="M;+":Goto 18010:Endif :L$="R ",Str$(Mn),"-"
20495 If Par(71)=-1:L$=L$,"0":Else :L$=L$,"65535":Endif :Par(71)=O:Goto 19000
20500 Gosub 9100:Goto 20575
20505 If Summ=C2:Goto 20305:Else :Goto 20515:Endif 
20510 Par(72)=Flo:Par(73)=Bbs:Par(74)=Xm:Gosub 5600:Par(C5)=27:Bbs=27:Gosub 8100:Email=C3
20515 Mn1=O:If Par(9):Tcl$=From$:If Email:Goto 20540:Endif 
20520   For X=I To C10:If Dpeek(Adr(Msg$)+C17+C2*X)=O:Dpoke Adr(Msg$)+C17+C2*X,Hz(Bbs)+I
20525       Wk1=Usr(1576,C6,Adr(Idx$(29;))):Bput #C6,Adr(Msg$),39:Pop :Goto 20530:Endif :Next X
20530   ? Cr$;"Subject: ";Subj$;Cr$;"Change Subject ? ";
20535   Gosub 6100:If X:? Cr$;"New subject: ";:Gosub 300:? :Subj$=L$:Endif 
20540   Hold$=A$:Email=Email*C10:If Email:Gosub 21020:Else :Mn1=Mn:Gosub 21330:Endif 
20545   If Par(73):Gosub 5600:Flo=Par(72):Bbs=Par(73):Par(C5)=Bbs:Par(73)=O:Xm=Par(74)
20550     Email=O:Gosub 8100:Endif 
20555   Email=Email/C10:A$=Hold$:L$="E":Goto 20580:Endif 
20560 If Asc(Pw$(C50))&C8 Then ? #C3;Cr$;Z$;Cr$:? :Goto 20585
20570 If Summ=C2 Then Pop :Goto 19040
20575 Return 
20580 X$=L$:Gosub 8000
20585 F=Xm:If Len(D$)<C3 Then Return 
20590 D$=D$(C3):L$=D$:Goto 20350
20595 ? E$(Par(27),Par(28)-I);:Goto 20340
20600 ? "Ahead how many messages => ";:Trap 20600:Gosub 300
20610 Wk1=Val(L$):Trap Etr:F=F+Wk1:Tu=65535:Pop :Goto 20135
20630 ? "Back how many messages => ";:Trap 20630:Gosub 300
20640 Wk1=Val(L$):Trap Etr:F=F-Wk1:From=I:Pop :Goto 20135
20650 F=Am+I:From=I:Pop :Goto 20135
21000 Rem  Message Enter Processing  
21010 X$="E":Gosub 5700:If  Not Par(71):? Cr$;"Enter Message - ";Bbs$:Endif :Gosub 8100
21020 Mn1=O:If  Not Par(71):If Email<C4:? Cr$;"Subject: ";:Gosub 300
21025     Subj$=L$:If L$="":Return :Endif :Endif :Endif 
21035 If Par(71):Tcl$="All":Goto 21260:Endif 
21040 If Email>C3 Then 21260
21050 ? Cr$;"To: ?=Search ";:If  Not Email:Tcl$="All":Gosub 300:If L$>"" Then Tcl$=L$
21060   If L$<>"?" Then Goto 21260:Endif 
21070 ? :? Cr$;"You may only search on the first name";Cr$;"Please enter the string (first name)"
21090 ? "to search for (All implies stop at";Cr$;"each name): ";
21110 Gosub 100:If L$="" Then Tcl$="All":Return 
21120 Ll$=L$:Gosub 7100:Gosub 8300:Trap 21240
21130 L$(125)=" ":Bget #I,Adr(L$),125:If L$(I,I)=Cr$ Or L$(I,C4)="":Goto 21240:Endif :A$=L$(C5)
21140 For Y=I To Len(Ll$)
21150   X=Asc(A$(Y))&127:If (X>64 And X<91) Or X=C32:A$(Y,Y)=Chr$(X):Goto 21200:Endif 
21160   If X>96 And X<123:A$(Y,Y)=Chr$(X-C32):Goto 21200:Endif 
21190   A$(I)=A$(C2):A$(C20,C20)=" ":Goto 21150
21200 Next Y
21210 If A$(I,Len(Ll$))<>Ll$ And Ll$<>"ALL" Then 21130
21220 Tcl$=L$(C5):? ;Cr$;Tcl$;" 1-OK 2-Continue ";:Gosub 300:? ;Cr$;:Gosub 7100
21230 If L$="1":Goto 21260:Endif :Goto 21130
21240 Trap Etr:? Cr$;"Name not in file":Goto 21050
21260 If Email:If L$="":Return :Endif :Goto 21330:Endif 
21330 From$=Name$:Z$=" ":Z$(3700)=" ":Z$(C2)=Z$:Li=O:Se=I
21340 ? ;Cr$;"    Message Editor Command Summary";Cr$
21350 ? " /A=Abort  /S=Save  /?=Help  /L=List ";Cr$
21360 Zll=Asc(Pw$(37)):If  Not (Asc(Pw$(106))&C16):Zll=Zll-C4:Endif :Z81=Zll+I:Z79=Zll-I
21370 Par(C8)=O:Bl=Int(3500/Z81)
21380 L$=" ":L$(Zll)=" ":L$(C2)=L$:For X=Li+I To Bl:Z$(X*Z81-Zll)="":Next X
21390 Trap Etr:Z$(3700)=" ":If Se<=Bl Then 21410
21400 Se=Bl:? Cr$;"End of File";Cr$;Cr$;"/S(Save)/L(List)/?(Menu) Command: ";:Li=Se:Se=Se+I:Goto 21450
21410 If Se<I Then Se=I
21420 If Se>=Li+I Then Li=Se-I
21430 If Se<>Li+I And Se<>Bl Then Y=Se:Gosub 21850
21440 If  Not (Asc(Pw$(106))&C16):If  Not Par(C8):?  Using "##",Se;:? ") ";:Endif :Endif 
21450 L$="":If Par(C8):L$=Ll$:Par(C8)=O:Endif :Gosub 310:If Len(L$)<Zll:L$=L$,Cr$:Goto 21510:Endif 
21470 Trap 21510:For X=Zll-I To I Step -I:If L$(X,X)=" ":Pop :Goto 21480:Endif :Next X
21480 If X>I:Ll$=L$(X+I):L$=L$(I,X):Par(C8)=I:For Y=I To Zll-X:? " ";:Next Y:? ;Cr$;
21490   If  Not (Asc(Pw$(106))&C16):?  Using "##",Se+I;:? ") ";:Endif :? Ll$;:Endif 
21510 Trap Etr:Out$=L$:If L$="":Out$=" ":Goto 21690:Endif :If Len(L$)=I Or L$(I,I)<>"/" Then 21690
21520 Gosub 700:If L$(C2,C2)="C" Then 21710
21530 L$=L$(I,C2+(Len(L$)>C2)+(Len(L$)>C3)):X$=L$(C2):X=I:If X$="L" Then X=O
21540 Trap 21550:X=Val(L$(C3))
21550 Trap Etr:Y=Find("UNBTGLSIA?HD",X$,O)
21560 On Y+I Goto 21640,21570,21580,21590,21600,21610,21870,22000,21800,21620,21630,21640,21650
21570 Se=Se-X:Goto 21390
21580 Se=Se+X:If Se>Li:Se=Li+I:Endif :Goto 21390
21590 Se=Li+I:Goto 21390
21600 Se=I:Goto 21390
21610 Se=X:Goto 21390
21620 ? "ABORT..Are you sure? (Y/N) ";:Gosub 300:Gosub 700
21622 If L$="N" Then 21870
21628 ? Cr$;"Aborted":Return 
21630 X=X
21640 ? E$(Par(26),Par(27)-I);
21650 If Se+X>Li-I Then X=Li-Se
21660 Trap 21390:Z$(Se*Z81-Zll)=Z$((Se+X-I)*Z81+I):Li=Li-X
21670 L$=" ":L$(Zll)=" ":L$(C2)=L$:For X=Li+I To Bl:Z$(X*Z81-Zll)="":Next X:If Se=Li Then Li=Li-I
21680 Goto 21390
21690 Trap 21390:Z$(Se*Z81-Zll)=Chr$(Len(Out$)):Z$(Se*Z81-Z79)=Out$:If Se=Li+I Then Li=Li+I
21700 Se=Se+I:Goto 21390
21710 Trap 21760:Out$=Out$(C4):Y=Find(Out$,"/",O):If  Not Y Then Goto 21760
21730 A$=Out$(Y+I,Len(Out$)-I)
21735 Out$=Out$(I,Y-I):T=Len(Out$):L$=Z$(Z81*Se-Z79,Z81*Se-Zll+Asc(Z$(Se*Z81-Zll)))
21740 For Y=I To Len(L$)-Len(Out$)+I:If L$(Y,Y+Len(Out$)-I)=Out$ Then Pop :Goto 21770
21750 Next Y
21760 Trap Etr:? "    NOT FOUND":Goto 21390
21770 Out$=L$(I,Y-I*(Y>I)):Out$(Y)=A$:If Y+T<Len(L$) Then Out$=Out$,L$(Y+T)
21780 If Len(Out$)>Zll Then Out$=Out$(I,Zll)
21790 Z$(Se*Z81-Zll)=Chr$(Len(Out$)):Z$(Se*Z81-Z79)=Out$:Z$(1325)=" ":Goto 21390
21800 If Len(Out$)<C4 Then Out$="    "
21810 For X=Bl To Se+I Step -I:Z$(X*Z81-Zll,X*Z81)=Z$((X-I)*Z81-Zll,(X-I)*Z81):Next X
21820 Out$=Out$(C4):Li=Li+I:If Li>Bl Then Li=Li-I
21830 Goto 21690
21840 Z$((Se+I)*Z81-Zll)=Z$(Se*Z81-Zll,Li*Z81-Zll)
21850 Wk1=Y*Z81-Zll+Asc(Z$(Y*Z81-Zll))
21860 ?  Using "##",Y;:? ": ";Z$(Y*Z81-Z79,Wk1);:If Z$(Wk1,Wk1)<>Cr$:? :Endif :Return 
21870 M=Se:By=X:If By<I Then Se=I:By=Li
21880 If  Not Li Then 21920
21890 ? :For Y=Se To Se+By-I:If Y>Li Then Pop :Goto 21920
21900   Gosub 21850:If X=C3 Then Pop :Goto 21920
21910 Next Y
21920 Se=M:If Se<=Bl Then Goto 21440
21930 Se=Bl:? Cr$;"End of File";Cr$;Cr$;"/S(Save)/L(list)/?(Menu) Command: ";:Li=Se:Se=Se+I:Goto 21450
22000 Rem   Message Save Processing  
22040 If Pm=I:Pm=O:? Cr$;"Scribbling...":L$="*":L$(C20*C4)="*":L$(C2)=L$:? #C3;Cr$;L$;Cr$
22050   For X=I To Li:? #C3;Z$(X*Z81-Z79,X*Z81-Zll+Asc(Z$(X*Z81-Zll))):Next X
22070   M=C20+C8:? #C3;Cr$;L$;Cr$:Return :Endif 
22072 If Len(M$)=O:Hz(Bbs)=O:Idx$(Bbs;)="":Goto 22080:Endif 
22074 Hz(Bbs)=Dpeek(Adr(M$(Len(M$)))-C6)
22075 Wk1=Dpeek(Adr(M$(Len(M$)))-C2)+Peek(Adr(M$(Len(M$))))*(C256*C256)+Dpeek(Adr(M$(Len(M$)))-C4)
22076 Wk2=Int(Wk1/(C256*C256)):Idx$(Bbs;C3,C3)=Chr$(Wk2):Wk1=Wk1-Wk2*(C256*C256)
22077 Wk2=Int(Wk1/C256):Idx$(Bbs;C2,C2)=Chr$(Wk2):Wk1=Wk1-Wk2*C256
22078 Idx$(Bbs;I,I)=Chr$(Wk1)
22080 If Par(75) Then Goto 22100
22082 Gosub 1000:Subj$=Subj$,"                             ":Tcl$=Tcl$,"                    "
22084 Msg$="",Tcl$,From$,Subj$,Td$,Ti$,Chr$(Li),""
22090 For X=I To Li:Msg$(Len(Msg$)+I)=Z$(X*Z81-Z79,X*Z81-Zll+Asc(Z$(X*Z81-Zll))):Next X
22093 Msg$=Msg$,Cr$,Chr$(255):Dpoke Adr(Msg$(C6)),Optn(90)
22094 X=Len(Msg$):Dpoke Adr(Msg$)+C2,X:Dpoke Adr(Msg$)+126,X-C128
22100 Hz(Bbs)=Hz(Bbs)+I:Mn=Hz(Bbs):Dpoke Adr(Msg$),Mn:Dpoke Adr(Msg$(C8)),Mn:Dpoke Adr(Msg$)+C17,Mn1
22130 Gosub 600:If Bbs>24 Or Y<Optn(15+Bbs):Goto 22200:Endif 
22140 ? Cr$;"Aaaarrrggh...  I'm out of space";Cr$;Cr$;"I'll go delete some old messages"
22150 ? "and be right back.";Cr$;"Sit back and relax for a moment.":Mflag=I:Gosub 5600
22160 Open #I,C8,O,"D8:MTEMP.DAT":Rput #I,Msg$
22170 Gosub 5800:Close #I:Open #I,C4,O,"D8:MTEMP.DAT":Rget #I,Msg$
22190 ? Cr$;"Well I'm back. Sorry for the wait.":Goto 22130
22200 ? Cr$;"Saving message";:If  Not Email:? " #";Mn;:Endif :? 
22210 Wk1=Usr(1576,C6,Adr(Idx$(Bbs;))):If Wk1>I:Goto Ma:Endif 
22220 L$=Idx$(Bbs;)
22280 Bput #C6,Adr(Msg$),Len(Msg$):Wk1=Usr(1573,C6,Adr(Idx$(Bbs;)))
22290 If Wk1>I:Goto Ma:Endif 
22300 If Len(M$)+C7>B Then Gosub 5900
22310 M$(Len(M$)+I)=Msg$(I,C4),L$
22320 Trap 22340:If  Not Email:? #C3;"Msg ";:? #C3; Using "#####",Mn;:? #C3;" to ";Tcl$;" on ";Bbs$
22330 Else :? #C3;"E-mail to ";Tcl$:If Tcl$=Pw$(C5,C5+Len(Tcl$)-I):Par(C4)=Par(C4)+I:Endif :Endif 
22340 Trap Etr:Am=Am+I:Bpar(C5)=Bpar(C5)+I:Bpar(C3)=Bpar(C3)+I:Gosub 7700:Par(C10+I)=I:M=Bbs
22350 If  Not Email:Pw$(48,48)=Chr$(Asc(Pw$(48))+I):Endif :Return 
23000 Rem   Message Misc Processing  
23010 Summ=C2:Goto 19000
23020 If F*C7+I>Len(M$) Then M$(F*C7-C6)="":Goto 23040
23030 M$(F*C7-C6)=M$(F*C7+I)
23040 Par(C10+I)=I:Trap 23060:If  Not Email:? #C3;"Msg ";:? #C3; Using "#####",Mn;:? #C3;" deleted on ";Bbs$
23050 Else :? #C3;"E-Mail to ";Tcl$;" from ";From$;" deleted":Endif 
23060 Trap Etr:If Tcl$=Name$ And Email Then Par(C4)=Par(C4)-I
23070 Am=Am-I:Bpar(C5)=Bpar(C5)-I:Mflag=O:Gosub 7700:If Flo=I Then Xm=Xm-I
23080 Return 
23090 X=O:From=X:Tu=X:Flo=X:If A$="" Then Return 
23100 X=X+I:If X>Len(A$) Then 23160
23110 If A$(X,X)>="0" And A$(X,X)<="9" Then From=From*C10+Val(A$(X,X)):Goto 23100
23120 If A$(X,X)<>"-" Then 23160
23130 X=X+I:If X>Len(A$) Then 23170
23140 If A$(X,X)>="0" And A$(X,X)<="9" Then Tu=Tu*C10+Val(A$(X,X)):Goto 23130
23150 Goto 23170
23160 Tu=From:Flo=I:Goto 23180
23170 Flo=I:If Tu<From Then Flo=-I
23180 If X<Len(A$) Then A$=A$(X+I):Return 
23190 A$="":Return 
23200 If From>65535 Then From=65535
23210 Mn=From:Y=I:T=Am
23220 If Y>T Then 23260
23230 F=Int((Y+T)/C2):If Mn>Dpeek(Adr(M$)+F*C7-C7) Then Y=F+I:Goto 23220
23240 If Mn<Dpeek(Adr(M$)+F*C7-C7) Then T=F-I:Goto 23220
23250 Return 
23260 If Flo Then 23290
23270 If Mn<Dpeek(Adr(M$)+F*C7-C7) And F<Am Then F=F-I
23280 Return 
23290 If F<Am And F>I Then F=F+I
23300 Return 
24000 Rem     Function [P] & [X]     
24010 Gosub C10:? "Current profile for :";Cr$
24015 ? "    ";Pw$(C5,24)
24018 ? "(0) Nickname ............ ";Pw$(107,116)
24019 ? "    Access Level ........ ";Asc(Pw$(49,49))
24020 ? "(1) Password ../..Age.... ";Pw$(I,C4);"  /  ";Asc(Pw$(57))
24025 ? "(2) Phone Number ........ ";Pw$(C20+C5,C12*C3)
24026 L$="Yes":If Pw$(C32+C6,C32+C6)=Cr$:L$="No":Endif 
24028 ? "(3) Clear screens ....... ";L$
24030 ? "(4) Line length ......... ";Zll
24040 ? "(5) Page break length ... ";Par(77)
24080 L$="Off":If Asc(Pw$(C50+C3))&C2 Then L$="On"
24085 ? "(6) Time display ........ ";L$
24090 L$="On":If Asc(Pw$(106))&C16 Then L$="Off"
24095 ? "(7) Line numbering ...... ";L$
24100 L$="Off":If Asc(Pw$(106))&C32 Then L$="On"
24105 ? "(8) Pause at base end";Cr$;"    for message entry ... ";L$
24110 L$="Off":If Asc(Pw$(106))&64 Then L$="On"
24115 ? "(9) Quick-scan select ... ";L$;Cr$
24120 ? "To change your age, use function <U>"
24130 If Pw>C4:? " For User statistics...use function X ";Cr$:Endif 
24135 Trap Etr:? "Enter # to change or <cr> to continue ";:Gosub 200
24137 On Find("1234567890",X$,O)+I Goto 24150,24165,24210,24230,24240,24250,24160,24260,24270,24280,24350
24150 ? :Return 
24160 Pw$(C50+C3,C50+C3)=Chr$(Asc(Pw$(C50+C3))%C2):Goto 24000
24165 ? Cr$;"New password (4 char): ";:Gosub Reply
24170 If Len(L$)<>C4 Then 24165
24175 Z$=Pw$:Z$(I,C4)=L$
24180 Se=O:Gosub 29210:If Se=I Then For X=I To 2000:Next X:Goto 24000
24185 F$="D1:PAS.IDX":Gosub 6600:For X=I To Int(Len(M$)/C7):D$=M$(X*C7-C6,X*C7-C3)
24190   If D$=Pw$(I,C4):Pop :Else :Next X:Endif 
24195 M$(X*C7-C6,X*C7-C3)=Z$:Close #I:Open #I,C8,O,"D1:PAS.IDX":? #I;M$;:Close #I
24199 ? #3;"***** CHANGED PASSWORD *****"
24200 Pw$(I,C4)=Z$:Goto 24000
24210 ? Cr$;"Enter your FULL phone #";Cr$;"XXX-XXX-XXXX : ";:Gosub Reply:If Len(L$)<>C12 Then 24210
24220 Pw$(25,36)=L$:Goto 24000
24230 X$="":If  Not At:X$="":Endif :If Pw$(C32+C6,C32+C6)<>Cr$:X$=Cr$:Endif :Pw$(C32+C6,C32+C6)=X$:Goto 24000
24240 ? Cr$;"Max line length  20-80 [default=40]: ";:Gosub 300:Trap 24245:Zll=40:Zll=Val(L$)
24245 Trap 24000:Pw$(37,37)=Chr$(Zll):Goto 24000
24250 ? Cr$;"Page-break Length";Cr$;"(Zero turns page-break off): ";:Gosub 100:Trap 24000
24252 Par(77)=Val(L$):Pw$(101,101)=Chr$(Par(77)):Goto 24000
24260 Pw$(106,106)=Chr$(Asc(Pw$(106))%C16):Goto 24000
24270 Pw$(106,106)=Chr$(Asc(Pw$(106))%C32):Goto 24000
24280 Pw$(106,106)=Chr$(Asc(Pw$(106))%C64)
24282 If  Not (Asc(Pw$(106))&C64) Then Goto 24000
24284 Gosub C10:? Cr$;"Enter Y to scan the base";Cr$
24285 For M=I To Nbbs
24290   A=M:Am=O:While A>C8:A=A-C8:Am=Am+I:Endwhile 
24300   If Int(C2^(A-I)+0.5)&Asc(Pw$(56-Am))
24310     ?  Using "###",M;:? " ";Bbna$(M*C16-15,M*C16);"      (Y/N) ";:Gosub 6100:Else :Goto 24340:Endif 
24320   Y=Asc(Pw$(104-Am)):If X:Y=Y!(Int(C2^(A-I)+0.5)):Else :Y=Y&(255-(Int(C2^(A-I)+0.5))):Endif 
24330   Pw$(104-Am,104-Am)=Chr$(Y)
24340 Next M:Goto 24000
24350 ? ;Cr$;"New Nickname : ";:Gosub 300:If Len(L$)<9 Then L$=L$,"          "
24360 Pw$(107,116)=L$:Nick$=Pw$(107,116):Goto 24000
24500 Gosub 5000:Gosub C10:Edit$="#####":? "User Statistics ................... ";Cr$
24510 ? "Number of calls ........       ";:?  Using Edit$,Asc(Pw$(39))
24512 X=40:Gosub 7800:? "First call ............. ";D$
24513 X=43:Gosub 7800:? "Last call .............. ";D$
24515 ? Cr$;Cr$;"Index calculation";Cr$
24525 ? "Upload Files ";:?  Using "###",Asc(Pw$(46));:? " / Sectors.... ";:?  Using Edit$,Upar(I)
24530 Wk1=Asc(Pw$(48))
24560 ? "Messages entered ";:?  Using "###",Wk1;:? " x 25 .... ";:?  Using Edit$,Wk1*25
24590 ? "          Total Credits ...... ";:?  Using Edit$,Upar(I)+Wk1*25:? 
24610 ? "Download Files ";:?  Using "###",Asc(Pw$(47));
24620 ? " / Sectors.. ";:?  Using Edit$,Upar(C2)
24650 ? Cr$;"Your index is ................ ";Str$(Upar(O))
24660 ? "Access Level .................    ";Asc(Pw$(49)):Goto Ma
25000 Rem    File Section Module    
25005 ? "Powering up library system...":Gosub 7100
25010 Poke 1549,O:Close #I:F$=Cfile$(C7;),"USER.DAT":Open #I,C8,O,F$
25012 If Len(Pw$)>124:Poke 1036,I:Bput #I,Adr(Pw$),127:Else :Poke 1036,O:Bput #I,Adr(Pw$),124:Endif :Close #I
25020 Poke 1024,Ansi:Poke 1025,At:Poke 1026,Lf:Poke 1027,Baud:Poke 1028,Bpar(C8):Poke 1029,Zll:Poke 1030,Sy
25022 Poke 1033,Int(Optn(Val(Cfile$(C6;C2,C2)))):Poke 1031,Bpar(I):Poke 1032,Bpar(C2)
25023 Dpoke 1034,Int(Bpar(C6)/Peek(1033))
25030 Move 9544,Adr(Z$),200:F$=Cfile$(C7;),"WINDOW.DAT":Open #I,C8,O,F$:Bput #I,Adr(Z$),200:Close #I
25035 X=Usr(Adr("h )H%H@HpPv"))
25050 Poke 1549,O
25060 Out$="        ",Str$(Par(64)):Out$=Right$(Out$,8)
25070 Move Adr(Out$),1040,8
25160 X=Usr(1557,I):Run "D1:MODULE.54"
25163 Close #I:F$=Cfile$(C7;),"USER.DAT":Open #I,C4,O,F$:If Peek(1036):Pw$(127)=" ":Bget #I,Adr(Pw$),127:Else 
25165   Pw$(124)=" ":Bget #I,Adr(Pw$),124:Endif :Close #I
25166 F$=Cfile$(C7;),"WINDOW.DAT":Open #I,C4,O,F$:Out$(200)=" ":Bget #I,Adr(Out$),200:Close #I
25167 Move Adr(Out$),9544,200
25170 Move 1040,Adr(Out$),C8:Par(64)=Val(Out$(I,C8)):Bpar(C6)=Int(Dpeek(1034)*Peek(1033)):Out$=Str$(Bpar(C6))
25171 X=183:Gosub 900:Bpar(I)=Peek(1031):Out$=Str$(Bpar(I)):X=166-Len(Out$):Gosub 900
25172 Bpar(C2)=Peek(1032):Out$=Str$(Bpar(C2)):X=172-Len(Out$):Gosub 900
25180 Set 15,I:Pop :Pop :Pop :Pop 
25190 Gosub 1600:Gosub 400:Gosub C10
25200 Goto Ma
25201 Rem This file module courtesy of Clyde at the Final Frontier (215)624-6347
26000 Rem  Update Age ? 
26010 Wk1=Asc(Pw$(57))
26020 ? Pw$(38,38):? "We got ya down as ";Wk1;" years old"
26030 ? "Ya had another birthday, huh?":? :? "Would you like to change your age? ";:Gosub 6100:If  Not X Then Return 
26040 ? "What is your updated age? ";:Gosub Reply:Trap 26040:Wk1=Val(L$):Trap Etr:If Wk1>99 Then Goto 26040
26043 If Wk1=Asc(Pw$(57,57)) Then ? "No change in age ":Goto Ma
26045 If Wk1<>(Asc(Pw$(57,57))+I) Then ? Cr$;"You can only add 1 year at a time":Goto 26040
26050 Pw$(57,57)=Chr$(Wk1):? :? "See ya next year!":? :Trap Etr:Goto Ma
28000 Rem       Logon Sequence       
28010 Out$="                    ":X=C4:Gosub 900:Out$(C20)="":X=C128-C4:Gosub 900:Bbs$=Bbna$:Par(C5)=I
28020 Par(C4)=O:Par(11)=O:Pw=O:Poke 752,O:Gosub 1000:Lot$=Ti$:Ll$=Name$:Out$=" On ",Ti$:X=55:Gosub 900
28025 If Sy:Baud=C14:Endif 
28026 Bl=300:Par(68)=0.206:If Baud:Bl=1200:Par(68)=0.637:If Baud=C12:Bl=2400:Par(68)=0.966:Endif :Endif 
28027 If Baud=C14:Bl=9600:Par(68)=3.2:Endif 
28030 Gosub 7600:Par(64)=Y:Poke 1787,Int(Y/65536):Dpoke 1785,Y-Peek(1787)*65536
28031 Par(79)=O:Xm=O:If Sy:Goto 28070:Endif 
28040 ? Cr$;"Hit <return> ";:Gosub 200:If X$<>"" And X$<>Cr$:Goto 28040:Endif 
28060 If X$<>Cr$:At=O:Par(79)=I:Gosub Om:Gosub 6400:Endif 
28070 Out$="Ascii/ ":If At:Out$="Atari/ ":Endif :Out$(9-Len(Str$(Bl/100)))=Str$(Bl/100):X=73:Gosub 900
28120 ? Cr$;E$(Cst(I,O),Cst(I,I))
28130 If At:? Cr$;"ATASCII ";:Else :? Cr$;"ASCII ";:Endif :? Str$(Bl);" Baud connection at ";Lot$
28240 Pw$="":? Cr$;"Password  ";Cr$;"or RETURN if New ==> ";:Gosub Reply:Pw$=""
28250 If L$="" Then Gosub 29000:Goto 28340
28270 Trap 28300:For X=I To Int(Len(M$)/C7):D$=M$(X*C7-C6,X*C7)
28290   If D$(I,C4)=L$:Gosub 8300
28294     Wk1=Usr(1576,I,Adr(D$)+C4)
28295     Pw$(125)=" ":Bget #I,Adr(Pw$),125:Pop :Goto 28310:Endif :Next X
28300 Trap Etr:Xm=Xm+I:If Xm=C3:? Cr$;"Security Override...":Goto 31000:Else :? Cr$;"Wrong, try again":Goto 28240:Endif 
28310 Pw$(125,127)=D$(C5)
28320 ? Cr$;"Please complete your phone number";Cr$;"***-***-";:Z$=Pw$:Pw$="":Gosub Reply:Pw$=Z$
28330 If L$<>Pw$(C32+I,C32+C4) Then 28300
28335 If Pw$(C32+C6,C32+C6)<>Cr$:Pw$(C32+C6,C32+C6)="":If  Not At:Pw$(C32+C6,C32+C6)="":Endif :Endif 
28340 Bpar(C14+I)=I:Zll=Asc(Pw$(37)):Pw$(39,39)=Chr$(Asc(Pw$(39))+I):Pw=Asc(Pw$(49))
28342 Upar(I)=Asc(Pw$(119))*C256*C256+Asc(Pw$(120))*C256+Asc(Pw$(121))
28344 Upar(C2)=Asc(Pw$(122))*C256*C256+Asc(Pw$(123))*C256+Asc(Pw$(124))
28350 Name$=Pw$(C5,24):Out$=Name$:X=C4:Gosub 900:Gosub 5000
28355 Edit$=" ",Str$(Asc(Pw$(57))):Out$=Right$(Edit$,C2):X=146:Gosub 900
28360 Nick$=Pw$(107,116):Out$=Nick$:X=44:Gosub 900
28370 If Nick$(I,I)=" " Then Nick$=" ":Goto 28381
28380 While Nick$(Len(Nick$))=" ":Nick$=Nick$(I,Len(Nick$)-I):Endwhile 
28381 Edit$="0",Str$(Pw):Out$=Right$(Edit$,C2),"/":X=113:Gosub 900
28382 If Nick$<>"F-net":Bpar(C4)=Bpar(C4)+I:Bpar(O)=Bpar(O)+I:Endif 
28383 Out$=Str$(Bpar(C4)),"-",Str$(Bpar(O)):X=33:Gosub 900
28384 X=43:Gosub 7800:A$=D$:D$=Td$:Gosub 8400
28385 X=Asc(Pw$(118)):If A$<>D$:If X>90:X=90+(C10+C5*Pw):Else :X=X+(C10+C5*Pw):Endif 
28390   Pw$(118,118)=Chr$(X):Endif :Xm=X-90
28391 D$=Td$:Gosub 8400:? #C3;Cr$;Cr$;Bpar(C4);"-";Name$;" ";Lot$;" ";Bl;" ";Xm
28392 ? #C3;"Lc: ";A$;" Lev: ";Pw;" / ";Upar(O);" Ph: ";Pw$(C20+C5,C32+C4):Gosub 30100
28393 If Nick$="F-net" Then Goto 1200
28394 If Peek(1590)>I:F$=Cfile$(C4;),"FNETACTV":Gosub 7050:Goto 31000:Endif 
28396 Gosub 1000:Wk1=O:Wk2=Peek(706):Wk3=C3+Optn(92):If Wk2<Wk3
28397   Wk1=Wk2*60+X:Wk3=Wk3*60-1
28398   If Wk1+Xm>Wk3:Xm=Wk3-Wk1:Else :Wk1=O:Endif :Endif :Bpar(C12)=Wk1
28399 Gosub 1750:If Sy:Poke 1596,I:Dpoke 560,Dpeek(1594):Endif 
28400 If Ansi=O:F$=Cfile$(C4;),"WELCOME",Str$(Random(1,3)),".ATA":Gosub 7000
28410 Else :F$=Cfile$(C4;),"WELCOME.XXX":Gosub 1770:Endif :Gosub Clm
28420 Call "COLOR" Using 34,1,2:Gosub C10:? Cr$;"Caller No... ";Bpar(C4);Cr$;"Online...... ";Name$
28430 ? "Level....... ";Pw;Cr$;"Last called. ";A$;Cr$;"Time Limit.. ";Xm;" min":Trap 28435:Poke C256*C6,Xm:? 
28435 Trap Etr
28440 If Len(Ll$)>0 Then ? "Last Caller: ";Ll$
28450 Call "RESET_COLOR"
28490 Rem 
28498 Rem 
28500 Rem 
28505 For X=I To 2000:Next X
28510 Edit$="00",Str$(Xm):Out$="/",Right$(Edit$,C3):X=64:Gosub 900
28520 If Bpar(C12):F$=Cfile$(C4;),"FNETWARN":Gosub 7050:Gosub 1900:Endif 
28540 Gosub 1100
28550 If Pw>C4:If  Not (Asc(Pw$(106))&I)
28554     Gosub 5300:Pw$(106,106)=Chr$(Asc(Pw$(106))!I)
28555     Gosub 1900:Endif 
28556   X=Asc(Pw$(100)):If X<>O
28557     ? Cr$;Cr$;"To vote or view results enter [V]ote"
28558     ? "from the Main=> prompt.";Cr$:Else :Gosub 15000:Endif :Goto 28580:Endif 
28559 Call "COLOR" Using 36,1,2
28560 Gosub 5300
28570 Call "RESET_COLOR"
28580 Gosub 7100:? Cr$;"while I check for E-Mail"
28600 Bbs=27:Gosub 8100:Par(C4)=O
28603 If Am:For F=I To Am:Idx$(29;)=M$(C7*F-C2):Wk1=Usr(1576,C6,Adr(Idx$(29;))):Gosub 8500
28606     If Tcl$=Name$:Par(C4)=Par(C4)+I:Endif :Next F:Endif 
28610 Par(9)=Asc(Pw$(51))&C2:Par(77)=Asc(Pw$(101))
28620 If Par(C4):? "Delivering mail ......":Email=I:L$="E;+":Goto 18010:Endif 
28640 ? "Sorry ";Nick$;" no mail today":? :Goto Ma
29000 Rem      Process New User      
29010 If Peek(1590)>I:F$=Cfile$(C4;),"FNETACTV":Gosub 7050:Goto 31000:Endif 
29030 F$=Cfile$(C4;),"PASAPP":Zll=80:Gosub 7050:Se=O:Nick$=""
29035 Pw$=" ":Pw$(C50+C8)=" ":Pw$(C2)=Pw$:? Cr$;"Please enter your name: ";:Gosub Reply
29037 If L$="":Goto 29035:Endif :If L$="OFF" Or L$="off" Then Goto 31000
29040 Pw$(C5,24)=L$:Name$=L$
29060 ? Cr$;"Enter your FULL phone #";Cr$;"XXX-XXX-XXXX : ";:Gosub Reply:If Len(L$)<>C12 Then 29060
29070 Pw$(25,36)=L$:If Se Then 29110
29075 ? Cr$;"Your age is: ";:Gosub Reply:Trap 29075:Wk1=Val(L$):If Wk1>99 Then Goto 29075
29077 Trap Etr:Pw$(57,57)=Chr$(Wk1)
29080 ? Cr$;"Enter a four character password: ";
29090 Gosub Reply:Pw$(I,C4)=L$:If Len(L$)<C4 Then 29080
29100 ? Cr$;"You entered:";Cr$;"Name........: ";Pw$(C5,24)
29110 ? "Phone number: ";Pw$(C20+C5,C32+C4);Cr$;"Age.........: ";Asc(Pw$(57))
29120 If Se<>C2 Then ? "Password....: ";Pw$(I,C4)
29130 ? Cr$;"Is this correct ? ";:Gosub 6100:If  Not X And Se Then 29060
29140 If  Not X Then 29035
29145 ? #C3;Cr$;Pw$(C5,C20+C4),Pw$(C20+C5,C32+C4),Asc(Pw$(57)),Pw$(I,C4)
29150 If Se Then Return 
29160 Gosub 6420:Pw$(C32+C7)="":X=C20+C20:Gosub 7900:X=C50-C7:Gosub 7900
29170 D$(9)=" ":Close #C7:Open #C7,C4,O,"D:VALIDATE.DAT":Input #C7,X:Bget #7,Adr(D$),C8+I:Close #C7
29180 Pw$(46)="":Pw$(49,56)=D$:For X=58 To 124:Pw$(X,X)="":Next X:Pw$(118,118)=Chr$(C10*C10)
29190 Pw$(107,116)="          ":Z$=Pw$
29200 If Pw$(I,C4)<>"NONE":Gosub 29210:Endif :Return 
29210 Gosub 7100:Gosub 8300:Trap 29260:L$(125)=" "
29220 Bget #I,Adr(L$),125:If L$(I,I)=Cr$ Or L$(I,C4)="" Then Goto 29260
29230 If L$(C5,24)=Z$(C5,24) And Usg$="" Then ? Cr$;"Name already in file":Pop :Pop :Goto 28130
29240 If Z$(I,C4)<>L$(I,C4) Or (L$(I,24)=Z$(I,24) And Usg$>"") Then 29220
29250 ? Cr$;"Sorry, password not available":Se=I:If Usg$="" Then Se=O:Pop :Goto 29080
29260 Trap Etr:Goto 2290
30000 Rem  Blacklist User 
30010 F=9:Gosub 6035:Poke 1550,Ccon
30100 If Asc(Pw$(53))&128:? "I'm sorry, but due to repeated";Cr$;"violations of this BBS's system"
30101   ? "policies and regulations, your user";Cr$;"priveleges have been revoked."
30110   ? #3;"  ****  BLACKLISTED * USER  ****":Goto 31130:Endif :Return 
30999 ? "Your daily time limit has expired.":For X=1 To 1000:Next X
31000 Rem  Logoff and Wait for Call  
31005 Ansi=O
31010 Pop :Pop :Pop :Pop :Gosub 5600:Gosub 1000:On Bpar(C14+I)+I Goto 31150,31020,31030,31070,31140
31020 If Len(L$)<C3 Then ? Cr$;"Leave, are you sure? (y/N) ";:Gosub 6100:If  Not X Then Goto Ma
31030 If Len(Pw$)>124:Goto 31070:Endif :? Cr$;"Save password (y/N) ";:Gosub 6100
31035 ? #C3;X$,X
31040 If X:Gosub 2100:Gosub 8300:D$=Pw$(I,C4),Idx$(28;):Wk1=Usr(1576,I,Adr(Idx$(28;))):? #I;Pw$(I,124)
31050   Wk1=Usr(1573,I,Adr(Idx$(28;))):F$="D1:PAS.IDX":Gosub 6600:Close #I:M$(Int(Len(M$)/C7)*C7+I)=D$
31060   Open #I,C8,O,F$:? #I;M$;:Close #I
31065   F$="D1:NAMES.DAT":Open #I,9,O,F$:? #I;Name$;:Close #I:Endif 
31070 F$=Cfile$(C4;),"LOGOFF":Gosub 7000
31080 Out$=Name$:If Len(Nick$)>I:Out$=Nick$:Endif :? Cr$;"Thanks for calling, ";Out$
31090 ? Cr$;"Please come back soon...";Cr$;Cr$;"Logged on  ";Lot$;Cr$;"Logged off ";Ti$
31100 Gosub 7600:Y=Y-Par(64):T=Int(Y/60):Y=Y-T*60
31110 ? Cr$;"Connect time ";T;" minutes ";Y;" seconds";Cr$;Cr$;"Bye for now....."
31120 ? Cr$;Cr$;"FoReM-XE Professional Version 5.4"
31130 ? #C3;Usg$;Cr$;"Logoff ";Ti$;"  ";Upar(O)
31140 Bpar(C14+I)=O:Gosub Clm:Out$="Off ",Ti$,"  ":X=55:Gosub 900:Gosub 800
31150 Trap 31000:Ccon=O:Poke 1550,Ccon:Pm=O:Sy=O:Spc=O:Wr2=I:At=C32:Lf=O:Par(70)=I:Poke 559,34
31160 Baud=Optn(88):Gosub Clm:For X=O To C256*C2:Next X:Xio 34,#C2,C128,O,"R:":For X=O To C256*C2:Next X
31170 Xio 34,#C2,192,O,"R:":For X=O To C256*C2:Next X:Gosub Om
31180 For X=O To C256*C4:Next X:? #C2;"+++";:For X=O To C256*C4:Next X
31190 ? :L$="ATZ":Gosub 31870:L$="ATH0":Gosub 31870:L$="ATH1":Gosub 31870
31200 Gosub Clm:Zll=40:Poke 752,I:Usg$="":Xm=O:Dl=O
31210 Bpar(17)=C32:Par(C16)=O:Par(C17)=O:Par(19)=O
31220 Poke 712,O:Poke 710,148:Poke 709,202
31230 If  Not Bpar(O) Or Len(Pw$)<127 Then 31280
31240 Gosub 7600:Y=Y-Par(64):T=Int(Y/60):Y=Y-T*60
31250 X=Asc(Pw$(118))-T:If X<O:X=O:Endif :Pw$(118,118)=Chr$(X)
31260 Trap 31280:X=43:Gosub 7900
31270 Gosub 8300:Wk1=Usr(1576,I,Adr(Pw$)+124):? #I;Pw$(I,124):Pw$=""
31280 Trap 31000:If Bpar(C8):A$="D1:.":Gosub 8200
31290   If Sec<C10:Close #C3:Gosub 6200:Erase F$:Open #C3,9,O,F$:Endif :Sec=O:Endif 
31300 ? ""
31310 For Bbs=I To Nbbs:Gosub 600:If (Optn(39+Bbs)*390)>(Optn(15+Bbs)-Y)
31320     Mflag=I:? "  Packing Message Base ";Bbs:Gosub 5800:Pop :Goto 31310:Endif :Next Bbs
31330 X=Peek(706)-Optn(92):If X<>C2 Or Bpar(C10)<>O:Goto 31450:Endif 
31340 ? "Auto Backup in Process":Cfile$(C2;)="D3:BACKUP>":Bpar(C10)=I
31350 Cfile$(I;)="D1:BASES>MESSAGE.*":Gosub 8800
31360 Cfile$(I;)="D1:EMAIL.*":Gosub 8800
31370 Cfile$(I;)="D1:PAS.*":Gosub 8800
31380 Cfile$(I;)="D1:CONFIG.DAT":Gosub 8800
31430 ? "Packing E-mail":Bbs=27:Mflag=C2:Gosub 5800
31440 Gosub 1000:? #C3;Cr$;"Automatic Backup Completed at ";Ti$:Poke 1590,I:Goto 1500
31450 Bbs=O:Poke 766,O:F$="D1:PAS.IDX":Gosub 6600
31460 Gosub Om:L$="ATS0=0":Gosub 31870
31470 L$="ATH0":Gosub 31870:Gosub 31860:Poke 1596,C5:Dpoke 560,Dpeek(1537):Gosub C10:X=Usr(1591,C5*3600)
31480 Gosub 1000:Position 9,C10:? ;"FoReM-XE  Professional":Position C16,C12:? Td$
31490 Position C16,C14:? Ti$:Position C5,C16:? ;"For available commands enter ?":? :? :? 
31500 X=Peek(706)-Optn(92):If X=O Or X=I Or X=C4 Then Bpar(C10)=O
31510 If X=C2 And Bpar(C10)=O:Goto 31000:Endif 
31520 If Peek(556):Goto 31540:Endif 
31530 If (X=C3 Or X=C4) And Peek(1590):Goto 1300:Endif 
31540 Status #C2,X:If Peek(747):Goto 31770:Endif 
31550 If Peek(764)=C256-I:Goto 31480:Endif 
31560 Bpar(C16)=I:Gosub 200:Bpar(C16)=O
31570 Bpar(18)=Find("%&LB?PECFM ",X$,O):If  Not Bpar(18):Goto 31480:Endif :L$="ATH1":Gosub 31870
31580 On Bpar(18) Goto 31590,31590,31610,31620,31630,31640,31690,31700,31710,31720,31609
31590 If Bpar(C8):Close #C3:Gosub 6200:A=C8+I:If Bpar(18)=I Then A=C8
31600   Open #C3,A,O,Cfile$(I;):Goto 31000:Endif 
31610 Sy=I:Goto 31840
31620 Bpar(C8+I)=I-Bpar(C8+I):Goto 31000
31630 F$=Cfile$(C4;),"WAITMENU":Gosub 7000:? "<Cr> to continue";:Gosub 200:Goto 31000
31640 ? Cr$;"Select base(s) to Pack":? " [#], [A]ll, or [E]-Mail":Bpar(C16)=I:Input X$:Bpar(C16)=O
31645 Trap 31649:Bbs=Val(X$):? Cr$;"Packing base #";Bbs:Mflag=C2:Goto 31680
31649 Trap Etr:X=Asc(X$)&127:X$=Chr$(X)
31650 If X$<>"A" And X$<>"E" Then Goto 31000
31660 If X$="A" Then ? Cr$;"Packing All":Mflag=O:Goto 31680
31670 If X$="E" Then ? Cr$;"Packing E-mail":Bbs=C20+C7:Mflag=C2:Goto 31680
31680 Gosub 5800:Goto 31000
31690 End 
31700 Gosub 7400:Goto 31000
31710 ? Cr$;"Select F-net Function":? " [B]ackup with Packet Prep"
31711 ? " [P]acket Prep":? " [S]end Packets":? " [M]essage Post":? :? " Select==> ";:Bpar(C16)=I:Gosub 200:Bpar(C16)=O
31712 If X$="B" Then Goto 31340
31713 If X$="P" Then Goto 1500
31714 If X$="S" Then Goto 1300
31715 If X$="M" Then Goto 1700:Rem 02/07/91
31716 Goto 31000
31720 Gosub C10:For Bbs=I To Nbbs:Gosub 600
31730   ? "Msg Base ";:?  Using "##",Bbs;:? " - ";:?  Using "######",Y;:? " / ";
31740   ?  Using "######",Optn(15+Bbs);:? " / ";:?  Using "###",Optn(39+Bbs):Next Bbs
31750 Bbs=27:Gosub 600:? "E-mail      - ";:?  Using "######",Y
31760 ? "<Cr> to continue";:Gosub 200:Goto 31000
31770 Gosub 200:X=Find("1235",X$,O):On X+I Goto 31540,31810,31780,31790,31800
31775 Goto 31540
31780 ? "Ringing":? #2;"ATA";:Goto 31540
31790 ? "No Carrier":Goto 31000
31800 Baud=C10:? "Connect 1200":Goto 31840
31810 Gosub 200:X=Find("03",X$,O):On X+I Goto 31000,31820,31830,31835
31820 Baud=O:? "Connect 300":Goto 31840
31830 Baud=C12:? "Connect 2400":Goto 31840
31835 Baud=C14:? "Connect 9600"
31840 Gosub 31860:If  Not Sy Then For X=I To C4*C256:Next X
31850 Par(70)=O:Wr2=O:Gosub Om:If  Not Sy:Ccon=I:Poke 1550,Ccon:Endif :Goto 28000
31860 Status #C2,X:If Peek(747):Get #C2,X:Goto 31860:Else :Return :Endif 
31870 Gosub 31860:For X=O To C2*C256:Next X:? #C2;L$;"";:? L$;" ";:For X=O To C2*C256:Next X:L$=""
31880 X=Usr(1591,C5*C20*C3)
31890 Status #C2,X:If Peek(747):Goto 31900:Endif :If Peek(556):Goto 31890:Endif :Pop :Goto 31000
31900 Get #C2,X:L$=L$,Chr$(X):If X<>155 And X<>13 And X<>C10:Goto 31880:Endif :? L$
31910 If L$(I,I)="0":Return :Endif :Pop 
31920 If Find(L$,"AT",O):L$="ATE0":Gosub 31870:Endif 
31930 If Find(L$,"OK",O):L$="ATV0":Gosub 31870:Endif :Goto 31000
31950 ? "Backing up ";Cfile$(I;):Return 
32000 Rem       Initilize BBS        
32010 X=Usr(Adr("h%M%iLfM)lK  K"))
32020 Dim F$(24),Out$(C256),Ms$(24),Bpar(36),Upar(C10),Par(81),Nick$(9),L$(125),Cst(C10,I),Dd$(C2),Mo$(C2),Yy$(C2)
32030 Dim Lot$(C8),Axd$(5),Cr$(I),X$(I),Td$(13),Ti$(C8),Ll$(40),Bbs$(C16),Usg$(C20),D$(13),Optn(112):Optn(112)=I
32040 Dim Mif$(30),Mdf$(30),Mt$(36),Edit$(C10*C3),Hold$(C10*C3),Idx$(29,C3)
32050 Dim A$(80),Name$(C20),Tcl$(C20),From$(C20),Subj$(30),Pw$(127),Z$(3700),Msg$(3700),Cfile$(C8,C32),Der$(11)
32055 Cfile$(C5;)="D1:SIGS>":Cfile$(C6;)="D1:UPLOADS>":Cfile$(C7;)="D8:":Cfile$(C8;)="D1:INVENTRY>":Rem PATH
32060 Dim Fnetname$(C20,C10*C3),Hz(27),Moment$(32)
32070 B=C7*1024:Dim M$(B+1):X=Fre(O)-1000:Dim E$(X):Par(48)=X:Spc=I:Dim Hh$(C2),Mm$(C2),Ss$(C2)
32110 Mt$="JanFebMarAprMayJunJulAugSepOctNovDec":Cfile$(C3;)="D1:PERM>":Cfile$(C4;)="D1:TEXT>"
32120 Mif$="D1:BASES>MESSAGE.IS1":Mdf$="D1:BASES>MESSAGE.DA1":Cr$=Chr$(155)
32130 Out$="Na                          CNo         Nk                          Mod         "
32140 Out$=Out$,"Cr       Db       Mg        Lvl         Lg                    Ag    Fil         "
32150 Out$=Out$,"Up 00 Dn 00 Sc 000 Fr 000   Mis       ":X=I:Gosub 900
32160 Open #C5,C4,O,"K:":Dpoke 560,Dpeek(1537):Dpoke 838,Dpeek(1552)
32170 Poke 752,I:? "   FoReM-XE Professional Version 5.4"
32180 ? "      From: Bob's Binary Shop":? "            Final Frontier BBS":? "            MoonBase Alpha BBS"
32181 ? "          Reading PERM Files";
32190 F$=Cfile$(C3;),"CUSTOM":Open #I,C4,O,F$:Input #I,L$:Input #I,L$:Wk2=I
32200 For Wk3=I To C4
32210   Input #I,L$:Input #I,L$:Cst(Wk3,O)=Wk2:E$(Wk2)=L$:Cst(Wk3,I)=Cst(Wk3,O)+Len(L$)-I:Wk2=Wk2+Len(L$)
32220 Next Wk3:Close #I:Wk1=21:Par(Wk1)=Wk2:Par(71)=I
32230 A$="DBSEL   FUNCTNHIFUNCTNLOSYSPAGE1SYSPAGE2MSGHELP MSGMENU1"
32240 For Wk3=I To 56 Step C8:F$=Cfile$(C3;),A$(Wk3,Wk3+C7):Gosub 6600
32250   E$(Par(Wk1))=M$:Par(Wk1+I)=Par(Wk1)+Len(M$):Par(33)=Par(Wk1+I):Wk1=Wk1+I:Next Wk3
32260 Close #I:Par(71)=O:X$="D":Goto 32280
32265 ? "    Insert data disk ...Press <rtn>";:Get #C5,X
32270 ? "      Log to [D]isk or [P]rinter";:Get #C5,X:X$=Chr$(X&127)
32280 If X$="D" Or X$="d":Bpar(C8)=I:Open #C3,9,O,"D1:USRLOG.DAT":Else :Open #C3,C8,O,"P:":Endif 
32290 ? "            Initializing";
32300 Poke 1589,Bpar(C8):Gosub 1400:Poke 1581,Optn(91)+48
32305 Gosub 32310:Goto 32500
32310 Open #I,4,0,"D1:FNETPARM.DAT":Trap 32330
32320 Input #I,L$:If L$(I,I)="1":Wk1=Val(L$(C2,C5))-9000:Fnetname$(Wk1;)=L$(C6):Endif :Goto 32320
32330 Trap Etr:Close #I
32340 Return 
32500 Gosub 1000:? #C3;Cr$;"FoReM initialized on ";Td$;" at ";Ti$;Cr$
32510 For X=I To Optn(O):If Int(C2^(X-I)+0.5)&Optn(C10)
32520     Close #I:F$="D1:.":F$(C2,C2)=Str$(X):Open #I,C6,C128,F$
32530     For Wk1=I To C4:Input #I,L$:Next Wk1
32540     Trap 32540:Input #I,L$:Y=Int(Val(L$)*Optn(X)):Trap Etr:If Y>Bpar(C6):Bpar(C6)=Y:Endif :Endif :Next X
32550 Out$=Str$(Bpar(C6)):X=183:Gosub 900:Out$=Str$(Bpar(C4)),"-",Str$(Bpar(O)):X=33:Gosub 900:Gosub 9400
32560 ? #C3;"Free Space ..... Data - ";Fre(O);"  Pgm - ";Fre(I);Cr$;"Transfer buffer (M$) ";B
32570 ? #C3;"Perm Data Store (E$) ";Par(48);"   Used ";Par(33)
32580 Bpar(9)=I:Bpar(C10)=I:X=Usr(1557,C3):Goto 31000