00001 option base 1 00002 dim A$*32767,PRIV$*17,M$*800,HELP$*80,CB$*800,CBSW$*5,CBCN$*100,LOC$(300)*30,C$*1000,BUF$*1000,BUFFER$*256,IMG1$*1000,IMG2$*1400,COMMAND$*256,SUBJ$*100 00003 declare all integer*2 00004 declare integer*4 ECD,TOTAL,AC0,AC1,AC2,LSTART,I,J,TEMP,MSGSTRT,MBXNUM,ENVELOPE,TEMPENV,P 00005 dim ON$*500,OFF$*500,ID$*500,HOME$*500,TEMP$*500,UN$*100,CHAN(40),FK$(75)*200,L$*256,T80$*128 00006 mat FK$=("")&nul$ 00007 def LEFT$(A$,L)=A$(1:L) 00008 characteristics "ON","NKI" 00009 def MID$(A$,S,L)=A$(S:S+L-1) 00010 print chr$(2);chr$(15);chr$(21);chr$(29);"SMail - (c)1987 Walter Stoneburner" 00011 def MIDR$(A$,S)=A$(S:len(A$)) 00012 print " (c)1987 Wizard Workshop & Company" 00013 let IMG1$=":SMAIL.PR :BASIC.PR :SSIWP.PR :CLI.PR :SED.PR :PED.PR :COBOL.PR :PASCAL.PR :LINK.PR :FORTRAN.PR :SSIMP.PR " 00014 let IMG1$=IMG1$&":CEO_CP.PR :CEO_WP.PR :CEO_ :BIPC2AOS.PR :BIAOS2PC.PR :PREDITOR.PR :DUMP_II.PR " 00015 let IMG1$=IMG1$&":MUPET.PR :GALAXY.PR :GOD.PR :DND.PR :DUNGEON.PR :DMASTER.PR :LANDSCAPE.PR :BAS.PR :ADVENT.PR :ADV.PR :WUMPUS.PR " 00016 let IMG1$=IMG1$&":LISP.PR :C:CC.PR :CHOMP.PR :CONSOLE.PR :F_77.PR :BIGBASIC.PR :MINES.PR OTHELLO.PR :WPML:LIB.PR :HDG.PR " 00018 def FNPRV=pos("*"&chr$(170),PRIV$(1:1)) 00019 def FNMGR=pos(chr$(170),PRIV$(1:1)) 00020 let CTRLD=0 00030 let IMG2$="SMail VSB Basic Word Perfect Operating System SED Simple Editor PED Monitor Cobol Compiler Pascal Compile Program Linker " 00031 let IMG2$=IMG2$&"Fortran Compiler Math Plan CEO Main Menu CEO Word Processing CEO Application Uploading to DG Downloading from DG Account Management System Dump Utility " 00032 let IMG2$=IMG2$&"Mupet Controller Galaxy Galaxy GOD Dungeons & Dragons Dungeon Dungeon Master Lazer Landscape Basic Compiler Adventure Advent Wumpus " 00033 let IMG2$=IMG2$&"LISP Compiler C Compiler Chomp Monitoring Consoles Fortran 77 Big Basic Mines Othello Word Perfect LibraryHotel Data General " 00039 let CBU,DMP,INV=0 00040 rem let FILENAME$=":Sdd:Udd:280.stoney:Wp.Cli" 00041 rem let SFIL=-1 00042 rem let USR$="ENG.HART" 00043 rem gosub 61400 00044 rem print ERR;FILENAME$ 00045 rem stop 00050 map integer*4 BYTE_PTR(2); integer*2 ARG_NUM,CONTROL_WRD 00060 let AC0,AC1,AC2,SFIL=0 00061 let I=sys("138",AC0,AC1,AC2) ! disable all Control Sequences 00062 let CONTROL_WRD=1 00064 let BYTE_PTR(2)=addr(BUFFER$) 00066 let AC2=addr(CONTROL_WRD) 00068 let BUFFER$=rpt$(" ",256) 00070 let I=sys("GTMES",AC0,AC1,AC2) 00072 let COMMAND$=ltrm$(rtrm$(BUFFER$)) 00074 let BUFFER$="" 00120 margin 0 00130 gosub 52060 ! get ready for mail 00131 who into A$ 00132 let PID=val(A$(5:8)) 00300 let KLUGE=1 ! 8000 return to 305 00301 goto 08000 00305 let ECD=0 ! line 305 00310 let V$="SMail v4.3" 00311 let MES=-1 00315 let CONFILE$=":SDD:UDD:ENG.HART:SMAIL.CON" 00320 directory i 00330 let UAF$=":SDD:UDD:ENG.HART:SMAIL.UAF" 00335 let HELP$=":SDD:UDD:ENG.HART:SMAIL.HLP" 00340 directory into HOME$ 00345 mat LOC$=("")&nul$ 00350 map US%*15;RN%*35;CN%*10;BO%*4;CE%*20;SM%*17;LL%*17;PW%*10;UD%*80;SW%*5; integer*2 SP,CH,PR,CPID 00355 gosub 42000 00360 let SM%=" " 00365 goto 08200 00370 if FNPRV then let P$=chr$(29)&"SMail> " else let P$=chr$(29)&"SMAIL> " 00371 gosub 04900 00375 if SM%(1:1)="-" then 08840 00380 let CBHLP$=":SDD:UDD:ENG.HART:SMAIL.CB.HLP" 00385 if HOME$(len(HOME$):len(HOME$))<" " then let HOME$=LEFT$(HOME$,len(HOME$)-1) 00390 acl "=" into M$ 00395 goto 00425 00400 print chr$(12);chr$(18);V$;" ";MES$;tab(64);date$;" ";time$ 00401 if MES<>0 then 00402 print chr$(10) 00403 gosub 55800 00404 end if 00405 let MES=0 00406 return 00425 if MES$="" and pos(ON$,"NRM")>0 then let MES$="** INCOMING MESSAGES DISABLED **" 00430 if PRIV$(1:1)="N" then 50000 00435 if PRIV$(2:2)="C" then let MES$=MES$&" -CLI ON-" 00440 gosub 00400 00445 print 01000 characteristics "ON","FKT","WRP","NKI","ULC","EB0","ST","OFF","ESC","FF","RAC","RAF","RAT","UCO","EB1" 01001 if CTRLD<>0 then 50000 01002 let CBPR=0 01004 let I=1 01006 let KLUGE=2 ! 8000 return to 1008 01007 goto 40000 ! which goes to 8000 01008 if SM%(1:1)="-" then 08840 ! line 1008 01009 enable handler RESM, resume at 01008 01010 linput eof 50000, prompt P$:C$ 01012 if fkey<>0 then print chr$(25);" ";chr$(25) 01014 disable handler 01016 let C$=ltrm$(rtrm$(C$)) 01018 enable handler PRINT_ERROR, resume at 01000 01020 let MES$="" 01021 let PA$="" 01022 let AR$="" 01030 if C$="" then 01031 if term$=chr$(12) then 00425 01032 print 01034 goto 01000 01035 end if 01040 let UC$=uprc$(C$) 01041 let P=pos(UC$,"/") 01042 if P>0 then 01043 let PA$=ltrm$(rtrm$(MIDR$(UC$,P))) 01044 let UC$=ltrm$(rtrm$(LEFT$(UC$,P-1))) 01045 end if 01046 let P=pos(UC$," ") 01047 if P>0 then 01048 let AR$=ltrm$(rtrm$(MIDR$(UC$,P))) 01049 let UC$=ltrm$(rtrm$(LEFT$(UC$,P))) 01050 end if 01055 if len(UC$)>0 and UC$=LEFT$("WHO",len(UC$)) and len(UC$)<4 then 05000 01056 if len(UC$)>1 and UC$=LEFT$("WUMPUS",len(UC$)) and len(UC$)<7 then 01057 swap ":SDD:UDD:PER.STONEY:WUMPUS.PR" 01058 goto 01000 01059 end if 01060 if UC$="CLS" then 00425 01065 if UC$="CB" then 10455 01070 if len(UC$)>0 and UC$=LEFT$("READ",len(UC$)) and len(UC$)<5 then 61000 01072 if len(UC$)>2 and UC$=LEFT$("DISPOSE",len(UC$)) and len(UC$)<8 then 62000 01074 if len(UC$)>1 and UC$=LEFT$("CATALOGUE",len(UC$)) and len(UC$)<10 then 55500 01080 if len(UC$)>1 and UC$=LEFT$("PASSWORD",len(UC$)) and len(UC$)<9 then 04930 01100 if len(UC$)>0 and UC$=LEFT$("BYE",len(UC$)) and len(UC$)<4 then 50000 01110 if len(UC$)>2 and UC$=LEFT$("EXIT",len(UC$)) and len(UC$)<5 then 50000 01113 if len(UC$)>3 and UC$=LEFT$("PROMPT",len(UC$)) and len(UC$)<7 then 02800 01114 if len(UC$)>2 and UC$=LEFT$("EXAMINE",len(UC$)) and len(UC$)<8 then 02300 01115 if len(UC$)>1 and LEFT$("PID",len(UC$))=UC$ and len(UC$)<4 then 02300 01120 if len(UC$)>1 and UC$=LEFT$("FILESTATUS",len(UC$)) and len(UC$)<11 then 01122 enable handler BAD_FILES, resume at 01000 01124 if AR$="" and PA$="" then let AR$="+" 01126 filestatus AR$&PA$ 01127 goto 01000 01130 end if 01140 if len(UC$)>0 and UC$=LEFT$("QUIT",len(UC$)) and len(UC$)<5 then 50000 01141 if len(UC$)>0 and UC$=LEFT$("LOGOUT",len(UC$)) and len(UC$)<7 then 50000 01142 if len(UC$)>0 and UC$=LEFT$("LOGOFF",len(UC$)) and len(UC$)<7 then 50000 01143 if len(UC$)>1 and UC$=LEFT$("SMAIL",len(UC$)) and len(UC$)<6 then 01144 print "At your service! (c)1987 Walter Stoneburner" 01145 print V$;tab(19);"(c)1987 Wizard Workshop and Company";chr$(10) 01146 gosub 55800 01147 goto 01000 01148 end if 01150 if len(UC$)>0 and UC$=LEFT$("INFORMATION",len(UC$)) and len(UC$)<12 then 55920 01160 if len(UC$)>1 and UC$=LEFT$("CHAT",len(UC$)) and len(UC$)<5 then 03000 01162 if len(UC$)>1 and UC$=LEFT$("STOP",len(UC$)) and len(UC$)<5 then 50000 01163 if len(UC$)>0 and UC$=LEFT$("USERNAMES",len(UC$)) and len(UC$)<10 then 51010 01164 if UC$="USERS" then 51010 01165 if len(UC$)>1 and UC$=LEFT$("CEO",len(UC$)) and len(UC$)<4 then 01166 if ltrm$(rtrm$(CE%))<>"" then cli "CEO" else print "Your profile indicates you do not have CEO access." 01167 if ltrm$(rtrm$(CE%))<>"" then let MES$="Returning to SMail" else print "You may modify your profile with PROFILE/MODIFY if you have a CEO account." 01168 if ltrm$(rtrm$(CE%))<>"" then goto 00425 else goto 01000 01169 end if 01170 if len(UC$)>1 and UC$=LEFT$("DATE",len(UC$)) and len(UC$)<5 then 01171 print date$ 01172 if fkey=14 then 08600 01173 goto 01000 01175 end if 01180 if len(UC$)>1 and UC$=LEFT$("TIME",len(UC$)) and len(UC$)<5 then 01181 print time$ 01182 goto 01000 01183 end if 01190 if len(UC$)>1 and UC$=LEFT$("MAIL",len(UC$)) and len(UC$)<5 then 60000 01195 if len(UC$)>1 and UC$=LEFT$("BECOME",len(UC$)) and len(UC$)<7 then 60910 01200 if len(UC$)>0 and UC$=LEFT$("HELP",len(UC$)) and len(UC$)<5 then 06000 01201 if UC$="?" then 06000 01210 if len(UC$)>1 and UC$=LEFT$("TYPE",len(UC$)) and len(UC$)<5 then 01212 let AR$=ltrm$(rtrm$(AR$)) 01214 if AR$="" then 01216 print "%SMAIL-Warning, No filename specified" 01218 goto 01000 01220 end if 01225 enable handler RESM, resume at 01000 01230 cli "TYPE "&AR$ 01235 disable handler 01240 goto 01000 01250 end if 01260 if len(UC$)>3 and UC$=LEFT$("PROFILE",len(UC$)) and len(UC$)<8 then 09000 01300 if len(UC$)>1 and UC$=LEFT$("SED",len(UC$)) and len(UC$)<4 then 01301 print "** Now entering SED Editor **" 01302 cli "X SED "&AR$&PA$ 01303 let MES$="Return from SED" 01304 goto 00425 01305 end if 01310 if len(UC$)>1 and UC$=LEFT$("FASS",len(UC$)) and len(UC$)<5 then 01312 cli "FASS "&AR$&PA$ 01314 goto 01000 01316 end if 01320 if len(UC$)>1 and UC$=LEFT$("PED",len(UC$)) and len(UC$)<4 then 01322 print "Press H for help, or E to Exit. **PED MONITOR**" 01324 cli "PED "&AR$&PA$ 01326 let MES$="Returning from PED" 01328 goto 00425 01329 end if 01330 if len(UC$)>1 and UC$=LEFT$("GALAXY",len(UC$)) and len(UC$)<7 then 01331 swap ":SDD:UDD:PER.STONEY:GALAXY.PR" 01332 let MES$="Returning From GALAXY" 01334 goto 00425 01335 end if 01340 if len(UC$)>1 and UC$=LEFT$("GOD",len(UC$)) and len(UC$)<4 then 01342 swap ":SDD:UDD:PER.STONEY:GOD.PR" 01344 let MES$="Returning From GOD" 01346 goto 00425 01347 end if 01350 if len(UC$)>1 and UC$=LEFT$("WWCO",len(UC$)) and len(UC$)<5 then 01352 print "%SMAIL-Information, Installing Wizard Workshop & Company Products; please wait." 01353 directory i 01354 cli "Copy WWCo :SDD:UDD:PER.STONEY:WWCO.CLI" 01355 cli "WWCO" 01356 goto 01000 01357 end if 01360 if UC$="WP" then 01361 print "*Word Perfect*" 01362 cli "WP "&AR$&PA$ 01363 let MES$="Return from Word Perfect" 01364 goto 00425 01365 end if 01370 if UC$="MP" then 01371 print "*Math Plan*" 01372 cli "MP "&AR$&PA$ 01373 let MES$="Return from Math Plan" 01374 goto 00425 01375 end if 01400 if UC$="CLI" then 01402 if AR$="" then 01404 if pos(PA$,"/OF")>0 then 01406 gosub 48000 01408 let SM%(2:2)=" " 01410 let PRIV$(2:2)=" " 01412 print "CLI Commands now disabled." 01414 gosub 49000 01416 goto 01000 01418 end if 01420 if pos(PA$,"/ON")>0 then 01422 gosub 48000 01424 let SM%(2:2)="C" 01426 let PRIV$(2:2)="C" 01428 print "CLI Commands are now enabled." 01430 gosub 49000 01432 goto 01000 01434 end if 01436 end if 01438 let AR$=ltrm$(rtrm$(AR$)) 01440 if AR$<>"" or PA$<>"" then 01442 cli AR$&PA$ 01444 goto 01000 01446 end if 01448 print "** Now entering CLI... Type BYE to exit back to mail" 01450 enable handler CLI_RETURN 01452 cli 01454 print "** Returning to SMail ";date$;" ";time$ 01456 disable handler 01457 gosub 55800 01458 goto 01000 01460 end if 01461 if UC$="CD" then let UC$="DIRECTORY" ! for IBM users 01470 if len(UC$)>2 and LEFT$("DIRECTORY",len(UC$))=UC$ and len(UC$)<10 then 01471 if AR$="" and pos(PA$,"/I") then 01472 directory i 01473 let PA$="" 01474 end if 01480 if AR$="" and pos(PA$,"/W") then 01481 let PA$="" 01482 let UC$="FILESTATUS" 01483 goto 01120 01485 end if 01490 if AR$="" then 01491 directory 01492 goto 01000 01493 end if 01494 directory AR$&PA$ 01495 directory 01496 goto 01000 01497 end if 01500 if len(UC$)>1 and LEFT$("MUPET",len(UC$))=UC$ and len(UC$)<6 then 01501 swap ":SDD:UDD:PER.STONEY:MUPET.PR" 01502 let MES$="Returning From MUPET" 01503 goto 00425 01504 end if 01510 if len(UC$)>1 and LEFT$("MINES",len(UC$))=UC$ and len(UC$)<6 then 01511 swap ":WPML:MINES.PR" 01512 let MES$="Return From MINES" 01513 goto 00425 01514 end if 01520 if len(UC$)>1 and LEFT$("OTHELLO",len(UC$))=UC$ and len(UC$)<8 then 01521 swap ":WPML:OTHELLO.PR" 01522 let MES$="Return From OTHELLO" 01523 goto 00425 01524 end if 01550 if len(UC$)>1 and LEFT$("DUNGEON",len(UC$))=UC$ and len(UC$)<8 then 01552 swap ":SDD:UDD:PER.STONEY:DND.PR" 01554 let MES$="Returning From DND" 01556 goto 00425 01560 end if 01561 if len(UC$)>2 and UC$=LEFT$("CHOMP",len(UC$)) and len(UC$)<6 then 01562 swap ":SDD:UDD:280.STONEY:CHOMP.PR" 01563 let MES$="Finished Chomping" 01564 goto 00425 01565 end if 01600 let J=0 01610 for I=1 to len(UC$) 01620 if pos("0123456789",UC$(I:I))=0 then let J=-1 01630 next I 01650 if J=-1 then 01900 01651 let UC$=UC$(1:6) 01660 let J=val(UC$) 01670 if J<>int(abs(J)) or J<1 then 01680 print "%SMAIL-Error, Illegal Message Number Specified" 01690 goto 01000 01695 end if 01700 let ENVELOPE=J 01710 goto 61075 01900 if PRIV$(2:2)="C" then 01905 cli C$ 01907 goto 01000 01910 end if 02000 print "Illegal or Ambiguous Command." 02001 print "For a list of commands available; type HELP" 02005 goto 01000 02006 print "Invalid PID number selected." 02007 goto 01000 02010 handler PRINT_ERROR 02020 print excode$ 02030 resume 02040 end handler 02300 let BUF$="" 02301 disable handler 02302 let TPID=0 02305 if AR$<>"" then 02311 02310 linput eof 50000, prompt "Examine PID: ":AR$ 02311 enable handler RESM, resume at 02006 02312 let TPID=val(AR$) 02320 enable handler MISSING_PID, resume at 02680 02330 if TPID<1 or TPID>256 or TPID<>int(abs(TPID)) then 02331 print "%SMAIL-Warning, PID Value Out Of Range" 02332 goto 00445 02333 end if 02340 let A$="" 02341 who TPID into A$ 02350 let A$=ltrm$(rtrm$(A$(9:30))) 02351 let MES$="Examine PID: "&str$(TPID)&" "&A$ 02352 gosub 00400 02353 print 02360 print A$ 02370 for I=1 to len(A$) 02380 print "-"; 02390 next I 02400 print 02401 if len(UC$)>0 and LEFT$("EXAMINE",len(UC$))=UC$ and len(UC$)<8 then 02402 who TPID 02403 tree TPID 02404 goto 00445 02405 end if 02410 if TPID<1 then 00445 02420 who TPID into A$ 02430 if pos(A$(9:30),":CON")>0 and A$(31:38)=":CLI.PR"&chr$(10) then 02440 let A$=A$(9:pos(A$(9:len(A$)),":")+7) 02450 else 02460 if A$(31:38)=":CLI.PR"&chr$(10) then 02470 let A$="Cli" 02480 else 02490 let A$=rtrm$(A$(31:len(A$)-1)) 02500 end if 02510 end if 02520 print A$; 02530 let A$="" 02540 tree TPID into A$ 02550 let A$=ltrm$(rtrm$(A$(27:len(A$)-1))) 02560 if A$="" then 02570 print 02580 goto 02680 02590 else 02600 who TPID into C$ 02610 if pos(C$(9:30),":CON")>0 then 02620 print " => "; 02630 else 02640 print " -> "; 02650 end if 02660 end if 02670 let BUF$=ltrm$(A$&" "&BUF$) 02680 if BUF$="" then 00445 02690 let TPID=val(BUF$(1:pos(BUF$," "))) 02700 let BUF$=ltrm$(rtrm$(BUF$(pos(BUF$," "):len(BUF$)))) 02710 goto 02410 02720 handler MISSING_PID 02730 print "** PID";TPID;" does not exist." 02740 resume 02750 end handler 02800 if pos(PA$,"/R")>0 then 02801 let P$="SMAIL> " 02802 let MES$="Prompt Restored" 02803 goto 00425 02804 end if 02809 if AR$<>"" then 02810 if pos(PA$,"/E")>0 then 02811 let P$=C$(pos(uprc$(C$),AR$):len(AR$)+pos(uprc$(C$),AR$)-1) 02812 else 02813 let P$=AR$&"> " 02814 end if 02820 else 02830 linput eof 50000, prompt "Enter new SMail prompt: ":C$ 02831 if ltrm$(rtrm$(C$))="" then 02832 print "Prompt not changed." 02833 goto 01000 02834 end if 02835 let P$=C$ 02838 if pos(PA$,"/E")<1 then let P$=P$&"> " 02840 end if 02850 let MES$="Prompt Changed" 02860 goto 00425 02900 enable handler BAD_USERN, resume at 01000 02901 if uprc$(C$)="OP" then let C$="" 02902 let C=-1 02905 acl ":SDD:UDD:"&C$ into A$ 02907 print "Enter Messages to be sent to user ";uprc$(C$) 02910 let C$=ltrm$(rtrm$(uprc$(C$)))&":CON" 02920 let CBU=-1 02930 goto 04210 03000 if pos(PA$,"/O")>0 then 08050 03001 if AR$<>"" then 03002 let C$=AR$ 03003 goto 03006 03004 end if 03005 linput eof 50000, prompt "CHAT REQUEST - Select PID Number or Username: ":C$ 03006 let C$=uprc$(rtrm$(ltrm$(C$))) 03007 if C$(1:3)="PID" then 03008 let C$=C$(4:len(C$)) 03009 goto 03006 03010 end if 03011 if C$="" then 01000 03012 if C$="+" or C$="-" then 08050 03013 if pos(PA$,"/A")>0 then let SY=-2 else let SY=0 03014 enable handler RESM, resume at 02900 03015 let CBU=0 03016 let C=val(C$) 03031 if C<1 then 01000 04000 handler BAD_USERN 04010 print "%SMAIL-Error, Bad PID or Username selected." 04011 print "%SMAIL-Information, Use WHO for an active list of users." 04020 resume 04030 end handler 04050 enable handler NO_PROCESS, resume at 01000 04060 who C into W$ 04070 let P=pos(W$,":",8) 04080 let W$=rtrm$(LEFT$(W$,30)) 04100 if pos(W$,":CON")>0 and W$(8:14)<>" OP:CON" then 04140 let W$=LEFT$(W$,P-1) 04160 print "Enter Messages To Be Sent To PID ";C;" User: ";MIDR$(W$,8) 04180 else 04181 if FNPRV=0 then 04182 print "You are not authorized to send to a non-console process." 04183 goto 01000 04184 end if 04185 print "Enter Messages To Be Sent To PID";C;chr$(7);chr$(14);" **NOT A CONSOLE**";chr$(15) 04186 end if 04210 print "Hit NEW LINE by itself to return to mail.";chr$(10);"NEW LINE"; 04211 if SY=-2 then print "/CR = send message ERASE PAGE = erase screen and send" 04212 if SY<>-2 then print "= send ID CR = send anonymous ERASE PAGE = clear screen" 04213 let I=4 04214 let CBPR=C 04216 let KLUGE=3 ! 8000 return to 4219 04218 goto 40000 ! which goes to 8000 04219 if SM%(3:3)="-" then print "%SMAIL-Information, **Incoming Messages Are Still Disabled -- Use CHAT ON **" ! line 4219 04222 if CBU=-1 then print "%SMail-Information, SMail will not sense other user's CHAT OFF status"&chr$(10)&" User may not be receiving messages." 04225 print "-----------------------------------------" 04230 linput eof 50000, prompt "":M$ 04235 gosub 48000 04236 if PRIV$(1:1)="-" then 08840 04238 enable handler CHAT_ERROR, resume at 01000 04240 let T=ord(term$) 04250 if M$="" and T=10 then 01000 04255 if T=10 and SY=-2 then 04400 04260 if T=13 then 04400 04270 if T=12 then 04450 04280 enable handler CHAT_ERROR, resume at 01000 04300 if SY=0 then 04301 let SY=-1 04302 let A$=M$ 04303 let M$="Message From User: "&UN$&" Using SMail at Console: "&str$(console) 04304 if CBU=-1 then gosub 04320 else send C,M$ 04305 let M$=A$ 04306 end if 04307 if CBU=-1 then gosub 04320 else send C,M$ 04308 if CBU=-1 and CNT<1 then 04309 print "%SMail-Warning, No such user logged on." 04310 goto 01000 04311 end if 04319 goto 04230 04320 enable handler RESM, resume at 04350 04322 let CNT=0 04324 for C=1 to 256 04326 who C into TEMP$ 04328 if pos(TEMP$,C$)>0 then 04329 send C,M$ 04330 let CNT=CNT+1 04331 end if 04350 next C 04352 return 04393 let M$="Message From User: "&UN$&" Using SMail at Console: "&str$(console) 04400 let M$=chr$(13)&M$&chr$(11) 04420 goto 04300 04450 let M$=chr$(12)&M$ 04460 goto 04300 04500 handler CLI_RETURN 04510 print "%SMAIL-Fatal, Error in spawning process to CLI" 04512 print "%SMAIL-Information, Probable cause: Too many spawned processes already." 04514 print "%SMAIL-Information, System Could Be Too Full" 04515 continue 04517 end handler 04600 handler CHAT_ERROR 04602 if excode<>100 then 04603 if fkey<>0 then 04604 print chr$(13);"%SMAIL-Information, Chat Session Terminated By Function Key" 04605 else 04610 print "%SMAIL-Warning, Chat Process No Longer Exists" 04620 print "%SMAIL-Information, User May Have Logged Off" 04630 end if 04640 resume 04642 end if 04643 print "%SMAIL-Information, User not accepting messages" 04644 resume 04650 end handler 04700 handler NO_PROCESS 04710 print "%SMAIL-Warning, No Such Process Exists" 04720 resume 04730 end handler 04800 handler BAD_FILES 04810 print "%SMAIL-Warning, Bad File Template Specified" 04820 resume 04830 end handler 04900 if ltrm$(PW%)="" then return 04901 linput prompt "SMail Password: ", noecho, eof 50000:TEMP$ 04905 if ltrm$(rtrm$(uprc$(PW%)))=ltrm$(rtrm$(uprc$(TEMP$))) then 04907 print chr$(13);chr$(11); 04908 return 04910 end if 04920 print "Incorrect password." 04925 goto 50000 04930 if AR$="" then linput prompt "Old password: ", noecho, eof 50000:AR$ 04931 print 04932 let AR$=ltrm$(rtrm$(uprc$(AR$))) 04934 let AR$=AR$(1:10) 04936 gosub 48000 04938 if AR$<>ltrm$(rtrm$(uprc$(PW%))) then 04940 print chr$(10);"Incorrect password." 04942 goto 01000 04944 end if 04946 linput prompt "New password: ", noecho, eof 50000:AR$ 04947 print 04948 linput prompt "Verify: ", noecho, eof 50000:TEMP$ 04949 print 04950 let AR$=ltrm$(rtrm$(uprc$(AR$))) 04952 let TEMP$=ltrm$(rtrm$(uprc$(TEMP$))) 04954 let AR$=AR$(1:10) 04956 let TEMP$=TEMP$(1:10) 04958 if AR$<>TEMP$ then 04960 print "Verification failure." 04962 goto 01000 04964 end if 04966 let PW%=AR$ 04968 gosub 49000 04970 if AR$="" then print "Password removed." else print "Password changed." 04972 goto 01000 05000 let MES=0 05001 let CBPR=0 05002 let I=3 05003 let KLUGE=6 05004 goto 40000 05010 if pos(PA$,"/")>0 then 08700 05011 let MES$="Active User List" 05012 if AR$<>"" then let MES$="Selective WHO" 05013 if pos(PA$,"/C")>0 then let MES$=MES$&" Continual Update" 05014 gosub 00400 05015 if AR$<>"" then 05200 05016 let J=0 05017 disable handler 05018 let W$="" 05019 for I=1 to 256 05021 disable handler 05022 enable handler FINISH_WHO, resume at 05060 05025 who I into W$ 05030 let W$=rtrm$(LEFT$(W$,30)) 05040 if pos(W$,":CON")>0 then 05042 let P=pos(W$,":",8) 05044 let C$=MIDR$(W$,P+1) 05046 let W$=LEFT$(W$,P-1) 05048 if LEFT$(MIDR$(W$,8),3)<>" OP" then 05050 if AR$="" or pos(MIDR$(W$,8)&chr$(26)&C$&chr$(26)&LEFT$(W$,8),AR$)>0 and AR$<>"" then 05051 let J=J+1 05052 print MIDR$(W$,8);tab(30);C$;tab(40);LEFT$(W$,8);" "; 05053 gosub 09900 05054 end if 05056 end if 05058 end if 05060 next I 05061 print J;" person(s) listed active." 05062 if pos(PA$,"/C")>0 then 05063 disable handler 05064 enable handler RESM, resume at 05000 05065 linput eof 50000, noecho, bytes 1, wait 5, prompt "waiting...":A$ 05066 disable handler 05067 print chr$(13);" ";chr$(13); 05068 end if 05069 goto 01000 05070 handler FINISH_WHO 05095 resume 05100 end handler 05200 let C$=ltrm$(rtrm$(AR$)) 05210 if C$="" then 05220 let AR$="" 05230 goto 05000 05240 end if 05250 enable handler RESM, resume at 05016 05260 let C=val(C$) 05261 for TEMP=1 to len(C$) 05262 if pos("0123456789",C$(TEMP:TEMP))=0 then 05016 05263 next TEMP 05270 disable handler 05280 if C<1 or C<>int(abs(C)) then 05282 print "%SMAIL-Warning, Illegal Numerical Syntax" 05284 goto 01000 05285 end if 05300 enable handler NO_PROCESS, resume at 01000 05310 who C 05320 disable handler 05330 goto 01000 05920 06000 enable handler CONTD 06001 let MES=0 06010 close #1 06020 enable handler RESM, resume at 06050 06021 if pos(AR$,"%")<>0 or pos(AR$,"*")<>0 then 06022 print "Special characters are not allowed in the Help Topic name." 06023 goto 01000 06025 end if 06030 open #1:HELP$ display, sequential, input 06035 enable handler RESM, resume at 06090 06040 goto 06100 06050 enable handler CONTD 06052 close #1 06055 print "Help index not found." 06060 disable handler 06070 goto 01000 06090 if AR$="" then 06091 print "Help is not available, sorry." 06092 else 06093 print "There is no help on the topic you requested." 06094 print "If you have abbreviated the topic name, make it longer." 06095 end if 06096 close #1 06099 goto 01000 06100 linput #1:A$ 06110 let A$=ltrm$(rtrm$(A$)) 06120 if A$="" then 06100 06130 let M$=uprc$(LEFT$(A$,pos(A$,"%")-1)) 06140 let MES$=A$(len(M$)+2:pos(A$,"%",len(M$)+2)-1) 06150 let TEMP$=A$(len(MES$)+len(M$)+3:len(A$)) 06160 let I=pos(M$,"*") 06170 if I>0 then let M$=M$(1:I-1)&M$(I+1:len(M$)) 06200 if len(AR$)>=I-1 and LEFT$(M$,len(AR$))=AR$ and len(AR$)<=len(M$) then 06210 enable handler HELP_FILE, resume at 01000 06220 gosub 00400 06235 close #1 06240 type TEMP$ 06250 goto 01000 06260 end if 06270 goto 06100 07950 handler HELP_FILE 07962 print chr$(10);"No help is available on that topic.";chr$(10) 07964 resume 07965 end handler 08000 characteristics into M$ 08010 let ID$=LEFT$(M$,pos(M$,chr$(10))-1) 08020 let ON$=M$(len(ID$)+2:pos(M$,chr$(10),len(ID$)+2)-1) 08030 let OFF$=M$(len(ON$)+len(ID$)+3:pos(M$,chr$(10),len(ON$)+len(ID$)+4)-1) 08040 let M$="" 08041 on KLUGE goto 00305, 01008, 04219, 08094, 10503, 05010, 09028, 60008, 61080 08042 goto 01000 08050 if C$="+" or pos(PA$,"/ON")>0 then 08052 characteristics "OFF","NRM" 08054 print "Incoming messages may now be received." 08056 gosub 48000 08058 let SM%(3:3)=" " 08060 gosub 49000 08062 end if 08064 if C$="-" or pos(PA$,"/OF")>0 then 08065 gosub 48000 08066 let SM%(3:3)="-" 08067 gosub 49000 08069 characteristics "ON","NRM" 08074 print "Incoming messages are now suppressed." 08079 end if 08084 if PA$="/O" then print "SMail-Error, Valid arguments are PID, USERNAME, or + and - for /ON and /OFF" 08089 let KLUGE=4 ! 8000 return to 8094 08090 goto 08000 08094 goto 01000 ! line 8094 08100 handler MAKE_UAF 08110 create UAF$ 08115 acl UAF$,"PER.STONEY,OWARE +,WR" 08117 resume 08120 end handler 08130 handler UAF_PROBLEMS 08150 if DR=0 then let DR=R 08155 resume 08170 end handler 08200 let MES$="Welcome to SMail!" 08201 enable handler MAKE_UAF, resume at 08210 08210 open #2:UAF$ direct, internal, outin,fixed 256, shared 08211 who into UN$ 08212 let UN$=UN$(9:pos(UN$,":",9)-1) 08220 disable handler 08223 if pos(chr$(170)&"*YN",SM%(1:1))>0 then 08500 08260 let R=0 08261 let DR=0 08265 enable handler UAF_PROBLEMS, resume at 08300 08266 let R=R+1 08270 input #2 record R data 00350 08271 if ltrm$(rtrm$(US%))="" and DR=0 then let DR=R 08280 if LEFT$(US%,len(UN$))<>UN$ then 08266 08281 let MES$="Last On: "&LL% 08282 let LL%=date$&" "&time$ 08285 let DR=R 08287 if SM%(1:1)="N" then 08300 08290 goto 08500 08300 print chr$(12);"You have never used SMail before." 08310 print 08311 let BO%,CN%,SW%="" 08315 let CH,SP,PR=0 08320 linput eof 50000, prompt "Do you wish to be able to use SMail (Y/N)? ", bytes 1:A$ 08330 let A$=uprc$(A$) 08340 if A$<>"Y" and A$<>"N" then 08310 08350 let SM%=A$ 08351 let RN%="-Observed-" 08360 let US%=UN$ 08365 let PW%="" 08370 let LL%=date$&" "&time$ 08380 let UD%=HOME$ 08400 if A$="N" then 08500 08410 print chr$(12);"Please enter the following questions to produce an SMail" 08415 print "user profile so other users may converse with you.";chr$(10) 08420 linput eof 50000, prompt "What is your real name: ":A$ 08421 let A$=ltrm$(rtrm$(A$)) 08422 if A$="" then 08420 08425 let RN%=LEFT$(A$,35) 08430 linput eof 50000, prompt "What alias would you like on the computer: ":A$ 08432 let CN%=uprc$(LEFT$(A$,10)) 08440 linput eof 50000, prompt "What is your campus BOX number: ":A$ 08441 if A$="" then let A$="NONE" 08442 let BO%=LEFT$(A$,4) 08450 print "What is your CEO mailing address, enter a blank line" 08451 print "if you don't know or don't have CEO access:" 08452 linput eof 50000, prompt "CEO ADDRESS: ":A$ 08453 let CE%=uprc$(LEFT$(A$,20)) 08500 disable handler 08502 let SP=1 08505 output #2 record DR data 00350 08506 let PRIV$=SM% 08507 let USR=DR 08509 close #2 08550 goto 00370 08600 characteristics "ON","FKT" 08610 linput eof 50000, prompt "SMail> ":C$ 08611 if fkey<>0 then print chr$(13); 08630 if fkey<>58 then 01014 08640 linput eof 50000, prompt "Sequence Code: ":C$ 08645 if fkey<>0 then print chr$(13);"-----------------------" 08650 characteristics "OFF","FKT" 08660 if fkey<>50 then 00425 08661 if C$="*!" then let C$=chr$(170) 08662 if len(C$)<1 then 00425 08670 let SM%(1:1)=C$(1:1) 08671 let MES$="Recognized" 08675 goto 08201 08680 print 08681 let I=-1 08682 goto 08821 08700 let MES$="User List" 08701 let TEMP$=" " 08702 if pos(PA$,"/U")=0 and pos(PA$,"/S")=0 and pos(PA$,"/B")=0 and pos(PA$,"/N")=0 and pos(PA$,"/A")=0 and pos(PA$,"/T")=0 then 05011 08703 if pos(PA$,"/A")>0 then let MES$=MES$&" Active" 08704 if pos(PA$,"/T")>0 then let MES$=MES$&" Today" 08705 if pos(PA$,"/A")>0 and pos(PA$,"/U")=0 then let PA$=PA$&"/U" 08710 gosub 00400 08712 enable handler CONTD 08714 close #2 08716 enable handler MAKE_UAF, resume at 08718 08718 open #2:UAF$ direct, internal, outin,fixed 256, shared 08720 enable handler UAF_PROBLEMS, resume at 08821 08722 let I=0 08724 let J=0 08726 if SM%(1:1)="*" then let PRIV$="*" 08728 let I=I+1 08730 input #2 record I data 00350 08732 if pos(PA$,"/T")>0 and LL%(1:8)<>date$ then 08728 08734 if pos(PA$,"/A")>0 and SP=0 then 08728 08735 if I=USR and SM%(1:1)="-" then 08840 08736 if ltrm$(US%)="" then 08728 08737 if int(J/21)=J/21 and J>0 and pos(PA$,"/C")=0 then 08738 print chr$(29);J;"user(s) listed so far... press NEW LINE to continue" 08742 linput eof 50000, prompt P$:C$; 08743 if ltrm$(rtrm$(C$))<>"" then 08680 08744 print chr$(13);chr$(11);chr$(23);chr$(11); 08745 end if 08748 print chr$(29); 08749 if LL%(1:8)<>date$ then print chr$(28); 08750 print CN%;" ";US%;" "; 08751 if pos(PA$,"/N")>0 then 08752 print RN%;" "; 08753 else 08754 print LL%;" "; 08755 end if 08756 if pos(PA$,"/U")>0 and pos(PA$,"/S")=0 then gosub 08785 08757 if pos(PA$,"/B")>0 and pos(PA$,"/S")=0 then print "BOX: ";BO%;" "; 08760 if FNPRV and pos(PA$,"/S")>0 then 08762 if SM%(1:1)="Y" then print "SMail User"; 08763 if SM%(1:1)="N" then print "Observed"; 08764 if SM%(1:1)="*" then print "Privileged"; 08765 if SM%(1:1)="-" then print "Suspended"; 08766 if SM%(1:1)=chr$(170) then print "SMail MGR"; 08770 end if 08778 print 08779 let J=J+1 08780 goto 08728 08785 if SP=0 then print "Not Active "; 08786 if SP=1 then print "Using SMail "; 08787 if SP=2 then if CH>0 then print using "On CB ## ":CH; else print "On CB "; 08789 if SP=4 then if PR>0 then print using "Chat to ### ":PR; else print "Using Chat "; 08790 if SP=3 then print "Using Who "; 08791 if SP=5 then print "Profile "; 08792 if SP=6 then print "Sending Mail "; 08793 if SP=7 then print "Reading Mail "; 08820 return 08821 let DR=USR 08822 input #2 record USR data 00350 08823 close #2 08824 disable handler 08825 if I<>-1 then print J;" User(s) Listed.";chr$(11) 08826 if I=-1 then 01012 else 01000 08840 print "Your SMail privileges have been suspended." 08842 print "You are not authorized to use SMail." 08860 goto 50000 09000 let CBPR=0 09001 let I=5 09002 let KLUGE=7 09003 goto 40000 09028 if AR$=UN$ then 09054 09030 if FNPRV=0 and pos(PA$,"/M")>0 then 09032 print "You are not authorized for user modifications." 09034 goto 01000 09036 end if 09038 if AR$="" then 09040 linput eof 50000, prompt "Profile Information for which user: ":AR$ 09042 let AR$=ltrm$(rtrm$(uprc$(AR$))) 09044 if AR$="" then 09046 print "No username specified." 09048 goto 01000 09050 end if 09052 end if 09054 enable handler CONTD 09055 close #2 09056 disable handler 09057 enable handler MAKE_UAF, resume at 09060 09060 open #2:UAF$ direct, internal, outin,fixed 256, shared 09065 disable handler 09070 enable handler UAF_PROBLEMS, resume at 09320 09080 let R=0 09090 let R=R+1 09100 input #2 record R data 00350 09101 if R=USR and SM%(1:1)="-" then 08840 09110 if LEFT$(US%,len(AR$))<>AR$ then 09090 09120 print chr$(10);"User PROFILE"; 09121 if FNPRV and pos(PA$,"/M") then print " Modifications"; 09122 if FNPRV and pos(PA$,"/R") then 09123 print " User RESET"; 09124 let SP=0 09125 if pos(PA$,"/P")>0 and FNMGR then 09127 let PW%="" 09128 print tab(40);"SMail Password cleared."; 09129 end if 09138 output #2 record R data 00350 09139 end if 09140 print chr$(10);"--------------------------" 09150 print "User selected: ";US% 09160 print "Real name: ";RN% 09170 print "Alias: ";CN% 09180 print "Box Number: ";BO% 09182 print "SMail Status: "; 09183 gosub 09185 09184 goto 09250 09185 if FNPRV then 09186 if SM%(1:1)=chr$(170) then print "SMail MGR"; 09200 if SM%(1:1)="-" then print "Suspended"; 09201 if SM%(1:1)="*" then print "Privileged"; 09202 if SM%(1:1)="Y" then print "SMail User"; 09203 if SM%(1:1)="N" then print "Observed - Not subscribing"; 09204 if pos("-*YN"&chr$(170),SM%(1:1))=0 then print "UNKNOWN [";SM%(1:1);"]"; 09205 print " "; 09207 end if 09208 print "CHAT-O"; 09209 if SM%(3:3)="-" then 09210 print "FF"; 09212 else 09214 print "N"; 09216 end if 09220 print " CLI-O"; 09221 if SM%(2:2)="C" then 09222 print "N"; 09223 else 09224 print "FF"; 09225 end if 09245 print 09247 return 09250 print "Last Login: ";LL% 09260 print "CEO Address: ";CE% 09261 if FNMGR and pos(PA$,"/P")>0 then print "Password: ";ltrm$(rtrm$(uprc$(PW%))) 09270 if FNPRV then print "Usr Directory: ";ltrm$(rtrm$(UD%)) 09271 if FNPRV and pos(PA$,"/D")>0 then 09272 if FNMGR=0 and pos("*"&chr$(170),SM%(1:1))>0 then 09273 print "You are not allowed to deleted a privileged user." 09274 goto 01000 09275 end if 09280 linput eof 50000, prompt "Delete This User? [Y/N] ", noecho, bytes 1:C$ 09281 let C$=uprc$(C$) 09282 if C$(1:1)="Y" then 09301 09283 print "No." 09284 end if 09285 if FNPRV and pos(PA$,"/M")>0 then 09400 09286 if LEFT$(US%,len(UN$))=UN$ and pos(PA$,"/M")>0 then 09400 ! modify self 09287 input #2 record USR data 00350 09288 if FNPRV=0 then 09292 close #2 09293 goto 01000 09295 end if 09300 goto 01000 09301 linput eof 50000, prompt "Yes... Are You Sure? [press # if so] ", noecho, bytes 1:C$ 09302 if C$(1:1)="#" then 09303 let SP=0 09304 let US%="" 09305 let SM%="N" 09306 output #2 record R data 00350 09307 print "YES";chr$(10);" -- User Deleted" 09308 else 09309 print "No." 09310 end if 09311 input #2 record USR data 00350 09312 goto 01000 09320 print "User not found." 09321 close #2 09322 goto 01000 09323 handler MODUSR 09335 print "Data entered is longer than desired field length." 09336 print "No change made." 09337 print 09338 continue 09340 end handler 09400 print "Modify SMail Account: ";US% 09410 linput eof 50000, prompt "Proceed (Y/N): ", noecho, bytes 1:A$ 09420 if A$="Y" or A$="y" then 09450 09430 print "No." 09440 goto 01000 09450 print "Yes." 09451 if SM%(1:1)=chr$(170) and FNMGR=0 then 09452 print "You may not alter the SMail Manager's Account." 09453 close #2 09454 goto 01000 09455 end if 09500 print "-MODIFY- User: ";US% 09503 disable handler 09507 enable handler MODUSR 09510 print "========================================" 09520 print "A) Real Name: ";RN% 09530 print "B) Alias: ";CN% 09540 print "C) Box Number: ";BO% 09550 if FNPRV then 09555 print "D) Privilege: "; 09556 else 09557 print "D) Status: "; 09558 end if 09560 gosub 09185 09580 print "E) Last Login: ";LL% 09590 print "F) CEO Account: ";CE% 09600 print 09610 print "S) Save Changes Q) Quit with No Save" 09620 linput eof 50000, prompt "PROFILE> ", noecho, bytes 1:A$ 09630 if A$="Q" or A$="q" then 09632 print "Quit. -No Save Performed-" 09633 disable handler 09635 close #2 09637 goto 01000 09638 end if 09640 if A$="A" or A$="a" then 09641 print "A) Change Real Name" 09642 linput eof 50000, prompt "New Name: ":RN% 09645 goto 09500 09647 end if 09650 if A$="B" or A$="b" then 09651 print "B) Change Alias" 09652 linput eof 50000, prompt "New Alias: ":CN% 09653 let CN%=uprc$(CN%) 09654 goto 09500 09655 end if 09670 if A$="C" or A$="c" then 09671 print "C) Change Box Number" 09672 linput eof 50000, prompt "New Box Number: ":BO% 09673 goto 09500 09675 end if 09680 if A$="E" or A$="e" then 09681 if FNPRV then 09682 print "E) Change Last Login Date&Time / Message" 09683 linput eof 50000, prompt "New Text: ":LL% 09684 goto 09500 09685 else 09686 print "You are not authorized to change that." 09687 end if 09688 end if 09690 if A$="F" or A$="f" then 09691 print "F) Change CEO Account Name For Mail Messages" 09692 linput eof 50000, prompt "New Account Name: ":CE% 09693 let CE%=uprc$(CE%) 09694 goto 09500 09695 end if 09700 if A$="S" or A$="s" then 09710 print "S) SAVE CHANGES -Saved-" 09720 output #2 record R data 00350 09730 input #2 record USR data 00350 09740 close #2 09745 disable handler 09750 goto 01000 09760 end if 09800 if A$="D" or A$="d" then 09801 if FNPRV=0 then 09802 print "You are not authorized to do that." 09803 goto 09500 09804 end if 09805 print "D) Change Privilege Status" 09806 print "Y: SMail User N: Observed *: Privileged -: Suspended" 09807 print "I: CLI-ON X: CLI-OFF E: Chat Enable D: Chat Disable" 09808 linput eof 50000, prompt "New Status: ", noecho, bytes 1:A$ 09809 let A$=ltrm$(rtrm$(uprc$(A$))) 09810 if A$="I" then 09811 let SM%(2:2)="C" 09812 goto 09831 09813 else 09814 if A$="X" then 09815 let SM%(2:2)=" " 09816 goto 09831 09817 else 09818 if A$="E" then 09819 let SM%(3:3)=" " 09820 goto 09831 09821 else 09822 if A$="D" then 09823 let SM%(3:3)="-" 09824 let SP=0 09825 goto 09831 09826 end if 09827 end if 09828 end if 09829 end if 09830 if pos("*YN-",A$)>0 then let SM%(1:1)=A$ else print "Invalid selection. "; 09831 gosub 09185 09832 goto 09500 09833 end if 09834 print "UNKNOWN -- Enter Menu Item A-F,S,Q" 09835 goto 09500 09900 if pos(PA$,"/L")>0 then 09901 print LOC$(val(C$(pos(C$,"N")+1:len(C$)))) 09902 return 09903 end if 09904 let K=I 09905 enable handler NO_PROC, resume at 10002 09906 if pos(PA$,"/E")>0 then 09907 runtime I into A$ 09908 print "Elapsed time on";A$(8:pos(A$,",")-1) 09909 return 09910 end if 09924 tree K into A$ 09934 who K into TEMP$ 09944 let A$=ltrm$(rtrm$(A$(28:31))) 09954 if A$(len(A$):len(A$))<" " then let A$=A$(1:len(A$)-1) 09955 if val(A$)=0 then 09970 09964 let K=val(A$) 09965 goto 09924 09970 who K into A$ 09971 let A$=A$(31:len(A$)-1) 09972 if pos(PA$,"/I")>0 then 09973 print A$ 09974 return 09975 end if 09976 for TMPI=1 to int(len(IMG1$)/15) 09977 if pos(A$,ltrm$(rtrm$(IMG1$(TMPI*15-14:TMPI*15)))) then 09978 print ltrm$(rtrm$(IMG2$(TMPI*20-19:TMPI*20))) 09979 return 09980 end if 09981 next TMPI 09982 let TMPI=pos(A$,".PR")-1 09983 if TMPI<1 then let TMPI=30 09984 let TMPJ=TMPI 09985 if TMPJ>1 and A$(TMPJ:TMPJ)<>":" then 09986 let TMPJ=TMPJ-1 09987 goto 09985 09988 end if 09989 if TMPJ<1 then let TMPJ=1 10000 print chr$(28);A$(TMPJ+1:TMPI);chr$(29) 10001 return 10002 print "-Unknown-" 10003 return 10004 handler NO_PROC 10452 let K=0 10453 resume 10454 end handler 10455 disable handler 10456 if FNMGR and pos(PA$,"/I") then let INV=-1 else let INV=0 10501 let KLUGE=5 ! 8000 return to 10503 10502 goto 08000 10503 if pos(ON$,"NRM")>0 then ! line 10503 10504 print "You may not use the CB unless you enable incoming messages with CHAT ON" 10505 goto 01000 10506 end if 10507 let MES$="SMail CB" 10508 gosub 00400 10509 print chr$(10) 10510 characteristics "ON","FKT","OFF","ESC" 10511 enable handler MAKE_UAF, resume at 10512 10512 open #2:UAF$ direct, internal, outin,fixed 256, shared 10513 disable handler 10514 enable handler CB_ERRORS, resume at 12025 10515 input #2 record USR data 00350 10516 let CBSW$="" 10517 let CBPR=0 10518 let CBCN$=ltrm$(rtrm$(uprc$(CN%))) 10519 if CBCN$="" then 10520 close #2 10521 print "You may not use CB unless you have a handle. Please use PROFILE." 10522 goto 01000 10523 end if 10524 let SW%="" 10525 let SP=2 10526 if FNMGR and pos(PA$,"/M")>0 then let PR,CH=0 else let PR=0 10527 let CPID=PID 10528 output #2 record USR data 00350 10529 if CH=0 and AR$="" then 10530 let CH=19 10531 print chr$(28);"You are now assigned to Channel";CH 10532 else 10533 if AR$<>"" then 10534 disable handler 10535 enable handler BAD_CHANNEL, resume at 10540 10536 if val(AR$)<>int(abs(val(AR$))) and val(AR$)<1 or val(AR$)>40 then gosub 30310 10537 if FNMGR and pos(PA$,"/I")>0 then let CH=-val(AR$) else let CH=val(AR$) 10538 if FNMGR and pos(PA$,"/M")>0 then let CH=0 10539 end if 10540 disable handler 10541 if FNMGR=0 and (CH<1 or CH>40) then let CH=19 10542 if CH<>0 then print chr$(28);"Welcome to Channel";abs(CH) else print chr$(28);"CB Monitor Mode Active" 10543 end if 10544 let CBCH=CH 10545 output #2 record USR data 00350 10546 print 10547 if CBCH=0 or pos(PA$,"/Q")>0 and FNMGR then print chr$(28);"CB quietly entered." else print 10548 enable handler CB_ERRORS, resume at 12025 10549 let CB$="just got on." 10550 if CBCH=0 or pos(PA$,"/Q")>0 and FNMGR then 10609 else 12000 10560 let CB$="has left CB and SMail."&chr$(127)&chr$(127) 10565 goto 12000 10600 if pos(CB$,chr$(127)&chr$(127))>0 then 50000 10603 if pos(CB$,chr$(127))>0 then 30090 10606 if pos(CB$,chr$(128))>0 then 13390 10609 let A$="" 10612 linput prompt chr$(2)&chr$(15)&chr$(21)&chr$(29)&A$, eof 10560:CB$; 10615 if term$=chr$(12) then print chr$(12); 11558 input #2 record USR data 00350 11559 let SP=2 11560 let CPID=PID 11561 output #2 record USR data 00350 11562 let ECD=0 11563 if SM%(1:1)="-" then 08840 11564 if SM%(3:3)="-" then 11565 let MES$="Forced Out Of CB" 11566 goto 00425 11567 end if 11568 if pos(CB$,chr$(23))>0 or pos(CB$,chr$(26))>0 then 11569 print chr$(12);"**INVALID CHARACTERS IN TEXT.. Please retype.**" 11570 goto 10600 11571 end if 11572 let CB$=A$&CB$ 11573 let A$=CB$ 11574 print chr$(2);chr$(15);chr$(21);chr$(29); 11575 if fkey<>0 then print chr$(25);" ";chr$(13);chr$(28);CB$ 11576 if fkey=0 then 12000 11577 if fkey=34 then 11578 print chr$(28);"Line deleted." 11579 goto 10609 11580 end if 11581 if fkey=16 then 11582 print 11583 print A$;chr$(2);chr$(15);chr$(21);chr$(28) 11584 print 11585 print chr$(28);"H: Highlight B: Blink U: Underline D: Dim -- Uppercase = ON Lowercase = OFF" 11586 linput eof 50000, noecho, prompt chr$(28)&"Text Attribute: ", bytes 1:M$ 11587 if M$="H" then let A$=A$&chr$(22) 11588 if M$="h" then let A$=A$&chr$(2) 11589 if M$="B" then let A$=A$&chr$(14) 11590 if M$="b" then let A$=A$&chr$(15) 11591 if M$="U" then let A$=A$&chr$(20) 11592 if M$="u" then let A$=A$&chr$(21) 11593 if M$="D" then let A$=A$&chr$(28) 11594 if M$="d" then let A$=A$&chr$(29) 11595 if pos("Hh",M$)>0 then print "Highlight "; 11596 if pos("Bb",M$)>0 then print "Blink "; 11597 if pos("Uu",M$)>0 then print "Underline "; 11598 if pos("Dd",M$)>0 then print "Dim "; 11599 if pos("HBUD",M$) then print "On" 11600 if pos("hbud",M$) then print "Off" 11601 if pos("HBUDhbud",M$)=0 then print "No Attribute Set" 11602 goto 10612 11603 end if 11604 if fkey=17 then 11605 let CB$=ltrm$(rtrm$(CB$)) 11606 let I=int((80-len(CB$))/2)-len(CBCN$)-3 11607 if I<1 then 11608 print chr$(28);"Line can not be centered." 11609 goto 10600 11610 end if 11611 let CB$=lpad$("",I)&CB$ 11612 print CB$ 11613 goto 12000 11614 end if 11615 if fkey=12 then 11616 let A$="123456789!123456789@123456789#123456789$123456789%123456789^123456789&123456789*" 11617 let A$=chr$(28)&chr$(22)&A$(1:len(CBCN$)+3)&chr$(2)&A$(len(CBCN$)+4:len(A$))&chr$(29) 11618 characteristics "CPL","255" 11619 print A$; 11620 characteristics "CPL","80" 11621 goto 10600 11622 end if 11623 if fkey=50 then 11624 linput eof 10560, noecho, prompt chr$(28)&"Press Function Key To Store Text--":M$ 11625 if fkey=0 then 11626 print chr$(28);"**TEXT NOT SAVED**"&chr$(10)&"No function key was pressed." 11627 goto 10600 11628 end if 11629 let FK$(fkey)=CB$ 11630 print chr$(28);"** Text Saved **"&chr$(10)&"Press key to send, or READ and key to get text." 11631 goto 12000 11632 end if 11633 if fkey=46 then 11634 linput eof 10560, noecho, prompt chr$(28)&"Press Function Key To Read--":C$ 11635 if fkey=0 then 11636 print chr$(28);"No function key pressed." 11637 goto 10612 11638 end if 11639 if FK$(fkey)="" then 11640 print chr$(28);"That function key has no text stored." 11641 goto 10612 11642 end if 11643 let A$=CB$&FK$(fkey) 11644 print chr$(28);"** TEXT READ INTO BUFFER **" 11645 goto 10612 11646 end if 11647 goto 13000 12000 let I=0 12001 let CB$=CB$&chr$(2)&chr$(29)&chr$(21)&chr$(15)&chr$(11) 12005 let CB$=chr$(13)&chr$(29)&"<"<rm$(rtrm$(CBCN$))&"> "&CB$&chr$(15)&chr$(21)&chr$(29)&chr$(2) 12010 let I=I+1 12020 input #2 record I data 00350 12021 if I=USR and SM%(1:1)="-" then 08840 12023 let ECD=0 12025 if ECD=24 or ECD=71163 or ECD=71154 then 10600 12026 if ECD=100 then 12010 12027 if ECD=70683 or ECD=77154 or ECD=559 then 10609 12040 if SP<>2 then 12010 12050 if CBPR>0 and PR=USR and CBPR=I or I=USR then 12052 send CPID,CB$ 12054 goto 12010 12056 end if 12058 if CBPR<>0 then 12010 12060 if PR<>0 then 12010 12061 if CBCH=0 then 12062 send CPID,CB$ 12063 goto 12010 12064 end if 12065 if CH=0 then 12066 send CPID,chr$(13)&chr$(29)&"["&str$(CBCH)&"] "&CB$(3:len(CB$)) 12067 goto 12010 12068 end if 12070 if CBSW$="" and abs(CH)=CBCH then 12072 send CPID,CB$ 12074 goto 12010 12076 end if 12080 if abs(CH)=CBCH and CBSW$<>"" and ltrm$(rtrm$(uprc$(SW%)))=ltrm$(rtrm$(uprc$(CBSW$))) then 12082 send CPID,CB$ 12084 goto 12010 12088 end if 12090 goto 12010 12100 handler CB_ERRORS 12110 let ECD=excode 12115 if excode=71163 then resume 12120 if excode=24 then resume 12125 if excode=71 then 12130 let SP=0 12135 if I<>USR then output #2 record I data 00350 12140 resume 12145 end if 12150 if excode=71154 or excode=70683 or ECD=559 then 12155 print chr$(28);"Line too lengthy." 12160 resume 12165 end if 12170 print "Report the following SMail error LINE:";exline 12171 print "Error message: ";excode$ 12175 resume 12200 end handler 13000 if fkey<>42 then 14000 13005 input #2 record USR data 00350 13007 if SM%(1:1)="-" then 08840 13010 if PR>0 then 13020 input #2 record PR data 00350 13030 if SP=2 and PR=USR then 13040 send CPID,chr$(13)&chr$(29)&"<"<rm$(rtrm$(CBCN$))&"> has left private mode and CB."&chr$(15)&chr$(21)&chr$(29)&chr$(2) 13050 end if 13060 input #2 record USR data 00350 13070 end if 13300 let PR,CBPR,CPID=0 13310 let SW%="" 13320 let SP=1 13330 let CBSW$="" 13360 output #2 record USR data 00350 13361 if CBCH=0 or pos(PA$,"/Q")>0 and FNMGR then 13390 13370 let CB$="has left CB."&chr$(128) 13380 goto 12000 13390 close #2 13400 let MES$="Exit CB" 13410 goto 00425 14000 if fkey=10 and AR$="" and PA$="" then 20000 14009 if fkey<>2 then 14010 if FK$(fkey)<>"" then 14011 let CB$=CB$&FK$(fkey) 14012 goto 12000 14013 end if 14019 print chr$(28);"**ILLEGAL KEY** For assistance type HELP and press EXECUTE {F1}" 14020 goto 10600 14030 end if 14050 let C$=ltrm$(rtrm$(CB$)) 14060 let PA$="" 14070 let AR$="" 14080 let UC$=uprc$(C$) 14090 let P=pos(UC$,"/") 14100 if P>0 then 14110 let PA$=ltrm$(rtrm$(MIDR$(UC$,P))) 14120 let UC$=ltrm$(rtrm$(LEFT$(UC$,P-1))) 14130 end if 14140 let P=pos(UC$," ") 14150 if P>0 then 14160 let AR$=ltrm$(rtrm$(MIDR$(UC$,P))) 14170 let UC$=ltrm$(rtrm$(LEFT$(UC$,P))) 14180 end if 14190 if fkey=2 and UC$="" and AR$="" and PA$="" then 14192 print chr$(28);"** Press Shift-F1 [HELP] for a list of commands available **" 14193 print chr$(28);"** Always end text with NEW LINE or CR; enter commands with F1 {EXECUTE} **" 14194 goto 10600 14195 end if 15000 if len(UC$)>2 and LEFT$("EXIT",len(UC$))=UC$ and len(UC$)<5 then 13005 15001 if len(UC$)>1 and LEFT$("BYE",len(UC$))=UC$ and len(UC$)<4 then 13005 15005 if len(UC$)>0 and LEFT$("QUIT",len(UC$))=UC$ and len(UC$)<5 then 13005 15015 if len(UC$)>1 and LEFT$("HELP",len(UC$))=UC$ and len(UC$)<5 then 20000 15020 if len(UC$)>1 and LEFT$("STOP",len(UC$))=UC$ and len(UC$)<5 then 13005 15030 if UC$="?" then 20000 15032 if len(UC$)>0 and LEFT$("GOTO",len(UC$))=UC$ and len(UC$)<5 then 30000 15040 if len(UC$)>0 and LEFT$("CHANNEL",len(UC$))=UC$ and len(UC$)<8 then 30000 15042 if len(UC$)>0 and LEFT$("USERS",len(UC$))=UC$ and len(UC$)<6 then 31000 15050 if len(UC$)>0 and LEFT$("TIME",len(UC$))=UC$ and len(UC$)<5 then 15051 print chr$(28);"The current system time is ";time$ 15052 goto 10600 15053 end if 15060 if len(UC$)>0 and LEFT$("DATE",len(UC$))=UC$ and len(UC$)<5 then 15061 print chr$(28);"The current system date is ";date$ 15062 goto 10600 15063 end if 15070 if len(UC$)>1 and LEFT$("HANDLE",len(UC$))=UC$ and len(UC$)<7 then 41000 15075 if len(UC$)>1 and LEFT$("ALIAS",len(UC$))=UC$ and len(UC$)<6 then 41000 15080 if len(UC$)>0 and LEFT$("NAME",len(UC$))=UC$ and len(UC$)<5 then 41000 15090 if len(UC$)>0 and LEFT$("NICKNAME",len(UC$))=UC$ and len(UC$)<9 then 41000 15100 if len(UC$)>0 and LEFT$("WHO",len(UC$))=UC$ and len(UC$)<4 then 41500 15110 if len(UC$)>1 and LEFT$("SCRAMBLE",len(UC$))=UC$ and len(UC$)<9 then 19100 15120 if len(UC$)>1 and LEFT$("XSCRAMBLE",len(UC$))=UC$ and len(UC$)<10 then 19260 15130 if len(UC$)>0 and LEFT$("PRIVATE",len(UC$))=UC$ and len(UC$)<8 then 19400 15140 if len(UC$)>1 and LEFT$("XPRIVATE",len(UC$))=UC$ and len(UC$)<9 then 19900 15200 if len(UC$)>2 and LEFT$("EXPELL",len(UC$))=UC$ and len(UC$)<7 then 17100 15210 if len(UC$)>1 and LEFT$("SUSPEND",len(UC$))=UC$ and len(UC$)<8 then 17100 15220 if len(UC$)>1 and LEFT$("BLINK",len(UC$))=UC$ and len(UC$)<6 then 16020 15221 if FNMGR and len(UC$)>0 and LEFT$("INVISIBLE",len(UC$))=UC$ and len(UC$)<10 then 15222 input #2 record USR data 00350 15223 let CH=-abs(CH) 15224 output #2 record USR data 00350 15226 let INV=-1 15227 print chr$(28);"You are now invisible in user listings." 15228 goto 10609 15229 end if 15230 if FNMGR and len(UC$)>1 and LEFT$("XINVISIBLE",len(UC$))=UC$ and len(UC$)<10 then 15231 input #2 record USR data 00350 15232 let CH=abs(CH) 15233 output #2 record USR data 00350 15236 let INV=0 15237 print chr$(28);"You are now visible to user listings." 15238 goto 10609 15239 end if 15240 if FNMGR and len(UC$)>0 and LEFT$("MONITOR",len(UC$))=UC$ and len(UC$)<8 then 15241 input #2 record USR data 00350 15242 let CH,CBCH=0 15243 output #2 record USR data 00350 15244 print chr$(28);"You are now monitoring all channels." 15245 goto 10609 15246 end if 16000 print chr$(28);"*** ILLEGAL COMMAND *** Type HELP and press EXECUTE for list." 16010 goto 10600 16020 if AR$="" then 16022 print chr$(28);"%SMAIL-Information, BLINK may be ON or OFF." 16024 goto 10600 16028 end if 16029 if AR$="-" or AR$="OFF" or AR$="OF" then 16050 16030 if len(AR$)>0 and LEFT$("DISABLE",len(AR$))=AR$ and len(AR$)<8 then 16050 16032 if len(AR$)>0 and LEFT$("ENABLE",len(AR$))=AR$ and len(AR$)<7 then 16055 16035 if AR$="+" or AR$="ON" then 16055 16040 print "%SMAIL-Error, Invalid argument. Blink may be on or off." 16042 goto 10600 16050 print chr$(28);"Blink is now disabled.";chr$(29);chr$(4) 16051 goto 10600 16055 print chr$(28);"Blink is now enabled.";chr$(29);chr$(3) 16057 goto 10600 17100 if FNPRV=0 then 17102 print chr$(28);"You are not authorized to perform that function." 17104 goto 10600 17105 end if 17110 if AR$="" then 17120 print "No username specified." 17130 goto 10600 17140 end if 17150 let J=0 17160 let I=0 17200 disable handler 17210 enable handler CB_ERRORS, resume at 17250 17220 let I=I+1 17230 input #2 record I data 00350 17240 if J=0 and LEFT$(US%,len(AR$))=AR$ then 17300 17245 if J=1 and LEFT$(CN%,len(AR$))=AR$ then 17300 17247 if SM%(1:1)="-" and I=USR then 08840 17248 goto 17220 17250 let J=J+1 17252 if J<2 then 17160 17255 goto 19620 17300 if pos("*"&chr$(170),SM%(1:1))>0 and FNMGR=0 then 17301 print "A privileged user may not be expelled or suspended from CB." 17302 goto 19630 17303 end if 17304 print chr$(28);ltrm$(rtrm$(uprc$(US%)));" "; 17305 if UC$(1:1)="S" then 17310 let SM%(1:1)="-" 17320 print "is now suspended." 17330 output #2 record I data 00350 17340 goto 19630 17350 end if 17400 if SP<>2 then 17410 print "is not on the CB." 17420 else 17430 let SM%(3:3)="-" 17440 output #2 record I data 00350 17450 print "has been expelled from the CB." 17460 end if 17470 goto 19630 19100 if AR$="" then 19105 print chr$(28);"Scramble mode is o"; 19110 if ltrm$(rtrm$(CBSW$))="" then 19120 print "ff. Type SCRAMBLE with a password to whisper, then press F1" 19130 else 19140 print "n. Word is: ";CBSW$ 19150 end if 19160 goto 10600 19170 end if 19180 let AR$=uprc$(ltrm$(rtrm$(LEFT$(AR$,5)))) 19190 input #2 record USR data 00350 19200 if SM%(1:1)="-" then 08840 19210 let CBSW$=AR$ 19220 let SW%=AR$ 19230 output #2 record USR data 00350 19240 print chr$(28);"Scramble word is now: ";CBSW$ 19250 goto 10600 19260 input #2 record USR data 00350 19270 let SW%="" 19280 let CBSW$="" 19290 print chr$(28);"Scramble mode is now off." 19300 output #2 record USR data 00350 19301 if SM%(1:1)="-" then 08840 19305 goto 10600 19400 if AR$="" then 19401 print chr$(28);"Private mode is o"; 19404 if CBPR=0 then 19405 print "ff. Type PRIVATE with a username to talk in private,";chr$(10);"then press F1" 19406 else 19407 print "n. Use XPRIVATE to leave." 19408 end if 19409 goto 10600 19500 end if 19505 let AR$=LEFT$(ltrm$(rtrm$(uprc$(AR$))),15) 19510 let J=0 19511 let I=0 19520 disable handler 19530 enable handler CB_ERRORS, resume at 19600 19540 let I=I+1 19550 input #2 record I data 00350 19560 if J=0 and LEFT$(US%,len(AR$))=AR$ then 19660 19570 if J=1 and LEFT$(CN%,len(AR$))=AR$ then 19660 19580 if SM%(1:1)="-" and I=USR then 08840 19590 goto 19540 19600 let J=J+1 19610 if J<2 then 19511 19620 print chr$(28);"Username or Handle not found." 19630 disable handler 19640 enable handler CB_ERRORS, resume at 12025 19650 goto 10600 19660 disable handler 19661 enable handler CB_ERRORS, resume at 12025 19662 if USR=I then 19663 print chr$(28);"You can't go private with yourself." 19664 goto 10600 19665 end if 19669 if SP<>2 then 19670 print chr$(28);"That user is not in CB." 19680 if SP<>0 then print chr$(28);"You may be able to use CHAT." 19690 goto 10600 19695 end if 19710 if PR<>0 and PR<>USR then 19720 print chr$(28);"That user is already in private mode." 19730 goto 10600 19740 end if 19741 if PR=0 then 19742 let CB$="requests you in private mode." 19743 else 19744 let CB$="is now in private mode." 19745 end if 19750 let CB$=chr$(13)&chr$(29)&"<"<rm$(rtrm$(CBCN$))&"> "&CB$&chr$(15)&chr$(21)&chr$(29) 19760 send CPID,CB$ 19780 if PR=0 then 19781 print chr$(28);"Requesting <";ltrm$(rtrm$(CN%));"> enters private mode." 19782 else 19783 print chr$(28);"You have joined <";ltrm$(rtrm$(CN%));"> in private mode." 19784 end if 19790 let CBPR=I 19800 input #2 record USR data 00350 19810 let PR=I 19820 output #2 record USR data 00350 19830 goto 10600 19900 input #2 record USR data 00350 19910 let I=PR 19911 let CBPR=0 19913 if PR=0 then 19960 19917 let PR=0 19918 output #2 record USR data 00350 19920 input #2 record I data 00350 19925 if SP=2 and PR=0 or PR=USR then 19930 let CB$="has left private mode." 19935 let CB$=chr$(13)&chr$(29)&"<"<rm$(rtrm$(CBCN$))&"> "&CB$&chr$(15)&chr$(21)&chr$(29) 19937 send CPID,CB$ 19940 end if 19942 print chr$(28);"Leaving private mode." 19950 goto 10600 19960 print chr$(28);"Not in private mode." 19970 goto 10600 20000 print chr$(28) 20010 cli "TYPE "&CBHLP$ 29998 print chr$(29) 29999 goto 10600 30000 if AR$="" then 30010 if CBCH=0 then print chr$(28);"You are monitoring the CB." else print chr$(28);"Channel is currently set to";CBCH 30020 goto 10600 30030 end if 30035 disable handler 30040 enable handler BAD_CHANNEL, resume at 30200 30050 let K=val(AR$) 30060 if K<>int(abs(K)) then 30220 30070 if K<1 or K>40 then 30220 30072 disable handler 30074 enable handler CB_ERRORS, resume at 12025 30075 if CBPR<>0 or CBSW$<>"" then 30076 print chr$(28);"You may not change channels while in private or scrambled modes.";chr$(29) 30077 goto 10600 30078 end if 30080 let CB$="is off. Moved to channel "&str$(K)&chr$(127) 30081 if CBCH=0 or pos(PA$,"/Q")>0 and FNMGR then 30082 print chr$(28);"Channel quietly changed to channel ";str$(K);"." 30083 goto 30090 30084 end if 30089 goto 12000 30090 input #2 record USR data 00350 30091 if SM%(1:1)="-" then 08840 30095 if FNMGR and INV then let CH=-abs(K) else let CH=K 30100 let CBCH=K 30110 output #2 record USR data 00350 30111 if pos(PA$,"/Q")>0 and FNMGR then 10609 30120 print chr$(28);"Channel is now";abs(CH) 30130 let CB$="is on." 30150 goto 12000 30200 disable handler 30220 print chr$(28);"Channel incorrectly specified. Select channel 1 to 40" 30225 print "No change made. Channel is currently";CBCH 30226 enable handler CB_ERRORS, resume at 12025 30230 goto 10600 30300 handler BAD_CHANNEL 30301 print chr$(28);"Bad character in channel number." 30302 resume 30303 end handler 30310 print chr$(28);"Illegal channel number selected. No change made." 30320 return 31000 print 31001 mat CHAN=zer 31005 print chr$(28);"Channel";tab(11);"Number of Users" 31010 print "-------";tab(10);"---------------" 31011 disable handler 31100 enable handler CB_ERRORS, resume at 31200 31110 let I=0 31120 let I=I+1 31130 input #2 record I data 00350 31132 if CH<1 then 31120 31140 if SP=2 then let CHAN(CH)=CHAN(CH)+1 31150 goto 31120 31200 disable handler 32000 enable handler BAD_CHANNEL, resume at 32030 32010 let K=val(AR$) 32020 if K<>int(abs(K)) or K<1 or K>40 then let K=0 32030 disable handler 32040 enable handler CB_ERRORS, resume at 12025 32050 for I=1 to 40 32060 if CHAN(I)>0 and K=0 or K=I then 32070 if CBCH=I then 32080 print " *";I;tab(7);"*"; 32090 else 32100 print using " ###":I; 32110 end if 32120 print tab(15);CHAN(I) 32130 end if 32140 next I 32150 print chr$(29) 32160 goto 10600 40000 enable handler CONTD !goto 40000 must have a KLUGE= and line inserted after 8000 somewhere 40008 close #2 ! gosub 8000 due to compiler errors 40009 disable handler 40010 open #2:UAF$ direct, internal, outin,fixed 256, shared 40020 input #2 record USR data 00350 40025 let PRIV$=SM% 40030 let PR=CBPR 40040 let SP=I 40042 output #2 record USR data 00350 40044 close #2 40050 if SM%(3:3)="-" then 40060 characteristics "ON","NRM" 40070 else 40080 characteristics "OFF","NRM" 40090 end if 40100 if SM%(1:1)="-" then 08840 40120 goto 08000 41000 input #2 record USR data 00350 41005 if AR$="" then 41010 if ltrm$(rtrm$(CN%))=ltrm$(rtrm$(CBCN$)) then 41020 print chr$(28);"Your current handle is: ";CBCN$ 41030 goto 10600 41040 else 41050 print chr$(28);"Your stored alias is: ";CN% 41060 print chr$(28);"Your current CB handle is: ";CBCN$ 41070 goto 10600 41080 end if 41090 end if 41100 if pos(PA$,"/O")>0 and FNPRV then 41105 let A$=CBCN$ 41110 let CBCN$=C$(pos(uprc$(C$),AR$):pos(uprc$(C$),AR$)+len(AR$)-1) 41120 print chr$(28);"Handle changed, alias overridden." 41121 if pos(PA$,"/Q")>0 then 41122 print chr$(28);"Quiet name change to: ";CBCN$ 41123 goto 10600 41124 end if 41130 let CB$="was "&A$ 41140 goto 12000 41150 else 41151 if PR>0 or CBSW$<>"" then 41152 print chr$(28);"Handles may not be altered in private or scrambled modes.";chr$(29) 41153 goto 10600 41154 end if 41160 let CB$="was "&CBCN$ 41161 if len(AR$)>10 then print chr$(28);"Handle too long- truncating..." 41170 let AR$=LEFT$(uprc$(AR$),10) 41180 if pos(AR$,chr$(28))>0 or pos(AR$,chr$(9))>0 or pos(AR$,chr$(14))>0 or pos(AR$,chr$(9)) then 41190 print chr$(28);"Illegal character in handle. Handle not altered." 41200 goto 10600 41210 end if 41220 let CN%=AR$ 41230 output #2 record USR data 00350 41231 let CBCN$=ltrm$(rtrm$(CN%)) 41232 if pos(PA$,"/Q")>0 and FNPRV then 41234 print chr$(28);"Handle has been changed quietly to: ";CBCN$ 41236 goto 10600 41238 end if 41250 goto 12000 41260 end if 41270 print chr$(28);"Invalid handle command. Press HELP {Shift-F1} for arguments." 41280 goto 10600 41500 let I=0 41501 let K=0 41502 if AR$="A" or AR$="AL" or AR$="ALL" or AR$="+" or AR$="*" then 41550 41510 disable handler 41515 let K=CBCH 41516 if AR$="" then 41550 41520 enable handler BAD_CHANNEL, resume at 41540 41521 let K=-1 41530 let K=val(AR$) 41540 if K<>int(abs(K)) or K<1 or K>40 then let K=-1 41550 disable handler 41560 enable handler CB_ERRORS, resume at 41900 41570 if K<0 then 41571 print chr$(28);"** Invalid channel specified. **" 41572 goto 10600 41573 end if 41574 let J=0 41575 print chr$(28);"Channel Handle User Name Status" 41576 print chr$(28);"-------------------------------------------" 41577 let TOTAL=0 41580 let I=I+1 41590 input #2 record I data 00350 41600 if SM%(1:1)="-" and I=USR then 08840 41601 if CH<1 and FNMGR=0 then 41580 41605 if SP<>2 then 41580 41606 let TOTAL=TOTAL+1 41610 if CH=K or K=0 then 41615 print chr$(28); 41620 if CH<>0 then print using " ### ":abs(CH); else print " All "; 41630 print chr$(28);CN%;" ";US%;" "; 41640 if ltrm$(rtrm$(SW%))<>"" then 41641 print "SCRAMBLED "; 41642 if FNMGR and pos(PA$,"/S")>0 then print chr$(28);SW%;" "; 41643 if CBSW$<>"" and ltrm$(rtrm$(SW%))=CBSW$ then print chr$(28);"*"; 41644 end if 41650 if PR<>0 then print chr$(28);"PRIVATE "; 41651 if FNMGR then 41652 if CH=0 then print "MONITOR "; 41653 if CH<0 then print "INVISIBLE "; 41654 end if 41659 if CH>0 and ltrm$(rtrm$(SW%))="" and PR=0 then print chr$(28);"NORMAL"; 41660 print 41661 let J=J+1 41665 end if 41670 goto 41580 41900 disable handler 41905 print using "#### Users listed #### Users on CB":J,TOTAL 41910 enable handler CB_ERRORS, resume at 12025 41920 goto 10600 42000 disable handler 42010 enable handler RESM, resume at 42200 42060 open #1:CONFILE$ display, sequential, input 42070 linput #1:A$ 42071 let A$=ltrm$(rtrm$(A$)) 42072 if A$="" then 42070 42080 let I=pos(A$," ")-1 42090 let J=I 42100 if J>1 then 42103 if ord(A$(J:J))>47 and ord(A$(J:J))<58 then 42104 let J=J-1 42106 goto 42100 42107 end if 42108 end if 42115 let J=val(A$(J+1:I)) 42120 let LOC$(J)=LEFT$(ltrm$(rtrm$(A$(I+2:len(A$)))),30) 42140 goto 42070 42200 close #1 42210 return 48000 enable handler CONTD 48002 close #2 48003 disable handler 48010 open #2:UAF$ direct, internal, outin,fixed 256, shared 48020 input #2 record USR data 00350 48021 let PRIV$=SM% 48030 close #2 48040 return 49000 enable handler CONTD 49001 close #2 49002 disable handler 49010 open #2:UAF$ direct, internal, outin,fixed 256, shared 49012 if SP=0 then let SP=1 49014 if SP=2 then let CPID=PID 49020 output #2 record USR data 00350 49021 let PRIV$=SM% 49030 close #2 49040 return 50000 enable handler CONTD 50001 close #2 50005 disable handler 50010 enable handler MAKE_UAF, resume at 50020 50020 open #2:UAF$ direct, internal, outin,fixed 256, shared 50030 disable handler 50040 input #2 record USR data 00350 50050 let SP=0 50051 let CPID=0 50052 let PR=0 50053 let SW%="" 50060 output #2 record USR data 00350 50070 close #2 50075 print chr$(29);chr$(21);chr$(15) 50080 enable handler RESM, resume at 90000 50083 if PRIV$(1:1)<>"-" then 90000 50085 linput eof 50000, noecho, prompt "", wait .5:A$ 50090 if fkey<>26 then 90000 50100 linput eof 50000, noecho, prompt "", wait 1:A$ 50110 if fkey<>6 then 90000 50120 linput eof 50000, noecho, prompt "", wait .5:A$ 50130 if A$<>"*" and term$<>chr$(13) then 90000 50140 open #2:UAF$ direct, internal, outin,fixed 256, shared 50150 input #2 record USR data 00350 50160 if SM%(1:1)="-" then let SM%(1:1)="Y" 50170 output #2 record USR data 00350 50180 close #2 50190 print "Suspension lifted." 50200 goto 90000 51010 if AR$="" then let MES$="System User List" else let MES$="Username Search" 51011 gosub 00400 51020 let COUNT,COLCNT,TOTAL=0 51022 print 51030 for I=48 to 90 51031 if I>57 and I<65 then 51340 51045 enable handler RESM, resume at 51340 51050 filestatus s a ":SDD:UDD:"&chr$(I)&"+" into A$ 51070 disable handler 51120 let P=pos(A$,chr$(10)) 51130 if P=0 then 51340 51140 let L$=A$(1:P-1) 51150 let A$=A$(P+1:len(A$)) 51160 if L$(23:25)="CPD" then 51170 let TOTAL=TOTAL+1 51180 if pos(L$(3:17),AR$)>0 then 51190 let COUNT=COUNT+1 51200 let COLCNT=COLCNT+1 51210 if COLCNT>4 then 51220 print rtrm$(L$(3:17)) 51230 let COLCNT=0 51240 else 51250 print L$(3:17);" "; 51260 end if 51270 end if 51280 end if 51290 goto 51120 51340 next I 51345 print chr$(10);chr$(10);COUNT; 51350 if COUNT<>TOTAL then print "/";TOTAL; 51360 print "Username(s) Listed" 51370 goto 00445 52000 handler CONTD 52010 continue 52020 end handler 52030 handler RESM 52040 resume 52050 end handler 52060 enable handler CONTD 52070 let LSTART=0 52080 let MBOX$=":SDD:UDD:280.STONEY:SMAILMBX.MBX" 52090 create MBOX$ 52100 acl MBOX$,"PER.STONEY,OWARE +,RW" 52110 let MLET$=":SDD:UDD:280.STONEY:SMAILLET.LET" 52120 create MLET$ 52130 acl MLET$,"PER.STONEY,OWARE +,RW" 52140 let MTXT$=":SDD:UDD:280.STONEY:SMAILTXT.TXT" 52150 create MTXT$ 52160 acl MTXT$,"PER.STONEY,OWARE +,RW" 52170 open #3:MBOX$ direct, internal, outin, begin, shared,fixed 42 52180 map MBO%*15;MST%*5; integer*4 INL,NLR,TMC,NST 52190 open #4:MLET$ direct, internal, outin, begin, shared,fixed 232 52200 map SNT%*15;STD%*17;LRU%*15;LRD%*17;SUBJ%*80;CLIP%*50; integer*4 CPST,MSST,TSLK,SCT,ENVL; integer*2 EALL 52210 open #5:MTXT$ direct, internal, outin, begin, shared,fixed 134 52220 map LTXT%*122; integer*4 LLNK,MSCNT; integer*2 MALB 52221 rem LTXT% message text LLNK link MSCNT message count MALB message allocation byte 52230 disable handler 52231 if pos(COMMAND$,"/M") then 70000 52240 let ANNOUNCE$=":SDD:UDD:CHENAULT:SMAIL.ANNOUNCE" 52245 if pos(COMMAND$,"/N") then 52320 ! SMail /NOANNOUNCEMENTS 52250 if ANNOUNCE$<>"" then 52260 enable handler RESM, resume at 52300 52270 type ANNOUNCE$ 52280 linput noecho, prompt "-hit a key-", bytes 1:A$ 52290 print chr$(13);chr$(11); 52300 disable handler 52310 end if 52320 return 52330 let BUF$=BUF$&L$ 52340 if len(BUF$)>=122 then 52350 let T80$=BUF$(1:122) 52360 gosub 52410 52370 let BUF$=BUF$(123:len(BUF$)) 52380 goto 52340 52390 end if 52400 return 52410 if MSGSTRT=0 then ! place record out w/ links 52420 gosub 53630 52430 let MSGSTRT=LSTART 52440 goto 52510 52450 end if 52460 let TEMP=LSTART 52470 gosub 53630 52480 input #5 record TEMP data 52220 52490 let LLNK=LSTART 52500 output #5 record TEMP data 52220 52510 let LLNK=-1 52515 let MALB=-1 ! set allocation byte for maintence 52516 let MSCNT=MSGSNTCNT ! message sent count 52520 let LTXT%=T80$ 52530 output #5 record LSTART data 52220 52540 return 52550 let LSTART=0 ! sending a letter starts here 52560 let MSGSTRT=0 52570 print chr$(28);rpt$("-",79) 52580 print "Enter Text Message. Use F11 to Exit Mail. Execute Commands with F1" 52590 print rpt$("-",79) 52600 characteristics "ON","NKI","FKT","EB0","OFF","EB1" 52602 enable handler RESM, resume at 55910 52605 let L$="" 52610 linput prompt chr$(29), eof 53025:L$; 52620 if fkey<>0 then 52750 52630 print chr$(29) 52710 let L$=L$&chr$(13) 52712 if term$=chr$(4) then 53025 52720 gosub 52330 ! append to text buffer and send pieces? 52722 goto 52610 52725 print chr$(28);chr$(10);"Mail Commands";chr$(10);"-------------" 52726 print chr$(28);"Sending: END, EXIT, FINISHED, MAIL, SEND, STAMP" 52727 print chr$(28);"Aborting: ABORT, DELETE, DISPOSE, QUIT, SCRAP, TRASH" 52730 print chr$(28);"Calendar: DATE, TIME" 52731 print chr$(28);"Help: ?, HELP" 52748 print chr$(10);rpt$(chr$(1),31); 52749 goto 52600 52750 if fkey=50 or fkey=42 then 53026 52751 if fkey=10 then 52725 52759 print chr$(13);chr$(28);L$ 52760 let UL$=uprc$(ltrm$(rtrm$(L$))) 52770 let UL=len(UL$) 52780 if fkey=34 then 52790 print chr$(28);"**Line Deleted**" 52800 goto 52600 52810 end if 52820 if fkey<>2 then 52950 52830 if UL>0 and UL$=LEFT$("EXIT",UL) and UL<5 then 53030 52831 if UL>0 and UL$=LEFT$("END",UL) and UL<4 then 53030 52834 if UL>0 and UL$=LEFT$("FINISHED",UL) and UL<9 then 53030 52840 if UL>1 and UL$=LEFT$("SEND",UL) and UL<5 then 53030 52841 if UL>1 and UL$=LEFT$("STAMP",UL) and UL<6 then 53030 52842 if UL>0 and UL$=LEFT$("MAIL",UL) and UL<5 then 53030 52850 if UL>0 and UL$=LEFT$("QUIT",UL) and UL<5 then 52990 52851 if UL>0 and UL$=LEFT$("HELP",UL) and UL<5 then 52725 52852 if UL$="?" then 52725 52860 if UL>1 and UL$=LEFT$("TIME",UL) and UL<5 then 52870 print chr$(28);"Time: ";time$ 52880 goto 52600 52890 end if 52891 if UL>1 and UL$=LEFT$("DATE",UL) and UL<5 then 52892 print chr$(28);"Date: ";date$ 52893 goto 52600 52894 end if 52900 if UL>0 and UL$=LEFT$("ABORT",UL) and UL<6 then 52990 52910 if UL>1 and UL$=LEFT$("SCRAP",UL) and UL<6 then 52990 52911 if UL>1 and UL$=LEFT$("DISPOSE",UL) and UL<8 then 52990 52912 if UL>1 and UL$=LEFT$("DELETE",UL) and UL<7 then 52990 52920 if UL>1 and UL$=LEFT$("TRASH",UL) and UL<6 then 52990 52930 print chr$(28);"%SMAIL-Error, Illegal Command Specified" 52940 goto 52960 52950 print chr$(28);"%SMAIL-Warning, Illegal Function Key." 52960 print chr$(28);"%SMAIL-Information, Type HELP and press F1 for list. Press F11 to send." 52970 print chr$(29);rpt$(chr$(1),32); 52980 goto 52600 52990 print chr$(28);"**Message Aborted**";chr$(29) 52992 let FORCEWIPE=-1 53000 let LSTART=MSGSTRT 53010 gosub 53710 53020 let MBXNUM=0 53021 disable handler 53022 return 53025 let CTRLD=-1 53026 gosub 52330 53030 print chr$(10);chr$(28);"**Message Ends**";chr$(29) 53040 let MES=-1 53050 if BUF$="" then 53100 53060 let BUF$=BUF$&rpt$(chr$(26)&chr$(13)&chr$(11)&chr$(12)&chr$(28)&chr$(14),21) 53070 let BUF$=BUF$(1:122) 53080 gosub 52340 ! place partial record to mail field 53090 output #5 record LSTART data 52220 53100 return 53130 let MBXNUM=0 53140 return 53150 let J=0 53160 let J=J+1 53170 if J=I then 53200 53180 input #3 record J data 52180 53190 if ltrm$(rtrm$(MBO%))<>"" then 53160 53200 let MST%,MNT%="" 53210 let INL,NLR,TMC,NST=0 53220 let MBO%=MXOWN$ 53230 output #3 record J data 52180 53240 let I=J 53250 goto 53470 53260 let LTXT%="" 53270 let LLNK=0 53280 output #5 record LSTART data 52220 53290 goto 53700 53300 let MBXNUM=0 ! finds MXOWN$'s MBXNUM 53310 let MXOWN$=ltrm$(rtrm$(uprc$(MXOWN$))) 53320 if ltrm$(rtrm$(MXOWN$))="" then 53340 let MBXNUM=0 53350 return 53360 end if 53370 enable handler RESM, resume at 53130 53380 filestatus a ":SDD:UDD:"&uprc$(ltrm$(rtrm$(MXOWN$))) into A$ 53390 if A$(44:46)<>"CPD" then 53130 53400 disable handler 53410 let I=0 53420 let I=I+1 53430 enable handler RESM, resume at 53150 53440 input #3 record I data 52180 53450 if ltrm$(rtrm$(uprc$(MBO%)))=MXOWN$ then 53470 53460 goto 53420 53470 disable handler 53480 let MBXNUM=I 53490 return 53500 let ENVELOPE=0 !find free envelope [allocate by msst<>0] & wrt] 53510 let ENVELOPE=ENVELOPE+1 53520 enable handler RESM, resume at 53560 53530 input #4 record ENVELOPE data 52200 53540 if MSST=0 then 53560 53550 goto 53510 53560 disable handler 53570 let SNT%=UN$ ! SMail sender 53580 let STD%=date$&" "&time$ 53581 let SUBJ%=SUBJ$ 53590 let LRU%,CLIP%="" 53591 let LRD%="New" 53595 let ENVL=INL 53600 let CPST,EALL=0 53601 let MSST=-1 53602 let SCT=1 53603 let TSLK=MSGSTRT 53610 output #4 record ENVELOPE data 52200 53620 return 53630 enable handler RESM, resume at 53260 53640 let LSTART=LSTART+1 53650 input #5 record LSTART data 52220 53660 if LLNK<>0 then 53640 53670 let LTXT%="" 53680 let LLNK=-1 53690 output #5 record LSTART data 52220 53700 return 53710 let A$=rpt$(chr$(26)&chr$(12)&chr$(7)&chr$(14)&chr$(13)&chr$(11),21) ! deallocate here 53720 let A$=A$(1:122) 53730 enable handler RESM, resume at 53840 ! deallocates message from LSTART to end 53740 if LSTART<1 then return 53750 input #5 record LSTART data 52220 53751 let MSCNT=MSCNT-1 ! dec message cnt 53752 let TEMP=LLNK 53755 if MSCNT>1 and FORCEWIPE=0 then 53790 ! skip if other haven't disposed or aborted 53770 let LTXT%=A$ 53775 let MALB=0 !clear allocation field 53780 let LLNK=0 53790 output #5 record LSTART data 52220 53800 if TEMP>LSTART then 53810 let LSTART=TEMP 53820 goto 53750 53830 end if 53835 let FORCEWIPE=0 ! set force wipe from abort to not happen 53840 return 53850 let LSTART=MSGSTRT ! display message & set LSTART to end of Message 53860 if LSTART<1 then return 53871 disable handler 53880 input #5 record LSTART data 52220 53885 if LLNK=0 then 53940 53890 gosub 53960 53900 if LLNK>LSTART then 53910 let LSTART=LLNK 53920 goto 53880 53930 end if 53940 print chr$(15) ! reset all attributes (and ands blankline) 53950 return 53960 let TEMP=pos(LTXT%,chr$(26))-1 ! decode message text 53970 if TEMP<1 then let TEMP=len(LTXT%) 53980 let A$=LTXT%(1:TEMP) 53990 let TEMP=pos(A$,chr$(13)) 54000 if TEMP<>0 then 54010 let A$(TEMP:TEMP)=chr$(10) 54020 goto 53990 54030 end if 54041 if PMF$<>"" then output #1:A$; else print A$; 54050 return 54060 disable handler 55000 print chr$(12);chr$(18);V$;tab(20);MES$;tab(64);date$;" ";time$;chr$(20) 55001 let MXOWN$=UN$ 55002 gosub 53300 55010 print UN$;tab(18);"Total Messages:";TMC;tab(42); 55020 if NLR>0 then print "New:";NLR; else print "No New Mail"; 55050 print tab(81);chr$(21) 55060 return 55500 if AR$<>"" then 63000 55501 let MES$="Contents of Mailbox" ! mailbox listing 55510 gosub 55000 55520 let LSTART=INL 55530 if LSTART<1 then 55540 print "No messages in mailbox." 55541 let NLR,TMC=0 55542 output #3 record MBXNUM data 52180 55550 goto 01000 55560 end if 55570 let I=0 55571 if LSTART=0 then 55572 print I;" letter(s) listed." 55573 goto 01000 55574 end if 55575 if int(I/20)=I/20 and I>0 then 55576 print I;" messages listed so far... press NEW LINE to continue" 55577 linput eof 50000, prompt P$:C$ 55578 if ltrm$(rtrm$(C$))<>"" then 01012 55579 let TEMP=I 55580 gosub 55000 55581 let I=TEMP 55582 end if 55589 let I=I+1 55590 input #4 record LSTART data 52200 55591 if MSST>0 then print chr$(28); 55595 print using "###### ":I; 55600 print SNT%;" ";STD%;" ";LEFT$(SUBJ%,25);" "; 55610 select MSST 55620 case -1 55630 print "New"; 55640 case 0 55650 print "Deleted"; 55660 case 1 55670 print "Read"; 55680 case else 55690 print "Unknown" 55700 end select 55710 print chr$(2);chr$(15);chr$(21);chr$(29) 55720 let LSTART=ENVL 55730 goto 55571 55800 let MXOWN$=UN$ 55802 gosub 53300 55804 select NLR 55805 case 0 55806 print "No new mail." 55807 case 1 55808 print "You have one new mail message." 55809 case else 55810 print "You have";NLR;"new mail messages waiting.";chr$(7) 55812 end select 55815 return 55910 print chr$(28);"%SMAIL-Warning, Mail Message Lines May Not Exceeded 256 Characters" 55911 print "%SMAIL-Information, Press NEW LINE before you get to the right margin." 55912 print "%SMAIL-Information, Line was ignored, please re-edit";chr$(29) 55915 goto 52970 55920 let MES$="SMail User Information" 55921 gosub 55000 55927 print "You are ";UN$;" on CON";MIDR$(str$(console),len(str$(console))-1);" SMail process is";PID 55930 gosub 55800 55931 goto 01000 56000 if ENVELOPE<>int(abs(ENVELOPE)) or ENVELOPE=0 then !locate letter 56010 let ENVELOPE=0 56020 return 56030 end if 56032 let MXOWN$=UN$ 56033 gosub 53300 56040 let I=INL 56045 if I<1 then 56046 let ENVELOPE=0 56047 return 56048 end if 56050 input #4 record I data 52200 56060 let ENVELOPE=ENVELOPE-1 56070 if ENVELOPE=0 then 56080 let ENVELOPE=I 56090 return 56091 end if 56100 let I=ENVL 56110 goto 56045 60000 let MES$="Sending Mail" 60001 let I=6 60002 let CBPR=0 60003 let KLUGE=8 60004 goto 40000 60008 gosub 55000 60009 if AR$<>"" then 60100 60010 linput eof 50000, prompt "To: ":AR$ 60020 let AR$=uprc$(ltrm$(rtrm$(AR$))) 60030 if AR$="" then 01000 60080 goto 60110 60100 print "To: ";AR$ 60110 let MXOWN$=AR$ 60200 gosub 53300 60203 if MBXNUM<1 then 60204 print "%SMail-Warning, Mail Recipent Unknown -- please use usernames" 60205 goto 60010 60206 end if 60210 linput eof 50000, prompt "Subject: ":SUBJ$ 60211 let L$=SUBJ$ 60220 let T80$="" 60230 let BUF$="To: "&AR$&chr$(13) 60240 let BUF$=BUF$&"From: "&LEFT$(UN$&rpt$(" ",17),17)&"- "&RN%&" "&date$&" "&time$&chr$(13) 60250 if L$<>"" then let BUF$=BUF$&"Subject: "&L$&chr$(13) 60255 let MSGSNTCNT=1 ! sent number of people sending to 60260 gosub 52550 60270 if MBXNUM=0 then 60900 60290 input #3 record MBXNUM data 52180 60300 gosub 53500 ! place mail message in packet 60310 let INL=ENVELOPE 60320 let NLR=NLR+1 60330 let TMC=TMC+1 60350 output #3 record MBXNUM data 52180 60360 print "Message sent to user ";ltrm$(rtrm$(MBO%)) 60900 goto 01000 ! return from send mail 60910 if FNMGR=0 then 60911 print "%SMAIL-Fatal, No privilege for attempted operation." 60912 goto 01000 60914 end if 60915 if AR$="" then 60923 linput prompt "Who do you wish to become: ":AR$ 60925 let AR$=uprc$(ltrm$(rtrm$(AR$))) 60927 if AR$="" then 01000 60954 end if 60956 enable handler RESM, resume at 60961 60957 acl ":SDD:UDD:"&AR$ into A$ 60958 let UN$=AR$ 60959 print "You have become ";UN$ 60960 goto 01000 60961 print "That account does not exist. You are still ";UN$ 60962 goto 01000 61000 if AR$="" then linput prompt "Letter number: ":AR$ 61010 let J=0 61011 let AR$=ltrm$(rtrm$(uprc$(AR$))) 61012 let AR$=AR$(1:6) 61015 for I=1 to len(AR$) 61020 if pos("0123456789",AR$(I:I))=0 then let J=-1 61025 next I 61030 if J<>0 then 61035 print "%SMAIL-Error, Invalid Message Number Entered" 61040 goto 01000 61045 end if 61050 let J=val(AR$) 61055 if J<>int(abs(J)) or J<1 then 61060 print "%SMAIL-Error, Illegal Message Number Specified" 61065 goto 01000 61070 end if 61075 let ENVELOPE=J 61076 let I=7 61077 let CBPR=0 61078 let KLUGE=9 61079 goto 40000 61080 if pos(PA$,"/F") or pos(PA$,"/P")>0 then let PMF$="SMAIL.MSG."&MIDR$(str$(ENVELOPE),len(str$(ENVELOPE))-1) else let PMF$="" 61082 if pos(PA$,"/F")=0 and pos(PA$,"/P")>0 then let PMF$=PMF$&".HDCPY" 61090 if pos(PA$,"/F")>0 then let MES$="File" else let MES$="" 61092 if pos(PA$,"/P")>0 then 61093 if MES$="" then let MES$="Print" else let MES$=MES$&" / Print" 61094 end if 61095 if MES$="" then let MES$="Read" 61100 let MES$=MES$&" Message Number "<rm$(rtrm$(format$(ENVELOPE,"##########"))) 61105 gosub 55000 61106 gosub 56000 61108 if ENVELOPE=0 then 61110 print "No such letter exists in your mailbox." 61112 goto 01000 61114 end if 61115 disable handler 61120 if PMF$<>"" then 61122 create PMF$ replace 61124 open #1:PMF$ output, sequential, end, display, stream 61125 margin #1:0 61127 if pos(PA$,"/F")>0 then print "File created as ";PMF$ 61130 end if 61132 disable handler 61147 let MSGSTRT=TSLK 61150 let LRU%=UN$ 61151 let LRD%=date$&" "&time$ 61157 let MSGSTRT=TSLK 61160 gosub 53850 61161 if PMF$<>"" then close #1 61163 let MXOWN$=UN$ 61164 gosub 53300 61165 if MSST<>abs(MSST) then let NLR=NLR-1 61166 output #3 record MBXNUM data 52180 61167 let MSST=abs(MSST) 61168 output #4 record ENVELOPE data 52200 61169 if pos(PA$,"/P")>0 and PMF$<>"" then 61170 let B$="/QUE=LPT" 61180 let A$="QPRINT/FOLD" 61190 if pos(PA$,"/LP") then let B$="/QUE=LPT" 61200 if pos(PA$,"/BIO") then let B$="/QUE=BIO" 61210 if pos(PA$,"/BIN") then let A$=A$&"/BINARY" 61220 if pos(PA$,"/H") then let B$="/QUE=HPLA" 61225 if pos(PA$,"/LQ") then let B$="/QUE=LQP" 61230 if pos(PA$,"/LA") then let B$="/QUE=LASER" 61245 if pos(PA$,"/F")=0 then let A$=A$&"/DEL" 61250 cli A$&B$&" "&PMF$ 61260 end if 61300 goto 01000 61310 print "%SMAIL-Error, File(s) Could Not Be Created" 61320 goto 01000 61400 let AC0=1 ! FILENAME$=file to open for USR$ SFIL<>0 will open 61410 let AC1,AC2=0 ! SFIL =0 will only test file and not set attributes 61420 let ERR=sys("43",AC0,AC1,AC2) ! kill ?SPROC 61430 let AC1=1 61440 let ERR=sys("75",AC0,AC1,AC2) ! kill ?SUSE 61450 let BUFFER$=rpt$(" ",256) 61460 let AC0=addr(FILENAME$) 61470 let AC1=addr(BUFFER$) 61480 let AC2=256 61490 let ERR=sys("263",AC0,AC1,AC2) ! ?GRNAME 61500 if ERR<>0 then 61860 61510 let BUFFER$=ltrm$(rtrm$(BUFFER$)) 61520 let FILENAME$=BUFFER$ 61530 acl BUFFER$ into A$ 61531 let USR$=uprc$(ltrm$(rtrm$(USR$))) 61532 let A$=" "&A$ 61540 let J=pos(A$," +,") 61541 if J=0 then let J=pos(A$," "&USR$&",") 61550 if J=0 then let J=len(A$) 61555 if A$(len(A$):len(A$))<" " then let A$=A$(1:len(A$)-1) 61560 if pos(A$(J:pos(A$&" "," ",J+1)),"R")>0 then 61600 61570 let A$=A$(1:J)&" "&USR$&",R "&A$(J+1:len(A$)) 61571 print "61571: ";A$ 61580 enable handler RESM, resume at 61910 61590 if SFIL then acl BUFFER$,A$ 61600 do while len(BUFFER$)>1 61610 let I,J=0 61620 let I=pos(BUFFER$,":",J+1) 61630 if I>0 then 61640 let J=I 61650 goto 61620 61660 end if 61670 let BUFFER$=BUFFER$(1:J-1) 61680 print BUFFER$ 61690 acl BUFFER$ into A$ 61700 let J=pos(A$," +,") 61710 if J=0 then 61720 let A$=A$(1:len(A$)-1)&" +,RE" 61730 goto 61700 61740 end if 61750 let B$=ltrm$(rtrm$(A$(J+1:J+6))) 61760 let A$=A$(1:J) 61770 let J=pos(B$," ") 61780 if J>0 then let B$=B$(1:J-1) 61790 if pos(B$,"RE")=0 then let B$=B$&"RE" 61800 let A$=A$&B$ 61810 enable handler RESM, resume at 61890 61820 if SFIL then acl BUFFER$,A$ ! append +,E to directory 61830 loop ! end of opening DIR 61840 let ERR=0 61850 return 61860 print "%SMail-Error, Unable to Access Specified File" 61870 let ERR=-1 61880 return 61890 let ERR=0 61900 return 61910 print "%SMail-Error, You do not have access to mail ";FILENAME$ 61911 if len(FILENAME$)<36 then print FILENAME$ else print "the specified file." 61920 let ERR=-1 61930 return 62000 let MES=-1 62002 if AR$="" then linput prompt "Letter to dispose: ":AR$ 62004 let AR$=ltrm$(rtrm$(AR$)) 62006 if AR$="" then 01000 62007 enable handler RESM, resume at 62110 62008 let ENVELOPE=val(AR$(1:6)) 62009 disable handler 62014 if ENVELOPE<1 or ENVELOPE<>int(abs(ENVELOPE)) then 62015 print "Illegal message number." 62016 goto 01000 62017 end if 62019 let MES$="Dispose Message "&str$(ENVELOPE) 62020 gosub 55000 62022 if TMC<1 or INL<1 then 62023 print "No messages in mailbox to dispose of." 62024 goto 01000 62025 end if 62030 if ENVELOPE>TMC then 62031 print "No such message exists." 62032 goto 01000 62033 end if 62034 let TEMPENV=ENVELOPE 62035 gosub 56000 62036 gosub 63500 62037 if DMP<>0 then 01000 62038 let ENVELOPE=TEMPENV 62039 disable handler 62040 if ENVELOPE=1 then 62045 gosub 56000 62047 let TEMP=ENVL 62048 input #3 record MBXNUM data 52180 62050 let INL=TEMP 62052 output #3 record MBXNUM data 52180 62054 else 62056 let ENVELOPE=ENVELOPE-1 62058 gosub 56000 62061 let LSTART=ENVELOPE 62062 input #4 record LSTART data 52200 62064 let ENVELOPE=ENVL 62066 input #4 record ENVELOPE data 52200 62068 let TEMP=ENVL 62070 input #4 record LSTART data 52200 62072 let ENVL=TEMP 62074 output #4 record LSTART data 52200 62076 end if 62078 input #4 record ENVELOPE data 52200 62080 let LSTART=TSLK 62082 gosub 53710 62084 input #3 record MBXNUM data 52180 62086 let TMC=TMC-1 62088 if MSST<0 then let NLR=NLR-1 62090 output #3 record MBXNUM data 52180 62091 let SNT%,STD%,LRU%,LRD%,SUBJ%,CLIP%="" 62092 let CPST,MSST,TSLK,SCT,ENVL,EALL=0 62093 output #4 record ENVELOPE data 52200 62100 goto 01000 62110 print "%SMAIL-Error, Invalid Message Number Entered" 62111 goto 01000 63000 let MES=0 63010 let J=0 63020 for I=1 to len(AR$) 63030 if pos("0123456789",AR$(I:I))=0 then let J=-1 63040 next I 63050 if J<>0 then 63060 print "%SMAIL-Error, Invalid Message Number Entered" 63070 goto 01000 63080 end if 63090 let J=val(AR$) 63100 if J<>int(abs(J)) or J<1 then 63110 print "%SMAIL-Error, Illegal Message Number Specified" 63120 goto 01000 63130 end if 63140 let ENVELOPE=J 63150 let MES$="Catalog Message Number "&str$(ENVELOPE) 63160 gosub 55000 63170 gosub 56000 63180 if ENVELOPE=0 then 63190 print "No such letter exists in your mailbox." 63200 goto 01000 63210 end if 63300 print 63310 print "Sent by ";ltrm$(rtrm$(SNT%));" on ";ltrm$(rtrm$(STD%)) 63320 print 63340 if ltrm$(rtrm$(LRU%))<>"" then print "Last read by ";ltrm$(rtrm$(LRU%));" on ";ltrm$(rtrm$(LRD%)) 63350 print 63360 if ltrm$(rtrm$(SUBJ%))<>"" then 63370 print "Subject of letter:";chr$(10);rtrm$(SUBJ%) 63380 else 63382 print "Leter had no subject supplied for identification." 63384 end if 63390 print chr$(10) 63391 if ltrm$(rtrm$(CLIP%))<>"" then 63394 print "Clip file ";ltrm$(rtrm$(CLIP%));" was attached." 63395 else 63396 print "No file clipped to letter." 63397 end if 63398 print 63399 print "Message Status: "; 63400 select MSST 63401 case 0 63402 print "Deleted" 63403 case <0 63410 print "New "; 63420 case else 63430 print "Read "; 63440 end select 63442 print 63445 print 63450 goto 01000 63500 let DMP=0 ! Delete Message Protect 63510 if MSST>0 then return 63520 if pos(PA$,"/N") then 63530 print "%SMAIL-Information, Message was not read, but disposed anyway." 63550 else 63560 let DMP=-1 63570 print "%SMAIL-Warning, Can not dispose a message that is unread." 63580 print "%SMAIL-Information, Use DISPOSE /NEW to dispose unread mail." 63582 print " Or read the message first." 63585 end if 63590 return 70000 who into A$ ! show mail status and immeadiately leave SMAIL 70010 let MXOWN$=A$(9:pos(A$,":",9)-1) 70020 gosub 53300 70025 if NLR=0 then print "No new mail." 70026 if NLR=1 then print "You have one new mail message." 70027 if NLR>1 then print "You have";NLR;"mail messages waiting." 70030 goto 90000 90000 disable handler 90002 let AC0,AC1,AC2=0 90005 close 90006 let I=sys("139",AC0,AC1,AC2) ! enable control chars 90010 end 90020 ! to become priv'd Get in Smail - do DATE {SF5} {F15} * {F13} 90030 ! to lift suspension -- Run Program {SCF1} {F5} * {CR}