/* $VER: BBBBS.baud 6.5 © 1993 Richard Lee Stockton 7:58PM (31.10.93) - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS - BBBBS.baud. A full-featured BBS in ARexx for Baudbandit based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit! See Information/BBBBS.doc & rexx/bbsLOCAL.rexx for install info */ saypath='SYS:Utilities/Say' copyright.='' copyright.1=STRIP(SUBSTR(SOURCELINE(1),10)) copyright.2=' from Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009' copyright.3=' ARexx portions of this software copyright 1990-93 Richard Lee Stockton' copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -' /* If QuickSortPort not found then try to run setup.rexx */ IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx() IF ~SHOW('P','QuickSortPort') THEN EXIT 666 IF SHOW('P','BBBBS') THEN DO SAY 'BBBBS is already running!' EXIT 0 END CALL OPENPORT('BBBBS') CALL SETCLIP('BBS_version',copyright.1) CALL SETCLIP('BBS_localfiles') CALL SETCLIP('BBS_localusers') CALL SETCLIP('BBS_interpret') CALL SETCLIP('BBS_maint') CALL SETCLIP('BBS_MESSAGE') CALL SETCLIP('BBS_BROWSE') CALL SETCLIP('BBS_MSGS') CALL SETCLIP('BBS_QUIT') /* try to trap everything */ OPTIONS RESULTS OPTIONS FAILAT 999999 NUMERIC DIGITS 14 SIGNAL ON HALT SIGNAL ON SYNTAX SIGNAL ON FAILURE SIGNAL OFF BREAK_C SIGNAL OFF BREAK_E PARSE VERSION . . cpu . cpu=RIGHT(cpu,2)/10 IF cpu<1 THEN cpu=1 Status Vers BB_VERS=RESULT bm=50 IF RIGHT(BB_VERS,4)>1.59 THEN bm=25 dcd IF RC=0 THEN Send 'ATH1\r' bbsprefs.=0 /* start with all prefs OFF */ alpha.='' logonflag=1 emailonline=-1 CALL zerovars() /* User data structure by line */ text.='' text.1=' Full Name' text.2=' Street' text.3='City, ST Zip' text.4=' Voice Phone' text.5=' Password' text.6=' Protocol' text.7='LinesPerPage' text.8=' Preferences' text.9=' Computer' text.10=' Interests' text.11='Session Time' text.12='FirstSession' text.13='Last Session' text.14=' UpLoad' text.15=' Download' text.16=' Last File' text.17='Ratio Email' text.18=' Winnings' text.19=' Usage' text.20=' Level' text.21='Exclude DIRS' text.22=' Msgs Read' text.23=' Msgs Writ' text.24=' Marked Msgs' text.25='Marked Files' text.26='QUICKexclude' text.27=' CBV numbers' name='' CR='0D'x LF='0A'x SAY CR SAY CENTER(copyright.1,75)||CR CALL PRAGMA('W','N') CALL config() IF bbsprefs.15~=0 THEN CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====') IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon' SAY CENTER(copyright.2,75)||CR /* open printer? */ IF bbsprefs.3 THEN DO IF ~OPEN(p,'PRT:','W') THEN DO CALL send2log('failed to open printer.') bbsprefs.3=0 END END /* CALL PRAGMA('W','W') <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */ CALL colors(1) Capture OFF Timeout 120 SAY CENTER(copyright.3,75)||CR excuses.='' courtesy='' courtesyflag=0 SAY CENTER(copyright.4,75)||CR SAY CR SAY CR SAY ' Setting up, please wait...'CR SAY CR msg.='' IF readopen(bbspath'Lists/Conferences') THEN DO DO i=1 line=READLN(f) IF line='END' THEN BREAK IF EOF(f) THEN BREAK num=WORD(line,1) IF DATATYPE(num,'W') THEN msg.num=WORD(line,2) END CALL CLOSE(f) END dirs.='' IF readopen(bbspath'Lists/Libraries') THEN DO DO i=1 line=READLN(f) IF line='END' | EOF(f) THEN LEAVE i num=WORD(line,1) IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2)) END CALL CLOSE(f) END CALL loaduserlist() SAY CR SAY ' The larger the BBS gets, the longer it takes to setup...'CR CALL loadfiles() dcd IF RC~=0 THEN DO SAY CR SAY ' If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR END SAY CR CALL set_grand() CALL loadalpha() dcd IF RC=0 THEN DO logonflag=0 SIGNAL DONE END LOGON: CALL checkdcd() bps=0 SetMark 'CONNECT' IF RC=1 THEN DO GetLine connectline=RESULT PARSE VAR connectline 'CONNECT'bps CALL STRIP(bps) DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N') END bps=LEFT(bps,i-1) END IF bps<300 | bps>38400 THEN DO SetMark 'CARRIER' IF RC=1 THEN DO GetLine connectline=RESULT PARSE VAR connectline 'CARRIER'bps CALL STRIP(bps) END ELSE bps='000 ' END DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N') END bps=LEFT(bps,i-1) SIGNAL ON BREAK_C SIGNAL OFF BREAK_E REMOTE ON TimeOut 120 IF bps<300 THEN bps=getbaudrate() IF bps>16800 THEN bps=getinput(1 0 'Please enter your modem to modem baudrate > ') IF bps<300 THEN SIGNAL DONE bps=bps%1 IF logonflag=0 THEN DO logonflag=1 DO i=1 TO 7 SAY ' 'CR END DO i=1 TO 4 SAY CENTER(copyright.i,75)||CR END CALL sound('LOGON') CALL DELAY(150) CALL colors(1) SAY CR SAY CR SAY CR END IF alpha.0='' THEN CALL loadalpha() CALL TIME('R') /** Identify (title) message */ IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN DO nonstop=1 arg=bbspath'BBS_TEXT/HELLO' CALL readlines(arg 1) CALL seelines(0) nonstop=0 END SAY CR SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR Stat 'Z' CALL checkdcd() /* Ask for name */ name='' courtesy='' Queue CR DO count=1 TO 3 name=getinput(1 0 'Please enter name: ') name=cleanstring(1':'name) IF name='NEW' THEN LEAVE count IF name~='' THEN DO IF FIND(userlist,name)>0 THEN LEAVE count IF FIND(exclusion,name)>0 THEN DO SAY 'Sorry, that is a reserved name.'CR name='' ITERATE count END CALL loadcourtesy() IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN DO SAY CR SAY 'Welcome' name'!'CR SAY 'You will be automatically validated after you enter your user info.'CR SAY CR LEAVE count END END IF count<3 THEN DO IF STRIP(name)~='' THEN SAY name 'not found. Please try again.'CR SAY 'New Users enter NEW to apply for validation.'CR END END IF count>3 THEN SIGNAL DONE CALL TIME('R') logontime=TIME('C') line=left(name,16,' ') 'logged in at' time('C') date('W') date() 'at' bps 'baud' CALL send2log(line) CALL checkUser() IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN DO SAY CR SAY 'Please help us out by entering the following information.'CR CALL getbirth() SAY ' Thank you!'CR END prevcaller='' prevcaller=GETCLIP('BBS_lastcaller') IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller) city=docity(data.3) CALL SETCLIP('BBS_lastcaller',name city' 'TIME('C') DATE()) CALL SETCLIP('BBS_level',level) CALL postuser(0) Timeout maxidle /* max idle time at prompts */ IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN DO arg=bbspath'BBS_TEXT/BIRTHDAY' IF EXISTS(arg) THEN DO SAY CR CALL showtext(arg) END SAY CR SAY '*** Happy Birthday,' pen3||data.1||def', and many more! ***'CR SAY CR END SAY CR /* Get current protocol */ Status Trans protocol=STRIP(RESULT) IF bbsLOGON.baud(name level)=1 THEN SIGNAL OUT CALL checkdcd() CALL sortlibraries() IF FIND(data.8,'QUICK')>0 THEN DO logonflag=0 CALL do_quick(0) logonflag=1 END /* Opening Display after logon. Seen by all Users ONCE A DAY. It first looks for a unique yearly data (ie, WELCOME.0704), then daily data (ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile */ IF DATE('I')>lastondate THEN DO SAY CR arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4) IF EXISTS(arg) THEN CALL showtext(arg) SAY CR arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3) IF EXISTS(arg) THEN CALL showtext(arg) SAY CR arg=bbspath'BBS_TEXT/WELCOME' IF EXISTS(arg) THEN CALL showtext(arg) /* Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514" Deletes any that are previous to "today" */ untils.='' IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN DO CALL QSORT(1,untils.0,untils) DO ui=1 TO untils.0 IF RIGHT(untils.ui,8)3 THEN CALL waiting() IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx() IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx() IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN DO IF EXISTS('RAM:TODAY') THEN DO finfo=STATEF('RAM:TODAY') IF WORD(finfo,5)~=DATE('I') THEN ADDRESS COMMAND 'C:Today091 >RAM:TODAY' END ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY' IF EXISTS('RAM:TODAY') THEN DO CALL readlines('RAM:TODAY' 1) CALL seelines(0) END END SAY CR END CALL readmail(0) IF ~terseflag THEN DO IF level>sysoplevel THEN DO lstmail=WORD(data.17,3) IF ~DATATYPE(lstmail,'W') THEN lstmail=0 IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport() IF level<99 THEN DO SAY CR CALL showtext(bbspath'Email/'sysop'/NEW_FILES') END SAY CR CALL showtext(bbspath'Lists/NEW_USERS') CALL showtext(bbspath'Lists/CBV_USERS') END CALL logonstats() CALL newinfo() END CALL showmarked(1) CALL setdir(libpath||dirs.1) logonflag=0 /***** MAIN *****/ IF menu~='ALL' THEN menu='MAIN' RESTART: IF name='' | data.20='' | logonflag THEN SIGNAL LOGON /* login was interrupted */ SIGNAL ON BREAK_C SIGNAL ON BREAK_E waitchar='' string='' opt='' IF level<1 THEN menu='NEW' DO WHILE(opt~='G') go=0 DO WHILE(~go) IF waitchar='' | waitchar='?' THEN DO commands='cghiqrsvwxyz!#,' IF level>0 THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.' IF level>sysoplevel THEN commands=commands'k%^()=;' IF level=99 THEN commands=commands'@~' commands=commands'?' IF menuflag | waitchar='?' | string='?' THEN CALL menus() ELSE SAY pen3'COMMANDS:'def commands||CR opt='MENU' arg='' CALL postuser(1) END CALL showtime() line='' line=line||bak2' 'TIME('C')' 'def IF menu='ALL' | menu='FILE' THEN line=line pen3'FILE_LIBRARY:'plaindir||def ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def ELSE line=line pen3'MAIN:'def line=line' 'bbsname IF waitchar='' THEN waitchar=getinput(0 0 line' > ') PARSE VAR waitchar string' 'arg CALL checkdcd() nonstop=0 string=UPPER(STRIP(string)) IF POS('+++',string)>0 THEN SIGNAL OUT IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2 IF string='FL' & level>0 THEN CALL Friends() CALL checkalias() waitchar='' warnings=0 IF DATATYPE(string,'W') THEN DO IF string>level THEN DO arg=STRIP(string arg) string='D' END ELSE DO dirnum=string CALL chdir2() CALL since() END END IF string='QUICK' & level>0 THEN CALL do_quick(1) opt=left(string,1) IF opt='G' THEN DO IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?' END go=1 /* check for access */ IF POS(opt,UPPER(commands))=0 THEN go=0 END IF CBVflag=1 THEN SIGNAL OUT CALL postuser(1) OPTIONS PROMPT 'Filename: ' SELECT WHEN opt='A' THEN CALL showalpha() WHEN opt='B' THEN CALL browse() WHEN opt='C' THEN CALL editor('MAIL' sysop) WHEN opt='D' THEN CALL dload() WHEN opt='E' THEN CALL readmail(1) WHEN opt='F' THEN CALL do_F() WHEN opt='H' THEN CALL help('MAIN') WHEN opt='I' THEN CALL information() WHEN opt='J' THEN CALL jump2rexx() WHEN opt='K' THEN CALL killuser() WHEN opt='L' THEN CALL list() WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG' WHEN opt='N' THEN CALL newfiles() WHEN opt='O' THEN CALL otheruser() WHEN opt='P' THEN CALL editor('MSG') WHEN opt='R' THEN IF menu='NEW' THEN CALL CBV();ELSE CALL readmessages() WHEN opt='S' THEN CALL bbsSEARCH() WHEN opt='T' THEN CALL chpro() WHEN opt='U' THEN CALL uload(1) WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG') WHEN opt='W' THEN CALL showuserlist() WHEN opt='X' THEN CALL switchmenuflag() WHEN opt='Y' THEN CALL edituser() WHEN opt='Z' THEN CALL counts() WHEN opt='~' THEN CALL sysED(1) WHEN opt='!' THEN CALL yell() WHEN opt='@' THEN CALL shell() WHEN opt='#' THEN CALL switchcolors() WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL' WHEN opt='%' THEN CALL editnote() WHEN opt='^' THEN CALL readlogs() WHEN opt='&' THEN CALL profiles(1) WHEN opt='+' THEN CALL ext_dload() WHEN opt='(' THEN CALL filereport() WHEN opt=')' THEN CALL mailreport() WHEN opt='=' THEN CALL levelreport() WHEN opt=';' THEN CALL changename() WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN' WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN') OTHERWISE NOP END END SIGNAL LOGOUT EXIT /* FUNCTIONS */ do_F: IF menu='FILE' | menu='ALL' THEN DO IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN DO SAY CR SAY 'Sorry! Not enough memory left for background archiving.'CR SAY 'Please try again in 10 minutes or so.'CR SAY CR RETURN END DO i=0 TO libs.0 CALL SETCLIP('BBS_libs.'i,libs.i) END IF Make_BrowseList.baud(name colorflag files.0)=0 THEN DO CALL send2log('Arc: Make_BrowseList.baud') IF emailonline>=0 THEN emailonline=emailonline+1 END DO i=0 TO libs.0 CALL SETCLIP('BBS_libs.'i) END END ELSE IF menu~='ALL' THEN menu='FILE' RETURN cleanstring: PARSE ARG nflag':'cstr bot=TRIM(XRANGE(,' ')) bot=COMPRESS(bot,'1B'x) /* ESC for ANSI */ top=XRANGE('7F'x) IF nflag=1 THEN DO bot=bot||XRANGE('!','@')'[\]`~{:}' cstr=TRANSLATE(UPPER(cstr),' ','_') END cstr=COMPRESS(cstr,bot||top) IF nflag~=2 THEN cstr=STRIP(cstr) IF nflag=1 THEN cstr=SPACE(cstr,1,'_') RETURN cstr showtext: PARSE ARG arg . IF EXISTS(arg) THEN DO CALL readlines(arg 1) CALL seelines(1) nonstop=0 CALL waiting() END RETURN doGrin: IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0 CALL setdir(bbspath'rexxDoors') temp=Grin_du_Jour.rexx() SAY CR RETURN temp send2log: PARSE ARG sendline logfile=bbspath'Logs/log.'DATE('S') /* daily logs */ IF ~OPEN('log',logfile,'A') THEN DO IF ~OPEN('log',logfile,'W') THEN DO SAY 'failed to open log file' SIGNAL DONE END END CALL WRITELN('log',sendline) CALL CLOSE('log') IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline) RETURN send2last: PARSE ARG sendline IF bbsprefs.24~=1 & name=sysop THEN RETURN lynes.='' lynes.0=2 lynes.1=' -'pen3 bbsname def'user log for the last 99 calls -' lynes.2=sendline logfile=bbspath'USAGE/USER.LOG' /* simple usage log */ IF EXISTS(logfile) THEN DO x=OPEN(lu,logfile,'R') IF x=0 THEN RETURN CALL READLN(lu) DO i=3 TO 99 sendline=READLN(lu) IF EOF(lu) THEN LEAVE i lynes.i=sendline END CALL CLOSE(lu) IF i>99 THEN lynes.0=99 ELSE lynes.0=i-1 END x=OPEN(lu,logfile,'W') IF x=0 THEN RETURN DO i=1 TO lynes.0 CALL WRITELN(lu,lynes.i) END CALL CLOSE(lu) RETURN do_quick: ARG flag . IF FIND(UPPER(data.8),'QUICK')=0 THEN DO SAY CR SAY 'The QUICK option is OFF in your current settings.'CR SAY CR SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'CR SAY 'make a .lha archive of all new bbs activity since your last call.'CR SAY CR SAY 'This archive can then be read (and replied to, and files can be'CR SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'CR SAY 'module for BBBBS, which is available here in the file libraries.'CR SAY CR IF getinput(1 1 'Turn the QUICK option ON? (Ny) >')~='Y' THEN RETURN data.8=data.8 'QUICK' CALL saveData(0) END ELSE IF flag=1 THEN DO IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN DO temp=data.8 data.8='' DO i=1 TO WORDS(temp) IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i)) END ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?' RETURN END END IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN DO SAY CR SAY 'You may EXCLUDE any of these from your QUICK archives.'CR SAY pen3||LEFT('-',74,'-')||def||CR temp=LEFT(' ',7) SAY temp'HELLO - Pre-logon message.'CR SAY temp'WELCOME - Post-logon message.'CR SAY temp'GOODBYE - Logoff message.'CR SAY temp'HOURLY - Average-Minutes-Per-Hour usage graph.'CR SAY temp'STATS.BBS - Most of the Z command from the main menu.'CR SAY temp'filename - ANY filename in the Information area.'CR SAY temp'MESSAGES - New conference messages.'CR SAY temp'FILELIST - New file descriptions.'CR SAY pen3||LEFT('-',74,'-')||def||CR SAY 'Enter a space separated list of what you wish to exclude.'CR SAY pen3'Exclude:'def data.26||CR temp=getinput(1 0 pen3'Exclude: 'def) IF temp='' & data.26~='' THEN DO IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN data.26='' END ELSE data.26=temp temp='Your QUICK archives will exclude'pen3 IF data.26='' THEN temp=temp 'nothing!' ELSE temp=temp data.26 SAY temp||def||CR CALL saveData(0) SAY CR END IF GETCLIP('BBS_'name)~='' THEN DO SAY CR SAY 'The QUICK routines are still working on your archive...'CR SAY 'Please try again later.'CR SAY CR RETURN END quickdir=bbspath'EmailFiles/'name CALL MAKEDIR(quickdir) CALL setdir(quickdir) IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN DO arg='QUICKIN.lha' ul=2 DO WHILE ul=2 ul=uload(0) END END IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN DO ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6 SAY CR SAY 'Processing QUICKIN archive...'CR SAY CR END IF GETCLIP('BBS_'name)='QUICK' THEN DO SAY CR SAY 'The QUICK routines are still working on your file(s)...'CR SAY CR RETURN END arg='RAM:dirlist' ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES' IF WORD(STATEF(arg),2)>80 THEN DO CALL readlines(arg 1) CALL seelines(0) SAY CR END efiles=UPPER(SHOWDIR(quickdir)) DO qi=1 TO WORDS(efiles) qarg=WORD(efiles,qi) IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN DO SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'CR allargs=qarg DO WHILE dload2()=1 END t='' DO WHILE t~='N' & t~='Y' t=getinput(1 1 'Delete' qarg'? (ny) > ') END IF t='Y' THEN DO IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'CR CALL DELETE(quickdir'/'qarg'.xdl') qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA') CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg) END END END arg='' SAY CR IF GETCLIP('BBS_'name)~='' THEN RETURN IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN DO CALL SETCLIP('BBS_city',city) CALL SETCLIP('BBS_'name'_26',data.26) IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0) IF FIND(UPPER(data.26),'MESSAGES')=0 THEN CALL SETCLIP('BBS_'name'_22',data.22) CALL MAKEDIR(bbspath'EmailFiles/'name) CALL showmarked(0) ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21 CALL send2log('Started QUICKOUT at' TIME('C')) SAY CR IF FIND(UPPER(data.26),'MESSAGES')=0 THEN DO clear_marked=1 DO i=1 TO level IF WORD(data.22,i)~=-1 THEN lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0) END SAY CR END IF FIND(UPPER(data.26),'FILELIST')=0 THEN lastbrowse=countcheck(bbspath'Numbers/LastFile' 0) newfilesdate=DATE('S') TIME() IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN DO DO i=1 TO libs.0 CALL WRITELN(f,libs.i) END CALL CLOSE(f) END IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN DO DO i=1 TO msgs.0 CALL WRITELN(f,msgs.i) END CALL CLOSE(f) END SAY CR IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN DO SAY 'Your archive will be waiting next time you call...'CR SAY CR SIGNAL LOGOUT2 END SAY CR SAY 'Note: You now have no ''new'' files or messages (they are being archived).'CR SAY CR SAY 'You will be signaled if you are still online when your archive is ready...'CR SAY CR CALL saveData(1) CALL waiting() END ELSE DO SAY CR IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN SIGNAL LOGOUT2 END SAY CR CALL setdir(libpath||dirs.1) RETURN killuser: IF level<=sysoplevel THEN RETURN killcount=0 DO loop=1 IF arg='' THEN DO OPTIONS PROMPT 'RETURN=QUIT Username to Kill: ' PULL arg END IF STRIP(arg)='' THEN LEAVE loop arg=UPPER(arg) arg=SPACE(STRIP(arg),1,'_') IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN DO arg='' ITERATE loop END SAY 'Working...'lineup||CR IF readlines(bbspath'Users/'arg 1) THEN DO SAY 'User' arg 'not found.'CR arg='' ITERATE loop END IF level<=lynes.20 THEN DO SAY '*** Tsk! Tsk! Your level is not greater than' arg'.'CR CALL send2log('Tried to kill:' arg) arg='' ITERATE loop END CALL DELETE(bbspath'Users/'arg) IF EXISTS(bbspath'Email/'arg) THEN DO temp=WORDS(SHOWDIR(bbspath'Email/'arg)) emailonline=emailonline-temp ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL' END IF EXISTS(bbspath'EmailFiles/'arg) THEN ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL' CALL send2log('Killed:' arg) SAY CR'User file, Email & EmailFiles for' arg 'have been deleted.'CR killcount=killcount+1 arg='' END IF killcount=0 THEN RETURN CALL DELETE(bbspath'Lists/USERS') sortuserflag=1 RETURN menus: CALL checkdcd() SAY CR IF menu='NEW' THEN DO SAY pen6' _________________'def||CR SAY pen6' __/ 'pen3'New User Menu'pen6' \___'def||CR SAY pen6' | |'def||CR SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR SAY pen6' |'def' ['pen3'I'def']nformation 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def||CR SAY pen6' |'def' ['pen3'W'def']ho is here 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch user list 'pen6'|'def||CR SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def||CR SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def||CR SAY pen6' |'def' ['pen3'X'def'] toggle menus 'pen6'|'def||CR SAY pen6' |'def' ['pen3'#'def'] toggle color 'pen6'|'def||CR SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def||CR SAY pen6' |________________________|'def||CR IF bbsprefs.22~=0 THEN DO SAY CR SAY 'Local Callers may register and receive' pen7'INSTANT VALIDATION'def'!'CR SAY 'Enter R to ['pen3'R'def']egister using Call Back Verify.'CR END END ELSE IF menu='MSG' THEN DO SAY pen6' ____________'def||CR SAY pen6' ____/ 'pen3'Messages'pen6' \_____'def||CR SAY pen6' | |'def||CR SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR SAY pen6' |'def' ['pen3'P'def']ost messages 'pen6'|'def||CR SAY pen6' |'def' ['pen3'R'def']ead messages 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch messages 'pen6'|'def||CR SAY pen6' |'def' ['pen3'E'def']mail (private) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'QUICK'def'] options 'pen6'|'def||CR SAY pen6' |'def' ['pen3'FL'def'] Friends List 'pen6'|'def||CR SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'^'def'] view BBS logs 'pen6'|'def||CR SAY pen6' |'def' ['pen3')'def'] email report 'pen6'|'def||CR SAY pen6' |'def' ['pen3'='def'] level report 'pen6'|'def||CR SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def||CR;END IF(level=99) THEN DO SAY pen6' |'def' ['pen3'~'def'] online editor 'pen6'|'def||CR SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def||CR;END SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def||CR SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def||CR SAY pen6' |_______________________|'def||CR END ELSE IF menu='FILE' THEN DO SAY pen6' _________'def||CR SAY pen6' ______/ 'pen3'Files'pen6' \_______'def||CR SAY pen6' | |'def||CR SAY pen6' |'def' ['pen3'A'def']lphabetic list 'pen6'|'def||CR SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR SAY pen6' |'def' ['pen3'B'def']rowse filenotes 'pen6'|'def||CR SAY pen6' |'def' ['pen3'N'def']ew files list 'pen6'|'def||CR SAY pen6' |'def' ['pen3'L'def']ist by Library 'pen6'|'def||CR SAY pen6' |'def' ['pen3'F'def']ilelist archives 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch files 'pen6'|'def||CR SAY pen6' |'def' ['pen3'U'def']pload 'pen6'|'def||CR SAY pen6' |'def' ['pen3'D'def']ownload 'pen6'|'def||CR SAY pen6' |'def' ['pen3'T'def']ransfer protocol 'pen6'|'def||CR SAY pen6' |'def' ['pen3'+'def'] Extra Devices 'pen6'|'def||CR IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'K'def']ill a user 'pen6'|'def||CR SAY pen6' |'def' ['pen3'%'def'] edit filenote 'pen6'|'def||CR SAY pen6' |'def' ['pen3'('def'] file report 'pen6'|'def||CR SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def||CR;END IF(level=99) THEN DO SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def||CR;END SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def||CR SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def||CR SAY pen6' |________________________|'def||CR END ELSE IF menu='MAIN' THEN DO SAY pen6' _____________'def||CR SAY pen6' ____/ 'pen3'Main Menu'pen6' \_____'def||CR SAY pen6' | |'def||CR SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def||CR SAY pen6' |'def' ['pen3'I'def']nfomation 'pen6'|'def||CR SAY pen6' |'def' ['pen3'J'def']ump to doorways 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def||CR SAY pen6' |'def' ['pen3'W'def']ho is here list 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch userlist 'pen6'|'def||CR SAY pen6' |'def' ['pen3'O'def']ther users info 'pen6'|'def||CR SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def||CR SAY pen6' |'def' ['pen3'X'def']pert (no menus) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'#'def'] toggle colors 'pen6'|'def||CR SAY pen6' |'def' ['pen3'$'def'] toggle menu(s) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'&'def'] user profiles 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def||CR SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def||CR SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def||CR SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def||CR SAY pen6' |________________________|'def||CR END ELSE IF menu='ALL' THEN DO SAY pen6' __________________________________________________________'def||CR SAY pen6' __/ 'pen3'Main Menu File Menu Message Menu 'pen6' \__'def||CR SAY pen6' | |'def||CR SAY pen6' |'def' ['pen3'H'def']elp ['pen3'A'def']lphabetical list ['pen3'P'def']ost messages 'pen6'|'def||CR SAY pen6' |'def' ['pen3'I'def']nformation ['pen3'B'def']rowse filenotes ['pen3'R'def']ead messages 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics ['pen3'L'def']ist by Library ['pen3'E'def']mail (private) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'Y'def']our user data ['pen3'N'def']ew files ['pen3'C'def']omment to SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'O'def']ther users info ['pen3'F'def']ilelist archiver ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'J'def']ump to doorways ['pen3'+'def'] Extra Devices ['pen3'X'def']pert (no menus) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch menu ['pen3'D'def']ownload ['pen3'$'def'] toggle menu(s) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'&'def'] user profiles ['pen3'U'def']pload ['pen3'#'def'] toggle colors 'pen6'|'def||CR SAY pen6' |'def' ['pen3'V'def']iew user log ['pen3'T'def']ransfer protocol ['pen3','def'] hourly stats 'pen6'|'def||CR SAY pen6' |'def' ['pen3'G'def']oodbye (logoff) ['pen3'QUICK'def'] options ['pen3'FL'def'] Friends List 'pen6'|'def||CR IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report 'pen6'|'def||CR SAY pen6' |'def' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username 'pen6'|'def||CR;END IF(level=99) THEN SAY pen6' |'def' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report 'pen6'|'def||CR SAY pen6' |________________________________________________________________|'def||CR END QUEUE CR /* clears any un-CRed input in the queue */ RETURN help: ARG helppath . SAY CR SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR IF helppath='MAIN' THEN SAY 'Commands available from the' pen3||menu||def 'menu:'CR frontend=bbspath'BBS_HELP/'helppath backend='.USER' IF level=0 THEN backend='.NEW' ELSE IF level=99 THEN backend='.SUPER' ELSE IF level>sysoplevel THEN backend='.SYSOP' CALL showtext(frontend||backend) RETURN waiting: CALL checktime() IF waitchar='Q' THEN DO waitchar='' RETURN END waitchar='' IF nonstop=1 THEN RETURN OPTIONS PROMPT pen3' RETURN=Continue 'def PULL waitchar CALL cleanline(1) CALL checkdcd() RETURN waiting2: CALL checktime() IF nonstop=1 THEN RETURN 0 waitchar=getinput(1 1 pen3' Q=Quit N=Non-Stop RETURN=Continue 'def) IF waitchar='N' THEN DO nonstop=1 SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E 'def||CR SAY CR CALL DELAY(100) waitchar='' END CALL cleanline(1) CALL checkdcd() IF waitchar='Q' THEN RETURN 1 RETURN 0 busywait: ARG bii bi bt IF bbsprefs.21=0 THEN RETURN IF bi<1 THEN DO CALL WRITECH(STDOUT,'080808'x) RETURN END IF bi=1 THEN CALL WRITECH(STDOUT,' ') IF bi//(bii%2)~=0 THEN RETURN b=bi//bii IF b=0 | b=bii%2 THEN DO tp=RIGHT((bi*100)%bt,2)'%' CALL WRITECH(STDOUT,'080808'x||tp) END RETURN cleanline: ARG lflag . IF colorflag~=1 & lflag=1 THEN RETURN cline=lineup||LEFT(' ',78) IF lflag=1 THEN cline=cline||lineup SAY cline||CR RETURN getinput: PARSE ARG upflag' 'oneflag' 'pline CALL checkdcd() OPTIONS PROMPT pline PARSE PULL inarg inarg=STRIP(inarg) IF upflag THEN inarg=UPPER(inarg) IF oneflag THEN inarg=LEFT(inarg,1) inarg=cleanstring(0':'inarg) RETURN inarg docity: PARSE ARG citi citi=TRANSLATE(citi,' ','+-.,*/()<>') DO i=WORDS(citi) TO 1 BY -1 IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1)) IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1)) END citi=SPACE(citi,1) RETURN STRIP(citi) postuser: IF bbsprefs.12~=1 THEN RETURN ARG upflag . IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')' 'name city ELSE IF upflag=7 THEN ptext=name' is a NEW USER!' ELSE ptext='LogOn:' logontime' 'name city' Last On:' DATE(,lastondate,'I') ptext=CENTER(ptext,74)'\' age='?' IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN DO IF DATATYPE(WORD(data.12,4),'W') THEN DO age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4) IF SUBSTR(DATE('S'),5,2)59 THEN secs=59 IF secs<10 THEN secs='0'secs line=' Time: Used' mins':'secs mins=(maxtime-TIME('E'))%60 secs=TRUNC((maxtime-TIME('E'))//60) IF secs<10 THEN secs='0'secs line=line' Remaining' mins':'secs SAY line||CR checktime: IF TIME('E')>maxtime THEN DO SAY 'Sorry,' name 'your time has expired.'CR CALL send2log('*** Time Expired ***') SIGNAL LOGOUT2 END IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR CALL whodat() CALL checkdcd() RETURN setdir: PARSE ARG tempdir CALL PRAGMA('D',STRIP(tempdir)) directory=PRAGMA('D') Data directory slash=LASTPOS('/',directory) IF slash=0 THEN slash=LASTPOS(':',directory) plaindir=directory IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1) RETURN config: arg='s:CONFIG.BBS' IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS' IF readlines(arg 1) THEN DO SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR SIGNAL DONE2 END compos=POS('/*',lynes.1) IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1) bbsname=STRIP(lynes.1) sysop=WORD(lynes.2,1) compos=POS('/*',lynes.3) IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1) exclusion=STRIP(lynes.3) bbsdevice=WORD(lynes.4,1) sysoplevel=WORD(lynes.5,1) bbspath=WORD(lynes.6,1) IF ~EXISTS(bbspath) THEN DO SAY bbspath 'does not exist!'CR SIGNAL DONE2 END testchar=RIGHT(bbspath,1) IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/' CALL SETCLIP('BBS_path',bbspath) msgpath=WORD(lynes.7,1) IF ~EXISTS(msgpath) THEN DO SAY msgpath 'does not exist!'CR SIGNAL DONE2 END testchar=RIGHT(msgpath,1) IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/' CALL SETCLIP('BBS_msgpath',msgpath) msgpath=msgpath'MSG' libpath=WORD(lynes.8,1) IF ~EXISTS(libpath) THEN DO SAY libpath 'does not exist!'CR SIGNAL DONE2 END testchar=RIGHT(libpath,1) IF testchar~='/' & testchar~=':' THEN libpath=libpath'/' CALL SETCLIP('BBS_libpath',libpath) extdevs='' DO i=1 TO WORDS(lynes.10) test=WORD(lynes.10,i) IF POS(':',test)=0 THEN ITERATE i IF LEFT(test,2)='/*' THEN LEAVE i extdevs=STRIP(extdevs test) END SYSTEM_MSG_LIMIT=WORD(lynes.11,1) SYSTEM_SPACE_LIMIT=WORD(lynes.12,1) maxidle=WORD(lynes.13,1) maxtime=WORD(lynes.14,1) maxbps=WORD(lynes.15,1) IF ~DATATYPE(maxbps,'W') THEN maxbps=2400 CALL SETCLIP('BBS_baud',maxbps) DO i=16 TO 40 j=i-15 bbsprefs.j=STRIP(WORD(lynes.i,1)) END spellpath=WORD(lynes.9,1) IF bbsprefs.5 & ~EXISTS(spellpath) THEN DO SAY spellpath 'does not exist!'CR bbsprefs.5=0 END IF bbsprefs.10 THEN scratch=bbspath'Scratch' ELSE scratch='RAM:Scratch' CALL MAKEDIR(scratch) IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3 extension=WORD(lynes.32,1) arccom=lynes.33 compos=POS('/*',lynes.33) IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1) arccom=STRIP(lynes.33) IF LEFT(extension,1)~='.' THEN DO extension='.lzh' arccom='lharc -m m' END lpost=WORD(lynes.34,1) IF ~DATATYPE(lpost,'W') THEN lpost=3 rpost=WORD(lynes.35,1) IF ~DATATYPE(rpost,'W') THEN rpost=14 compos=POS('/*',lynes.42) IF compos>0 THEN lynes.42=LEFT(lynes.42,compos-1) bbsprefs.27=STRIP(lynes.42) RETURN readlogs: IF arg='' THEN arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ') IF arg='' THEN arg=DATE('S') arg=bbspath'Logs/log.'arg CALL readlines(arg 1) CALL seelines(0) nonstop=0 CALL waiting() RETURN loadcourtesy: IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN DO IF readopen(bbspath'Lists/Courtesy') THEN DO SAY 'Checking Courtesy List...'CR DO i=1 line=READLN(f) IF EOF(f) THEN BREAK line=cleanstring(1':'line) courtesy=courtesy line END CALL CLOSE(f) MSG '' MSG pen3'Courtesy List:'def MSG courtesy END END RETURN fileheader: SAY 'Filename Bytes File# Library KeyWords'CR SAY pen3||LEFT('=',77,'=')||def||CR RETURN showalpha: IF DATATYPE(arg,'W') THEN DO dirnum=arg arg='' IF chdir2()>0 THEN RETURN test='Y' END ELSE DO test=getinput(1 1 'Show one library only? (Ny) > ') IF test='Y' THEN DO IF chdir()>0 THEN RETURN END END showalpha2: IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir)) ELSE filecount=files.0 SAY ' 'filecount 'files.'CR CALL fileheader() count=0 DO wi=1 TO alpha.0 CALL busywait(60 wi alpha.0) IF test='Y' THEN DO IF count>=filecount THEN LEAVE wi IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN ITERATE wi END jj=WORD(alpha.wi,4) IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN ITERATE wi CALL busywait(4 0) SAY alpha.wi||CR count=count+1 IF (count+2)//linesperpage=0 THEN IF waiting2() THEN LEAVE wi CALL busywait(4 1) END CALL busywait(4 0) nonstop=0 IF waitchar~='Q' THEN CALL waiting() RETURN profiles: prodir=bbspath'Profiles' CALL MAKEDIR(prodir) pros=SHOWDIR(prodir) protxt=bbspath'BBS_TEXT/PROFILES' IF EXISTS(protxt) THEN CALL showtext(protxt) DO lupe=1 SAY CR SAY ' 1. Edit 'name'''s user Profile'CR SAY ' 2. View a User Profile'CR SAY ' 3. Search User Profiles'CR SAY ' 4. Browse User Profiles'CR SAY CR temp=getinput(1 1 'Enter Selection Number > ') IF temp=1 THEN DO lynes.='' IF EXISTS(prodir'/'name) THEN DO IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe CALL DELETE(prodir'/'name) END ELSE lynes.0=3 lynes.1=name lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C') lynes.3=LEFT('=',74,'=') IF savelines(prodir'/'name)~=0 THEN DO line='Profile for' name 'failed to save!' SAY line||CR CALL send2log(line) ITERATE lupe END edtype='' CALL bbsEd(4 prodir'/'name) IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name) IF lynes.0<4 THEN CALL DELETE(prodir'/'name) pros=SHOWDIR(prodir) END ELSE IF temp=2 THEN DO pf=1 totpros=WORDS(pros) DO pfl=1 TO totpros BY 3 pfl2=pfl+1 pfl3=pfl+2 pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21) IF pfl2<=totpros THEN pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21) IF pfl3<=totpros THEN pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21) SAY pfline||CR IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN IF waiting(2) THEN LEAVE pfl END emnum=getinput(1 0 pen3'Select User Profile Number > 'def) IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN DO tmp=WORD(pros,emnum) IF level>sysoplevel THEN DO CALL bbsEd(1 prodir'/'tmp) IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp) IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp) pros=SHOWDIR(prodir) END ELSE CALL showtext(prodir'/'tmp) END ELSE LEAVE pf END ELSE IF temp=3 | temp=4 THEN DO searcharg='' nonstop=0 IF temp=3 THEN DO searcharg=STRIP(getinput(0 0 'Enter Search Phrase > ')) IF searcharg='' THEN ITERATE lupe END DO ui=1 TO WORDS(pros) pro=prodir'/'WORD(pros,ui) IF temp=3 THEN IF textsearch(pro searcharg)=0 THEN ITERATE ui SAY CR CALL readlines(pro 1) IF nonstop=1 THEN rnonstop=1 ELSE rnonstop=0 CALL seelines(2) IF rnonstop THEN nonstop=1 ELSE IF waiting2()=1 THEN LEAVE ui SAY CR SAY CR END END ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe END DROP pros RETURN otheruser: line='' IF level>sysoplevel THEN line='['pen3'R'def']eport or' line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?' IF level>sysoplevel THEN line=line '(Dnr) > ' ELSE line=line '(Dn) > ' temp=getinput(1 1 line) IF temp='N' THEN DO CALL showuserlist() RETURN END ELSE IF level>sysoplevel & temp='R' THEN DO SAY CR line='' IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN DO CALL cleanline(0) SAY 'INACTIVE_USERS report will be in your email.'CR line='USERS ' END IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN DO CALL cleanline(0) line=line'FILES' line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > ')) SAY 'FILELISTS_REPORT will be in your email.'CR END SAY CR ADDRESS AREXX bbsREPORT.rexx name line RETURN END SAY CR SAY 'To allow (or not) other users to see your street address and/or phone number,'CR SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR SAY CR SAY 'User specification may include ? wildcard for single characters.'CR SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def) IF arg='' THEN RETURN arg=TRANSLATE(STRIP(arg),'_',' ') CALL FileList(bbspath'Users/*'arg'*',wildlist) line='Found' wildlist.0 'match' IF wildlist.0~=1 THEN line=line'es' SAY line'.'CR IF wildlist.0<1 THEN RETURN totlines=0 nextpagebreak=linesperpage-3 extrainfo=0 IF level>sysoplevel THEN DO IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN extrainfo=1 END DO i=1 TO wildlist.0 CALL readlines(wildlist.i 1) SAY CR totlines=totlines+6 SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR SAY lynes.1||CR IF FIND(UPPER(lynes.8),'STREET')>0 THEN DO totlines=totlines+1 SAY lynes.2||CR END SAY lynes.3||CR IF FIND(UPPER(lynes.8),'PHONE')>0 THEN DO totlines=totlines+1 SAY lynes.4||CR END SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR SAY pen3'Interests:'def lynes.10||CR IF extrainfo THEN DO SAY pen3' up:'def lynes.14||CR SAY pen3' down:'def lynes.15||CR temptot=0 DO j=1 TO WORDS(lynes.23) IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j) END SAY pen3' writ:'def temptot 'public messages.'CR SAY pen3'level:'def lynes.20||CR totlines=totlines+4 IF lynes.21~='' THEN DO totlines=totlines+1 SAY pen3'excluded dirs:'def lynes.21||CR END END IF nonstop~=1 & totlines>=nextpagebreak THEN DO IF waiting2() THEN LEAVE i nextpagebreak=totlines+linesperpage-5 END END nonstop=0 DROP wildlist. IF waitchar~='Q' THEN CALL waiting() RETURN changename: ARG cname IF level<=sysoplevel THEN RETURN IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ') IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN IF WORD(lynes,20)>=level THEN RETURN CALL SETCLIP('BBS_oldname',cname) CALL ChangeUserName.rexx() ncname=GETCLIP('BBS_newname') IF GETCLIP('BBS_oldname')='' THEN CALL send2log('Name change from' cname 'to' ncname) CALL DELETE(bbspath'Lists/USERS') sortuserflag=1 CALL SETCLIP('BBS_oldname') CALL SETCLIP('BBS_newname') RETURN ncname levelreport: minlev=0 maxlev=99 templist='' uname='' newufile=bbspath'Lists/NEW_USERS' IF EXISTS(newufile) THEN DO IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN DO IF readlines(newufile 1)=0 THEN DO i=2 TO lynes.0 templist=STRIP(templist WORD(lynes.i,3)) END END ELSE newufile='' END ELSE newufile='' IF newufile='' THEN DO minlev=getinput(1 0 'Minimum level? (0) > ') maxlev=getinput(1 0 'Maximum level? (99) > ') IF ~DATATYPE(minlev,'W') THEN minlev=0 IF ~DATATYPE(maxlev,'W') THEN maxlev=99 IF minlev<0 | minlev>99 THEN minlev=0 IF maxlev<0 | maxlev>99 THEN maxlev=99 templist=userlist END DO levi=1 TO WORDS(templist) arg=bbspath'Users/'WORD(templist,levi) CALL readlines(arg 1) lt=WORD(lynes.20,1) IF ~DATATYPE(lt,'W') THEN lt=0 IF ltmaxlev THEN ITERATE levi line=lt WORD(templist,levi) SAY line||CR IF newufile~='' | lt<10 THEN DO SAY CR||LF||line||CR DO levj=1 TO 12 SAY pen3' 'lynes.levj||def||CR END SAY pen3' 'lynes.19||def||CR END ELSE ITERATE levi lcom='' IF lt<10 THEN lcom='['pen3'A'def']dd ' lcom=lcom'['pen3'K'def']ill ['pen3'R'def']ename ['pen3'S'def']kip this user?' IF lt<10 THEN lcom=lcom' (Akrs) > ' ELSE lcom=lcom '(krS) > ' lcom=getinput(1 1 lcom) CALL cleanline(0) IF lcom='K' THEN DO arg=WORD(templist,levi) CALL killuser() END ELSE IF lcom='R' THEN DO newname=changename(WORD(templist,levi)) IF newname~='' & newname~=WORD(templist,levi) THEN DO temp=WORDINDEX(templist,levi+1) rtemp='' IF temp>0 THEN rtemp=SUBSTR(templist,temp) temp=WORDINDEX(templist,levi) templist='' IF temp>2 THEN templist=STRIP(LEFT(templist,temp-1)) templist=STRIP(templist newname rtemp) userlist=userlist newname END levi=levi-1 CALL SETCLIP('BBS_newname') END ELSE IF lcom~='S' & lt<10 THEN DO IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN DO DO lvi=1 TO 22 line=READLN(f) IF lvi=11 THEN lynes.11=line IF lvi=20 THEN lynes.20=line IF lvi=21 THEN lynes.21=line END lynes.22=line CALL CLOSE(f) edtype='' IF bbsprefs.25=1 THEN DO SAY CR lynes.22='' lynes.23='' IF DATATYPE(lynes.20,'W') THEN DO SAY 'Setting message counters to last 10 messages in each conference...'CR DO i=1 TO lynes.20 num=countcheck(bbspath'Numbers/LastMessage'i 0)-10 IF num<0 | msg.i.0<10 THEN num=0 lynes.22=lynes.22 num lynes.23=lynes.23 0 END END ELSE CALL send2log('Bad default level in BBS_TEXT/DEF.MEMBER file!') SAY 'Setting file counter to last file uploaded...'CR lynes.16=countcheck(bbspath'Numbers/LastFile' 0) lynes.16=lynes.16 '19900101 00:00:00' END lynes.0=27 CALL savelines(arg) SAY lynes.20 WORD(templist,levi) 'has been made a member.'CR END ELSE SAY 'You need a default member file in BBS_TEXT! ( BBS_TEXT/DEF.MEMBER )'CR END IF lcom~='K' & lcom~='R' & newufile~='' THEN DO nlt=getinput(1 0 lynes.20 'Enter new level or blank for no change. > ') IF DATATYPE(nlt,'W') THEN DO lynes.20=nlt CALL savelines(arg) END CALL writenew() END END IF newufile~='' & EXISTS(newufile) THEN IF getinput(1 1 'Delete NEW_USERS file? (nY) > ')~='N' THEN CALL DELETE(newufile) IF EXISTS(bbspath'Lists/CBV_USERS') THEN IF getinput(1 1 'Delete CBV_USERS file? (nY) > ')~='N' THEN CALL DELETE(bbspath'Lists/CBV_USERS') DROP templist RETURN writenew: arg=WORD(templist,levi) IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN DO IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|' CALL editor('MAIL' arg) END RETURN filereport: SAY 'Searching for mismatches between files and filenotes...'CR DO i=1 TO sysoplevel+1 IF dirs.i='' THEN ITERATE SAY dirs.i' 'lineup||CR rfiles=SHOWDIR(libpath||dirs.i) rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i) IF WORDS(rfiles)~=WORDS(rnotes) THEN DO line='Compare files & filenotes in'pen3 dirs.i||def'. ' DO j=1 TO WORDS(rfiles) IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN line=line WORD(rfiles,j) END SAY line||CR END END Send '^G' CALL waiting() RETURN mailreport: SAY 'Checking ALL pending Email...'CR SAY pen3' - Use CTRL-E to Exit -'def||CR SAY CR mailrep=SHOWDIR(bbspath'Email','D') mailfil=SHOWDIR(bbspath'EmailFiles','D') lastemail=WORD(data.17,3) IF ~DATATYPE(lastemail,'W') THEN lastemail=0 IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN DO DROP mailrep. mailfil. RETURN END mailynes.='' mk=0 DO mi=1 TO WORDS(mailrep) muser=WORD(mailrep,mi) IF muser=sysop | muser=name THEN ITERATE mi mlist=SHOWDIR(bbspath'Email/'muser) IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR DO mj=1 TO WORDS(mlist) fuser=WORD(mlist,mj) IF POS(sysop,fuser)>0 THEN ITERATE mj IF logonflag=0 THEN DO mk=mk+1 mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I') END IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN DO testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser)) IF testnum>emailnum THEN emailnum=testnum IF testnum>lastemail THEN DO CALL showtext(bbspath'Email/'muser'/'fuser) SAY CR SAY CR IF waitchar='Q' THEN LEAVE mi END END END IF logonflag=0 & FIND(mailfil,muser)>0 THEN DO efilelist=SHOWDIR(bbspath'EmailFiles/'muser) IF WORDS(efilelist)>0 THEN DO mk=mk+1 mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist END END END data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0) IF mk>0 THEN DO lynes.0=mk DO mi=1 TO mk lynes.mi=mailynes.mi END CALL seelines(1) nonstop=0 CALL waiting() END ELSE SAY 'No unseen Email pending.'CR DROP mailrep. mailfil. mailynes. mlist RETURN sortdoors: IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0 IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN DO jdoors.='' doorlist=SHOWDIR(bbspath'rexxDoors','F') doors.='' doors.0=WORDS(doorlist) DO i=1 TO doors.0 doors.i=WORD(doorlist,i) END SAY 'Sorting..'lineup||CR CALL QSORT(1,doors.0,doors) jdoors.0=doors.0%3 IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1 DO i=1 TO jdoors.0 DO j=0 TO 2 k=i+j*jdoors.0 IF k<=doors.0 THEN DO jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24) dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8) jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' ' END END END END RETURN 0 jump2rexx: CALL sound('JUMP') CALL sortdoors() temp=1 readcount=-1 DO doorloop=1 IF temp=0 THEN DO IF readcount~=-1 THEN DO doors.0='' CALL sortdoors() END SAY CENTER('- Number of accesses per file -',75)||CR END SAY pen3||LEFT('-',75,'-')||def||CR DO jd=1 TO jdoors.0 IF temp=0 THEN SAY jdoors.jd.0||CR ELSE SAY jdoors.jd||CR IF jd//linesperpage=0 THEN CALL waiting() IF waitchar='Q' THEN LEAVE doorloop END IF temp=0 THEN DO CALL waiting() temp=1 ITERATE doorloop END temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def) IF temp=0 THEN ITERATE doorloop IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN LEAVE doorloop IF TIME('E')>(maxtime-120) THEN DO SAY CR SAY '*** Less than 2 minutes left! ***'CR SAY '*** rexxDoors are closed! ***'CR SAY CR LEAVE doorloop END arg=doors.temp IF GETCLIP('BBS_localdoor')=arg THEN DO SAY 'That door is in use! Try again in a few minutes...'CR ITERATE doorloop END CALL SETCLIP('BBS_door',arg) readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8) IF ~DATATYPE(readcount,'W') THEN readcount=0 ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1 CALL postuser(1) curdir=PRAGMA('D') CALL setdir(bbspath'rexxDoors') CALL send2log('Door: 'doors.temp 'at' TIME('C')) CALL SETCLIP('BBS_winnings') savewinnings=0 timeleft=TRUNC(maxtime-TIME('E')) IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN DO savewinnings=winnings IF savewinnings=0 THEN savewinnings=1 winnings=timeleft SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR END comm='CALL' doors.temp'('name winnings savewinnings colorflag timeleft-42')' INTERPRET comm testwin=GETCLIP('BBS_winnings') IF DATATYPE(testwin,'N') THEN DO IF savewinnings>0 THEN DO IF testwin>7200 THEN DO SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR testwin=7200 END maxtime=TRUNC(testwin+TIME('E')) winnings=savewinnings END ELSE winnings=testwin END CALL setdir(curdir) CALL SETCLIP('BBS_winnings') CALL SETCLIP('BBS_door') SAY CR CALL showtime() END CALL SETCLIP('BBS_winnings') CALL SETCLIP('BBS_door') RETURN sortlibraries: SAY 'Sorting Libraries...'CR count=0 sdirs.='' DO i=1 TO level IF dirs.i='' THEN ITERATE i count=count+1 sdirs.count=dirs.i i END sdirs.0=count CALL QSort(1,count,sdirs) count=0 libs.='' DO i=1 TO sdirs.0 tempnum=WORD(sdirs.i,2) tempdir=WORD(sdirs.i,1) IF FIND(data.21,UPPER(tempdir))=0 THEN DO string=' ' IF tempnum<10 THEN string=string' ' string=string || tempnum'. 'LEFT(tempdir,14) count=count+1 libs.count=string END END libs.0=count%4 IF (count//4)>0 THEN libs.0=libs.0+1 DO i=1 TO libs.0 DO j=1 TO 3 k=i+j*libs.0 IF k<=count THEN libs.i=libs.i||libs.k END END DROP sdirs. CALL sortconferences() RETURN sortconferences: SAY 'Sorting Conferences...'CR count=0 smsg.='' DO i=1 TO level IF msg.i='' THEN ITERATE i count=count+1 smsg.count=msg.i i END smsg.0=count CALL QSort(1,count,smsg) count=0 msgs.='' DO i=1 TO smsg.0 tempnum=WORD(smsg.i,2) tempdir=WORD(smsg.i,1) IF FIND(data.21,tempnum)=0 THEN DO string=' ' IF tempnum<10 THEN string=string' ' string=string || tempnum'.' IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN string=string LEFT(tempdir,20) ELSE string=string pen3'-OFF-'def LEFT(tempdir,14) count=count+1 msgs.count=string END END msgs.0=count%3 IF (count//3)>0 THEN msgs.0=msgs.0+1 DO i=1 TO msgs.0 DO j=1 TO 2 k=i+j*msgs.0 IF k<=count THEN msgs.i=msgs.i msgs.k END END DROP smsg. RETURN readmessages: searcharg='' DO FOREVER SAY CR PARSE VAR arg temp' 'arg . IF DATATYPE(temp,'W') THEN msgdir=temp ELSE IF LEFT(UPPER(temp),1)='A' THEN DO CALL newmsgs() arg='' RETURN END ELSE IF LEFT(UPPER(temp),1)='M' THEN DO CALL readmarked() arg='' RETURN END ELSE DO SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'CR IF areaselect() THEN DO IF LEFT(temp,1)='A' THEN CALL newmsgs() IF LEFT(temp,1)='M' THEN CALL readmarked() RETURN END END pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF' pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > ' IF arg~='' THEN junk=UPPER(LEFT(arg,1)) ELSE junk=getinput(1 1 pline) IF junk='Q' THEN RETURN IF junk='A' THEN DO SAY CR CALL msgcount(msgdir) junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ') IF junk='Q' THEN RETURN IF DATATYPE(junk,'W') THEN DO IF junk>lastmess | junk<1 THEN junk=1 lastread.msgdir=junk-1 CALL savedata(1) END CALL SETCLIP('BBS_MSGS','ON') SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'CR lastread.msgdir=countcheck(bbspath'Numbers/LastMessage'msgdir 0) CALL send2log('Arc: ArcMsgs.rexx' msg.msgdir) ADDRESS AREXX ArcMsgs.rexx name msgdir IF emailonline>=0 THEN emailonline=emailonline+1 DO WHILE GETCLIP('BBS_MSGS')~='' CALL DELAY(14) END SAY 'When completed, the archive will be attached to email addressed to you.'CR CALL savedata(1) SAY CR RETURN END IF junk='S' THEN DO searcharg='' searcharg=getinput(0 0 pen3'Search Phrase: 'def) IF LENGTH(STRIP(searcharg))=0 THEN RETURN searcharg=COMPRESS(searcharg,'*') SAY CR CALL searchmsgdir() SAY CR SAY 'All messages in the'pen3 msg.msgdir def'Conference have been searched.'CR SAY CR CALL waiting() searcharg='' RETURN END IF junk='T' THEN DO line='Turning the' msg.msgdir 'conference' IF WORD(data.22,msgdir)<0 THEN DO line=line pen3'ON'def'.' newdata='0' END ELSE DO line=line pen3'OFF'def'.' newdata='-1' END SAY line||CR dataloc=WORDINDEX(data.22,msgdir)-1 data.22=DELWORD(data.22,msgdir,1) IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc) CALL sortconferences() END CALL readmsg(0) CALL saveData(1) nonstop=0 arg='' END RETURN newmsgs: test=UPPER(LEFT(arg,1)) IF test='' THEN test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ') IF test='A' THEN DO CALL SETCLIP('BBS_MSGS','ON') SAY CR SAY 'Archiving new conference messages...'CR CALL send2log('Arc: ArcMsgs.rexx') ADDRESS AREXX ArcMsgs.rexx name IF emailonline>=0 THEN emailonline=emailonline+1 clear_marked=1 DO i=1 TO level IF WORD(data.22,i)~=-1 THEN lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0) END DO WHILE GETCLIP('BBS_MSGS')~='' CALL DELAY(14) END SAY 'When completed, the archive will be attached to email addressed to you.'CR CALL savedata(1) SAY CR RETURN END curmsgdir=msgdir SAY 'Scanning all Conferences for new messages..'CR DO newi=1 TO level IF msg.newi='' THEN ITERATE newi msgdir=newi CALL readmsg(1) IF msgcom='Q' THEN LEAVE newi END CALL saveData(1) msgdir=curmsgdir nonstop=0 RETURN readmsg: ARG quietflag marknum . msgcom='' IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */ IF WORD(data.22,msgdir)=-1 THEN RETURN; /* user excluded */ entering='Entering'pen3 msg.msgdir def'Message Conference..' IF quietflag=0 & marknum='' THEN SAY entering||CR CALL postuser(2) IF DATATYPE(WORD(data.22,msgdir),'W') THEN lastread.msgdir=WORD(data.22,msgdir) ELSE lastread.msgdir=0 lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0) frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0) temp='' IF marknum='' THEN DO IF lastread.msgdir>=lstwrt | lastread.msgdir 'def) IF temp='' THEN temp=lastread.msgdir IF ~DATATYPE(temp,'W') THEN RETURN IF templstwrt THEN temp=lstwrt IF temp<1 THEN temp=1 lastread.msgdir=temp-1 END END ELSE lastread.msgdir=marknum-1 IF quietflag=1 THEN SAY entering||CR dirname=msgpath||msgdir msglist.=0 /* set read to 0, unread to 1, and reply >=2 */ firstmess=999999 testlist=SHOWDIR(dirname) DO i=1 TO WORDS(testlist) test=WORD(testlist,i) IF test>lastread.msgdir THEN msglist.test=1 IF testmarknum THEN LEAVE msgloop mess=marknum END IF msglist.mess~=msgstatus THEN ITERATE mess IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR msglist.mess=0 arg=dirname'/'mess IF ~EXISTS(arg) THEN DO SAY 'Message number' mess 'is missing.'CR ITERATE mess END IF ~readopen(arg) THEN ITERATE mess firstline=READLN(f) secondline=READLN(f) thirdline=READLN(f) forthline=READLN(f) CALL CLOSE(f) CALL killmark(msgdir mess) DO skp=1 TO skipsubj.0 IF forthline=skipsubj.skp THEN ITERATE mess END IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */ DO thread=SUBSTR(firstline,WORDINDEX(firstline,4)) DO tindx=1 TO WORDS(thread) test=WORD(thread,tindx) IF msglist.test~=0 THEN msglist.test=msgstatus+1 END END savearg=arg msgcom='A' DO msgloop2=1 WHILE msgcom='A' | msgcom='O' CALL readlines(arg 1) IF nonstop=1 THEN rnonstop=1 ELSE rnonstop=0 CALL seelines(2) msgcom='' IF rnonstop THEN DO SAY CR nonstop=1 msgcom='' END ELSE DO pline='' IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain' IF level>sysoplevel | name=WORD(lynes.2,2) THEN pline=pline '['pen3'E'def']dit ['pen3'K'def']ill' IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove' IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal' pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply' IF level=99 THEN pline=pline '['pen3'!'def']' pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']' msgcom=getinput(1 0 STRIP(pline)' > ') CALL cleanline(0) END CALL checktime() IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN DO arg=dirname'/'msgcom IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom msgcom='A' ITERATE msgloop2 END ELSE msgcom=LEFT(msgcom,1) IF msgcom='Q' THEN LEAVE msgloop ELSE IF msgcom='!' & level>sysoplevel THEN DO CALL DELETE(arg) newchar=LEFT(lynes.1,1) IF newchar~='!' THEN newchar='!!' ELSE newchar=' ' lynes.1=OVERLAY(newchar,lynes.1,1,2) CALL savelines(arg) ITERATE msgloop2 END ELSE IF msgcom='A' THEN ITERATE msgloop2 ELSE IF msgcom='M' & level>sysoplevel THEN DO prevmsgdir=msgdir If ~areaselect() THEN DO himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1 lynes.1=' Msg:' himsg lynes.3=' To:' WORD(lynes.3,2) lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir nlyn=lynes.0+1 lynes.0=nlyn lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***' CALL savelines(msgpath||msgdir'/'himsg) CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg) CALL msgmark(WORD(lynes.3,2) msgdir himsg) CALL readlines(arg 1) CALL DELETE(arg) CALL DELAY(28) lynes.0=7 lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***' CALL savelines(arg) END msgdir=prevmsgdir msgcom='A' END ELSE IF msgcom='N' THEN DO nonstop=1 msgcom='' END ELSE IF msgcom='H' | msgcom='?' THEN DO SAY pen3' - HELP with the Read Messages commands -'def||CR SAY ' RETURN reads the next message in line.'CR SAY ' 34 will read message number 34, if it exists in this conference.'CR SAY ' A reads this message Again (in case it scrolled off screen).'CR IF level>sysoplevel | name=WORD(lynes.2,2) THEN DO SAY ' E puts this message into the online Editor.'CR SAY ' K deletes a message you wrote. you cannot Kill others!'CR END IF level>sysoplevel THEN SAY ' M move this message to a new conference.'CR SAY ' N displays all new messages without pausing. CTRL-E to Exit!'CR SAY ' O if this message is a reply, will read the Original message.'CR SAY ' R enters the message editor to Reply to this message.'CR SAY ' S allows you to Skip threads or conferences.'CR IF level=99 THEN SAY ' ! toggles the do-not-purge! flag for this message.'CR SAY ' Q returns to the message menu. (Quit)'CR SAY CR CALL waiting() msgcom='A' IF waitchar='Q' THEN LEAVE msgloop END ELSE IF msgcom='E' THEN DO IF level>sysoplevel | name=WORD(lynes.2,2) THEN DO sline=7 IF level>sysoplevel THEN sline=1 CALL bbsED(sline arg) msgcom='A' END END ELSE IF msgcom='S' & mess ') END IF stemp='T' THEN DO SAY CR SAY pen3 forthline||def||CR SAY 'Skipping messages with this subject heading...'CR SAY CR DO i=lastread.msgdir TO lstwrt IF msglist.i>1 THEN msglist.i=0 END skipsubj.0=skipsubj.0+1 sksb=skipsubj.0 skipsubj.sksb=forthline END ELSE DO SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def||CR lastread.msgdir=lstwrt-1 lw=lstwrt-1 msglist.lw=0 msglist.lstwrt=1 LEAVE mess END END ELSE IF msgcom='K' THEN DO IF level>sysoplevel | name=WORD(lynes.2,2) THEN DO IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN DO IF DELETE(arg)=1 THEN SAY pen3||arg||def' has been deleted.'CR grand=grand-1 msg.msgdir.0=msg.msgdir.0-1 END END END ELSE IF msgcom='O' THEN /* go back and read original */ DO IF WORDS(lynes.3)>3 THEN DO temp=WORD(lynes.3,4) arg=dirname'/'temp END ELSE SAY 'This is the original message.'CR END ELSE IF msgcom='R' THEN /* toname msgnum */ DO msgnum=WORD(lynes.1,2) forthline=lynes.4 IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */ DO savearg2=arg arg=dirname'/'WORD(lynes.3,4) IF EXISTS(arg) THEN DO IF readlines(arg 1) THEN BREAK xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess) IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg ELSE lynes.1=lynes.1' Reply' xmsg CALL DELAY(28) /* allow 1/2 sec for read to close */ CALL savelines(arg) END arg=savearg2 END END ELSE IF arg~=savearg THEN /* Continue */ DO msgcom='A' arg=savearg END END IF thread~='' THEN DO thread='' msgstatus=msgstatus+1 END END IF msgstatus>1 THEN msgstatus=msgstatus-1 END DROP msglist. skipsubj. IF quietflag~=1 THEN nonstop=0 RETURN showmarked: ARG ff . IF WORDS(data.24)<1 THEN RETURN fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:' IF ff THEN DO SAY CR SAY pen6||fline||def||CR END tempkk=data.24 DO i=1 TO WORDS(tempkk) tempk=WORD(tempkk,i) PARSE VAR tempk kdir'/'kmsg line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference' IF EXISTS(msgpath||tempk) THEN DO IF ff THEN SAY line'.'CR ELSE fline=fline'0A'x||line'.' END ELSE DO line=line 'is missing.' IF ff THEN SAY line||CR ELSE fline=fline'0A'x||line data.24=DELWORD(data.24,FIND(data.24,tempk),1) END END IF ff THEN DO CALL waiting() SAY CR END ELSE DO IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN CALL WRITELN(f,fline) CALL CLOSE(f) END RETURN killmark: PARSE ARG kdir kmsg . IF data.24='' THEN RETURN markword=FIND(data.24,kdir'/'kmsg) IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1)) RETURN readmarked: mrknum=WORDS(data.24) IF mrknum=0 THEN RETURN SAY 'Reading only messages addressed to you...'CR mrklist=data.24 msgcom='' DO rmki=1 TO mrknum WHILE msgcom~='Q' tempk=WORD(mrklist,rmki) PARSE VAR tempk mkdir'/'mkmsg . IF ~EXISTS(msgpath||tempk) THEN DO CALL killmark(mkdir mkmsg) SAY CR SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'CR SAY CR ITERATE rmki END msgdir=mkdir savelast=lastread.msgdir CALL readmsg(1 mkmsg) IF mkmsg>savelast THEN lastread.msgdir=mkmsg ELSE lastread.msgdir=savelast END CALL saveData(1) RETURN sortnumbers: PARSE ARG slist IF STRIP(slist)='' THEN RETURN '' sorted.='' oldest=999999 newest=0 newlist='' DO si=1 TO WORDS(slist) testword=WORD(slist,si) IF ~DATATYPE(testword,'W') THEN DO testpos=LASTPOS('.',testword) IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1) ELSE DO newlist=testword newlist ITERATE si END END ELSE tempnum=testword/1 IF sorted.tempnum='' THEN DO sorted.tempnum=testword sorted.tempnum.0=1 IF DATATYPE(tempnum,'W') THEN DO IF tempnum>newest THEN newest=tempnum IF tempnum 'def temp=getinput(1 1 line) CALL cleanline(0) END IF temp='W' THEN DO CALL editor('MAIL') RETURN END ELSE IF temp='F' THEN DO firsteditline=0 picklist.='' picklist.0=0 IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN DO picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ') picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_') picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ') IF picklist.1='' THEN RETURN IF FIND(userlist,picklist.1)=0 THEN DO SAY '***'pen3 picklist.1 def'does not exist!'||CR picklist.0=0 RETURN END fmaillist=SHOWDIR(bbspath'EMail/'picklist.1) DO ej=1 TO WORDS(fmaillist) ejname=WORD(fmaillist,ej) uname=ejname caret=LASTPOS('.',uname) IF caret>2 THEN uname=LEFT(uname,caret-1) IF uname=name THEN DO arg=bbspath'EMail/'picklist.1'/'ejname IF EXISTS(arg) THEN DO pklst=picklist.0+1 picklist.pklst=picklist.1 picklist.pklst.0=ejname picklist.0=pklst END END END IF picklist.0=0 THEN SAY 'No Email FROM you was found.'||CR ELSE DO SAY pen3'You have the following Email pending:'def||CR pickcheck=1 DO WHILE pickcheck~=0 pickcheck=pickfromlist() IF pickcheck~=0 THEN DO firsteditline=5 IF level>sysoplevel THEN firsteditline=1 CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN picklist.pickcheck='- KILLED -' END END END END ELSE DO users=WORDS(userlist) SAY pen3'Scanning'def users pen3'email directories...'def||CR SAY pen3' - To ABORT, press CTRL-E -'def||CR DO wi=1 TO users CALL busywait(60 wi users) fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi)) DO ej=1 TO WORDS(fmaillist) ejname=WORD(fmaillist,ej) uname=ejname caret=LASTPOS('.',uname) IF caret>2 THEN uname=LEFT(uname,caret-1) IF uname=name THEN DO arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname IF EXISTS(arg) THEN DO pklst=picklist.0+1 picklist.pklst=WORD(userlist,wi) picklist.pklst.0=ejname picklist.0=pklst END END END IF wi=999999 THEN RETURN END CALL busywait(4 0) IF picklist.0=0 THEN SAY lineup'No Email FROM you was found. 'CR ELSE DO SAY pen3'You have Email pending to the following users:'def||CR pickcheck=1 DO WHILE pickcheck~=0 pickcheck=pickfromlist() IF pickcheck~=0 THEN DO firsteditline=5 IF level>sysoplevel THEN firsteditline=1 CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN picklist.pickcheck='- KILLED -' END END END END DROP picklist. RETURN END ELSE IF temp='T' THEN BREAK ELSE RETURN END SAY 'Checking your mailbox...'CR nomail=1 CALL MAKEDIR(bbspath'EMail/'name) mailist=sortnumbers(SHOWDIR(bbspath'Email/'name)) IF WORDS(mailist)=0 THEN DO SAY lineup'Your mailbox is empty. 'CR SAY CR RETURN END line=WORDS(mailist) IF line>1 THEN line=line 'letters' ELSE line=line 'letter' line=line 'waiting.' SAY line||CR DO ii=1 TO WORDS(mailist) SAY 'Email:' pen3||WORD(mailist,ii)||def||CR END IF ~fromenu THEN IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN onename='' IF WORDS(mailist)>3 THEN DO IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN DO onename=getinput(1 0 'Read ONLY private mail from? > ') onename=SPACE(STRIP(UPPER(onename)),1,'_') onename=COMPRESS(onename,'.,:/*#?^ ') IF onename='' THEN RETURN IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN DO SAY '***'pen3 onename def'does not exist!'||CR RETURN END END END DO letter=1 TO WORDS(mailist) readname=WORD(mailist,letter) uname=readname caret=LASTPOS('.',uname) IF caret>2 THEN uname=LEFT(uname,caret-1) IF onename~='' & onename~=uname THEN ITERATE letter arg=bbspath'Email/'name'/'readname /* user has mail! */ CALL readlines(arg 1) delnum=WORD(lynes.1,2) CALL seelines(1) nomail=0 nonstop=0 mailfile='' IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4) ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4) IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN DO IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN DO SAY CR SAY pen3'The attached file is unarchived and may be incomplete.'CR SAY 'If the archiver is still building this file, downloading will fail.'def||CR IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter SAY CR END curdir=PRAGMA('D') CALL setdir(bbspath'EmailFiles/'name) filesize=WORD(STATEF(mailfile),2) IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes. Download now? (nY) > ')~='N' THEN DO savearg=arg allargs=bbspath'EmailFiles/'name'/'mailfile DO WHILE dload2()=1 END arg=savearg CALL readlines(arg 1) END CALL setdir(curdir) END IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN DO tempchar='A' DO WHILE tempchar='A' tempchar=getinput(1 1 '['pen3'A'def']gain ['pen3'C'def']ontinue ['pen3'R'def']eply (acR) > ') IF tempchar='' THEN tempchar='R' IF tempchar='A' THEN CALL seelines(1) END IF tempchar='R' THEN DO IF WORDS(lynes.4)<2 THEN replysubj='NONE' ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2)) CALL editor('MAIL' uname) replysubj='' END END IF LEFT(readname,6)~='BBBBS.' THEN DO tempchar='A' DO WHILE tempchar='A' tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ') IF tempchar='A' THEN CALL seelines(1) END IF tempchar='Y' THEN DO IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN DO ei=1 TO thechosen.0 WHILE thechosen.ei~='' CALL MAKEDIR(bbspath'EMail/'thechosen.ei) forwardarg=bbspath'Email/'thechosen.ei'/'readname ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg CALL readlines(forwardarg 1) lynes.1=lynes.1' Forwarded to you by' name TIME('C') DATE() CALL DELETE(forwardarg) CALL savelines(forwardarg) IF WORDS(lynes.2)>3 THEN DO forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4) IF EXISTS(forname) THEN DO CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei) ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei END END line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def IF emailonline>=0 THEN emailonline=emailonline+1 CALL send2log(line) SAY line||CR END END END tempchar='' tempstr='Delete the email ('pen3||delnum||def') from'pen3 uname def'that you just read?' IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ') ELSE DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y' tempchar=getinput(1 1 tempstr '(nqy) > ') END IF tempchar='Q' THEN DO IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN DO readname='' uname='' RETURN END END ELSE IF tempchar~='N' THEN DO dirname=bbspath'Email/'name'/' nodelete=0 IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN nodelete=1 IF nodelete THEN ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop ELSE emailonline=emailonline-1 CALL DELETE(dirname||readname) tempstr='Old email' IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN DO IF nodelete THEN ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop CALL DELETE(bbspath'EmailFiles/'name'/'mailfile) CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl') tempstr=tempstr 'and attached file' END tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!' SAY tempstr||CR IF tempchar='Q' THEN IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN DO readname='' uname='' RETURN END END ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN DO ii=LEFT(readname,POS('.',readname)-1) ii=SUBSTR(ii,4)%1 IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN DO temp=TRANSLATE(readname,'/','.') temp=SUBSTR(temp,4) lynes.1='!!'STRIP(lynes.1) edtype='' CALL savelines(msgpath||temp) CALL DELETE(bbspath'Email/'name'/'readname) END END ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN DO arg=bbspath'Email/'name'/'readname CALL readlines(arg 1) IF WORDS(lynes.5)<7 THEN DO lynes.5=lynes.5' (Rcvd)' DATE('W') DATE() TIME('C') CALL DELETE(arg) CALL savelines(arg) SAY 'Email has been marked as received.'CR END END CALL checktime() readname='' uname='' arg='' END IF nomail THEN DO SAY 'No mail was found.'CR CALL waiting() END CALL setdir(libpath||dirs.1) thechosen.='' RETURN selectchosen: PARSE ARG startat selectline IF startat<2 THEN thechosen.='' line='Enter list of comma separated user names' IF level>sysoplevel THEN line=line 'or ALL' SAY line||CR thechosen.startat=getinput(1 0 selectline' ') IF STRIP(thechosen.startat)='' THEN RETURN 1 thechosen.startat=SPACE(thechosen.startat,1,'_') thechosen.0=startat IF level>sysoplevel & thechosen.startat='ALL' THEN thechosen.startat=SHOWDIR(bbspath'Users','F',',') IF POS(',',thechosen.startat)>0 THEN DO temp=TRANSLATE(thechosen.startat,' ',',') thechosen.0=thechosen.0+WORDS(temp)-1 DO ei=1 TO WORDS(temp) eii=startat+ei-1 thechosen.eii=STRIP(WORD(temp,ei)) END END DO ei=startat TO thechosen.0 DO WHILE FIND(userlist,thechosen.ei)=0 IF thechosen.ei~='' THEN DO IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN DO thechosen.ei=sysop ITERATE ei END CALL loadcourtesy() IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei END SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR thechosen.ei=getinput(1 0 pen3||selectline' 'def) IF thechosen.ei='' THEN DO IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN CALL showuserlist() ITERATE ei END thechosen.ei=SPACE(thechosen.ei,1,'_') END END RETURN 0 countcheck: PARSE ARG fname' 'cknum' '. IF ~EXISTS(fname) THEN DO IF cknum=0 THEN RETURN 0 IF ~writeopen(fname) THEN RETURN 0 CALL WRITELN(f,cknum) CALL CLOSE(f) RETURN cknum END IF ~readopen(fname) THEN RETURN cknum retval=STRIP(READLN(f)) CALL CLOSE(f) IF ~DATATYPE(retval,'W') THEN retval=0 IF ~DATATYPE(cknum,'W') THEN cknum=0 IF retval 'def) IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0 RETURN emnum sysED: IF level<99 THEN RETURN arg=getinput(0 0 'Textfile To Edit: ') IF arg='' THEN RETURN CALL bbsED(1 arg) RETURN bbsED: PARSE ARG firstedit editarg . notchanged=1 IF readlines(editarg 1) THEN RETURN 1 finfo=STATEF(editarg) IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8)) ELSE finfo='' SAY CR SAY ' 'pen3'Entering the EDITOR module..'def||CR SAY CR count=1 DO edloop=1 IF edcom='S' & bbsprefs.5 THEN /* spell check */ DO SAY pen3'You must use ['def'R'pen3']eplace to make corrections. 'pen2'Spellchecking...'def||CR CALL DELETE(scratch'/SpellFile') CALL savelines(scratch'/SpellFile') curdir=PRAGMA('D') CALL setdir(spellpath) CALL SpellChk.rexx(scratch'/SpellFile') CALL setdir(curdir) END ELSE DO IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7) IF edcom~='L' THEN count=count-linesperpage IF count>=lynes.0 | count<1 THEN count=1 startcount=count DO i=startcount TO lynes.0+1 IF ((i+1-startcount)//linesperpage)=0 THEN DO pline=' ['pen3'E'def']dit' pline=pline ' ['pen3'RETURN'def']=Continue ' edcom=getinput(1 1 pline) IF edcom~='' THEN LEAVE i CALL cleanline(1) END SAY pen3||RIGHT(i,3)||def lynes.i||CR count=count+1 END END CALL checktime() SAY lineup' ['pen3'A'def']ppend ['pen3'C'def']ut ['pen3'I'def']nsert ['pen3'K'def']ill ['pen3'?'def'] Help'CR pline=' ['pen3'L'def']ist ['pen3'P'def']aste ['pen3'R'def']eplace' IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck' pline=pline '['pen3'U'def']pload-Text > ' edcom=getinput(1 0 pline) IF edcom='Q' | edcom='X' THEN edcom='' IF edcom='?' THEN DO SAY CR SAY ' Editor Help'CR SAY '----------------------------------------------------------'CR SAY ' an empty RETURN tells the editor you are done editing.'CR SAY ' 7 edits line number 7, if it exists.'CR SAY ' a Append text to this file.'CR SAY ' c Cut selected line(s) of text to buffer.'CR SAY ' i Insert blank line.'CR SAY ' k Kill (delete) this file.'CR SAY ' l List this file from selected line.'CR SAY ' p Paste buffer contents to selected line number.'CR SAY ' r Replace a phrase or line of text.'CR SAY ' s Spellcheck this file.'CR SAY ' u Upload a textfile to append to this file.'CR SAY '----------------------------------------------------------'CR SAY CR OPTIONS PROMPT '' PULL END IF edcom='K' THEN DO junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ') IF junk='Y' THEN DO IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN DO IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN SAY WORD(lynes.2,4) 'DELETED.'CR END RETURN 2 END END IF edcom='' THEN DO SAY ' 'pen3'Leaving the EDITOR module.'def||CR IF notchanged THEN RETURN 0 IF getinput(1 1 ' Save changes? (nY)'pen3' > 'def)='N' THEN RETURN 1 CALL DELETE(editarg) IF savelines(editarg) THEN RETURN 1 CALL DELAY(28) IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo SAY pen3' Changes saved.'def||CR RETURN 0 END ELSE IF edcom='C' THEN /* Cut */ DO firstnum=getinput(1 0 ' Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def) IF firstnum='' THEN ITERATE edloop dash=POS('-',firstnum) IF dash>0 THEN DO lastnum=STRIP(SUBSTR(firstnum,dash+1)) firstnum=STRIP(LEFT(firstnum,dash-1)) END ELSE lastnum=firstnum IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN DO junk=getinput(1 1 pen3'*** You must enter numbers here! 'def) ITERATE edloop END IF lastnum>lynes.0 THEN lastnum=lynes.0 IF firstnumlastnum THEN DO SAY '*** Input error! First number larger than last number.'CR ITERATE edloop END notchanged=0 numdiff=lastnum+1-firstnum pasted.='' pasted.0=numdiff k=0 DO i=firstnum TO lynes.0 j=i+numdiff k=k+1 IF k<=numdiff THEN pasted.k=lynes.i lynes.i=lynes.j lynes.j='' END lynes.0=lynes.0-numdiff count=1 END ELSE IF edcom='A' THEN /* append */ DO CALL writebuffer(scratch'/EditorFile') notchanged=0 END ELSE IF edcom='U' THEN /* Upload a textfile to append */ DO CALL txup(1) notchanged=0 END ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN DO IF DATATYPE(edcom,'W') THEN DO ednum=edcom edcom='R' END ELSE DO line=pen3' ' IF edcom='L' | edcom='P' THEN line=line'Starting ' line=line'Line Number? > 'def ednum=getinput(1 0 line) END IF ~DATATYPE(ednum,'W') THEN ITERATE edloop IF ednum>(lynes.0+1) THEN ITERATE edloop IF edcom='L' THEN DO count=ednum ITERATE edloop END IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN DO IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN DO filenum=STRIP(WORD(lynes.1,2)) num=files.filenum.0 keywords=edkeywords(editarg) lynes.1=LEFT(lynes.1,21) keywords alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32)) savefileflag=1 notchanged=0 ITERATE edloop END END IF ednum'def PARSE PULL stext IF LENGTH(stext)=0 THEN DO IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN ITERATE edloop lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def) notchanged=0 ITERATE edloop END found=POS(UPPER(stext),UPPER(lynes.ednum)) IF found=0 THEN DO SAY CR SAY stext' was not found!'CR SAY CR ITERATE edloop END OPTIONS PROMPT pen3'...Replacement text? >'def PARSE PULL rtext lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext)) lynes.ednum=INSERT(rtext,lynes.ednum,found-1) IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN DO PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords PARSE VAR lynes.3 . 'Lib:' libnam filenum=STRIP(filenum) newc=files.filenum.0 libnum=finddirnum(libnam) alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4))) alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5) alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12) alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32)) savefileflag=1 END SAY 'Done.'CR SAY CR notchanged=0 END ELSE IF edcom='I' THEN /* insert */ DO DO i=lynes.0 TO ednum BY -1 j=i+1 lynes.j=lynes.i END lynes.ednum='' notchanged=0 lynes.0=lynes.0+1 lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def) END ELSE IF edcom='P' THEN /* paste */ DO DO i=lynes.0 TO ednum BY -1 j=i+pasted.0 lynes.j=lynes.i END DO k=1 TO pasted.0 kk=ednum+k-1 lynes.kk=pasted.k END notchanged=0 lynes.0=lynes.0+pasted.0 END END END RETURN 0 editor: toname='' msgnum=0 thechosen.='' PARSE ARG edtype toname msgnum . IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0') ELSE DO IF edtype='MSG' THEN DO tempmsgdir=0 IF DATATYPE(arg,'W') THEN tempmsgdir=arg IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN msgdir=tempmsgdir ELSE IF areaselect() THEN RETURN END lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0) END IF toname='' THEN DO IF edtype='MAIL' THEN DO CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def) toname=thechosen.1 END ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def) END toname=SPACE(toname,1,'_') toname=cleanstring(1':'toname) IF toname='' | FIND(exclusion,toname)>0 THEN DO IF toname='' & edtype='MSG' THEN toname='ALL' ELSE toname=sysop SAY pen3'*** Re-Addressed to'def toname||CR END IF toname~='ALL' THEN DO IF toname='BBBBS' THEN toname=sysop IF FIND(userlist,toname)=0 THEN DO IF courtesy='' THEN CALL loadcourtesy() IF FIND(courtesy,toname)=0 THEN DO SAY CR SAY bak2' 'toname' is not on the user list! 'def||CR IF edtype='MAIL' THEN DO CALL showuserlist() RETURN 0 END ELSE DO IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN DO IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN CALL showuserlist() RETURN 0 END END END END END IF toname=sysop THEN CALL sound('FEEDBACK') ELSE CALL sound('MESSAGE') IF edtype='MAIL' THEN DO CALL MAKEDIR(bbspath'EMail/'toname) mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1 END ELSE DO CALL MAKEDIR(msgpath||msgdir) mailname=msgpath||msgdir'/'lastwrit+1 END lynes.='' lynes.0=6 IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1 /* FILE: filename */ ELSE lynes.1=' Msg:' lastwrit+1 /* Msg: MSG# REPLY # # ... */ lynes.2=' From:' name IF city~='' THEN lynes.2=lynes.2' - 'city lynes.3=' To:' toname /* To: toname MSG # */ IF edtype='MAIL' THEN DO IF readopen(bbspath||'Users/'toname) THEN DO CALL READLN(f) CALL READLN(f) temp=READLN(f) CALL CLOSE(f) temp=docity(temp) IF temp~='' THEN lynes.3=lynes.3' - 'temp END IF replysubj='|@NEW@|' THEN DO CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7) replysubj='Welcome to' bbsname END END subj='' IF edtype='REPLY' THEN DO subj=SUBSTR(forthline,WORDINDEX(forthline,2)) SAY pen3'Subj:'def subj||CR temp=getinput(0 0 'Change the current subject? (Ny) > ') IF LENGTH(temp)>3 THEN subj=temp ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj='' END ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj IF subj='' THEN DO IF opt='C' THEN subj='FEEDBACK' ELSE DO SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR subj=getinput(0 0 pen3': 'def) END END IF LENGTH(subj)>66 THEN subj=LEFT(subj,66) IF subj='' THEN subj='?' lynes.4=' Subj:' subj lynes.5=' Date:' DATE('W') DATE()' 'TIME('C') IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir lynes.6=LEFT('',74,'=') IF edtype='REPLY' THEN lynes.3=lynes.3' MSG 'msgnum DO i=1 TO lynes.0 SAY lynes.i||CR END CALL writebuffer(scratch'/MessageFile') IF savelines(mailname) THEN RETURN 0 CALL seelines(1) IF thechosen.0='' THEN DO thechosen.0=1 thechosen.1=toname END carbons=thechosen.0+1 DO FOREVER IF thechosen.0>=carbons THEN DO junk='Copies To:' DO cci=carbons TO thechosen.0 junk=junk thechosen.cci END SAY junk||CR END pline='' IF edtype='MAIL' THEN pline='['pen3'C'def']opies' pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead') pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def junk=getinput(1 1 pline) IF junk='E' THEN DO IF level>sysoplevel THEN firstedit=1 ELSE firstedit=7 IF bbsED(firstedit mailname)=2 THEN RETURN 0 junk='R' END ELSE IF edtype='MAIL' & junk='C' THEN DO CALL selectchosen(carbons pen3'Carbon Copies To: 'def) junk='R' END ELSE IF junk='K' THEN DO IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR RETURN 0 END ELSE IF junk='U' THEN DO CALL txup(0 mailname) junk='R' END IF junk='R' THEN DO CALL readlines(mailname 1) CALL seelines(1) nonstop=0 END ELSE BREAK END IF edtype='MAIL' THEN DO IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN DO junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ') IF junk~='N' THEN DO arg=bbspath'Email/'name'/'readname IF ~readlines(arg 1) THEN CALL savelines(mailname) END END junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def) IF junk='Y' THEN DO savearg=arg arg=getinput(0 0 'Filename: ') curdir=PRAGMA('D') CALL MAKEDIR(bbspath'EmailFiles/'toname) CALL setdir(bbspath'EmailFiles/'toname) DO WHILE uload(0)=2 END IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN DO CALL readlines(mailname 1) IF arg~='' THEN lynes.1=lynes.1' FILE: 'arg CALL setdir(curdir) CALL DELETE(mailname) CALL savelines(mailname) END ELSE DO CALL DELETE(bbspath'EmailFiles/'toname'/'arg) SAY pen3'*** Upload failed! ***'def||CR END arg=savearg END totmail=WORD(data.17,2) IF ~DATATYPE(totmail,'W') THEN totmail=1 ELSE totmail=totmail+1 data.17=WORD(data.17,1)' 'totmail' 'WORD(data.17,3) END IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1 CALL readlines(mailname 1) DO ui=1 TO thechosen.0 IF thechosen.ui='' THEN ITERATE ui IF ui>1 THEN DO CALL MAKEDIR(bbspath'Email/'thechosen.ui) newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1 IF ui3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN DO CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui) ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui line2='Copied' WORD(lynes.1,4) SAY line2 'to the' thechosen.ui 'file area.'CR CALL send2log(line2) END END line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui IF edtype~='MAIL' THEN DO IF FIND(userlist,thechosen.ui)>0 THEN CALL msgmark(thechosen.ui msgdir lastwrit+1) line=line 'in' msg.msgdir END CALL send2log(line) line=edtype 'Sent To' thechosen.ui IF edtype='MAIL' THEN DO IF emailonline>=0 THEN emailonline=emailonline+1 END ELSE DO grand=grand+1 IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1 ELSE msg.msgdir.0=msg.msgdir.0+1 line=line 'in the'pen3 msg.msgdir def'conference.' END SAY line||CR END IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1) ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1) CALL setdir(libpath||dirs.1) thechosen.='' RETURN 1 txup: PARSE ARG upflg uparg . SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR pline='Are you SURE your file is un-compressed text? (Ny) > ' IF getinput(1 1 pline)='Y' THEN DO savearg=arg arg='UploadFile' curdir=PRAGMA('D') CALL setdir(scratch) CALL DELETE(arg) CALL DELETE('tempfile1') IF uload(0)=0 THEN DO IF upflg=0 THEN DO ADDRESS COMMAND 'C:copy' uparg 'tempfile1' CALL DELETE(uparg) ADDRESS COMMAND 'C:join tempfile1 UploadFile AS' uparg END ELSE IF upflg=1 THEN DO CALL readlines(arg lynes.0+1) notchanged=0 END END CALL setdir(curdir) arg=savearg END RETURN msgmark: PARSE ARG markname markdir markmsg . IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN mlines.='' DO mi=1 temp=READLN(f) IF EOF(f) THEN LEAVE mi mlines.mi=STRIP(temp) END CALL CLOSE(f) mlines.0=mi-1 CALL DELAY(28) mlines.24=STRIP(mlines.24 markdir'/'markmsg) IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN DO mi=1 TO mlines.0 CALL WRITELN(f,mlines.mi) END CALL CLOSE(f) RETURN shell: SAY CR olddir=PRAGMA('D') DO WHILE(UPPER(opt)~='EXIT') SAY bak2||TIME('C')||def PRAGMA('D')||CR OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def PARSE PULL opt' 'arg CALL checkdcd() IF(UPPER(opt)='CD') THEN CALL setdir(arg) ELSE IF exists(opt)~=0 THEN DO IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt) END ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN ADDRESS COMMAND opt '<* >*' arg END CALL PRAGMA('D',olddir) RETURN yell: chatrequest=1 IF excuses.1='' THEN DO IF readopen(bbspath'Lists/Excuses') THEN DO DO i=1 line=READLN(f) IF EOF(f) THEN BREAK excuses.i=line END excuses.0=i-1 CALL CLOSE(f) END END j=TIME('S')//excuses.0+1 SAY CR SAY 'Sorry, your SysOp,' sysop','CR IF excuses.j~='' THEN SAY excuses.j||CR ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR SAY CR IF bbsprefs.13 THEN RETURN SAY 'I''m yelling anyway...'CR SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR CALL sound('YELL') ADDRESS AREXX bbsSpeak.rexx 'CHAT' name bbspath saypath RETURN /* online change to member. Sysop triggered by BumpMember.baud */ /* user triggered by Call Back Verification CBV: */ validate: ARG varg . IF readopen(bbspath'BBS_TEXT/'varg) THEN DO SAY CR SAY 'You are being validated. Please wait...'CR SAY CR DO lvi=1 TO 22 line=READLN(f) IF lvi=11 THEN data.11=line IF lvi=20 THEN data.20=line END data.22=line CALL CLOSE(f) CALL SetData() CALL sortlibraries() IF bbsprefs.25=1 THEN DO data.22='' data.23='' SAY CR SAY 'Setting message counters to last 10 messages in each conference...'CR DO i=1 TO level num=countcheck(bbspath'Numbers/LastMessage'i 0)-10 IF num<0 | msg.i.0<10 THEN num=0 lastread.i=num data.22=data.22 num data.23=data.23 0 END SAY 'Setting file counter to last file uploaded...'CR lastbrowse=countcheck(bbspath'Numbers/LastFile' 0) newfilesdate='19900101 00:00:00' END SAY CR CALL logonstats() CALL saveData(0) IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN DO CALL MAKEDIR(bbspath'EMail/'name) lastwrit=countcheck(bbspath'Numbers/LastMail' 0)+1 IF lastwrit>1 THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit) lynes.='' lynes.1=' Mail:' lastwrit lynes.2=' From:' sysop lynes.3=' To:' name lynes.4=' Subj: Welcome to' bbsname lynes.5=' Date:' DATE('W') DATE()' 'TIME('C') lynes.6=LEFT('',74,'=') CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7) CALL savelines(bbspath'EMail/'name'/'sysop'.'lastwrit) SAY 'You have welcoming EMail.'CR END CALL waiting() IF bbsprefs.22=2 THEN DO SAY CR SAY pen3||name def'is now a fully valadated member of'pen3 bbsname||def||CR SAY 'All the features of the BBS will be available on your next call.'CR SAY CR CALL waiting() SIGNAL LOGOUT2 END SIGNAL RESTART END ELSE DO SAY 'Sorry. Auto-validation is disabled.'CR temp=' ***' sysop'! You need a default file in BBS_TEXT! (' varg ') *** ' MSG bak2||temp||def||CR CALL Send2log(temp) END RETURN /* online time change. Sysop triggered by BumpTime.baud */ uptime: mins=GETCLIP('BBS_minutes') IF DATATYPE(mins,'N') THEN DO IF (mins*60)>maxtime THEN SAY name', this session''s time has been increased to' mins 'minutes.'CR ELSE MSG '*** User has not been told that his time has decreased.' CALL SETCLIP('BBS_minutes') maxtime=mins*60 END RETURN /* online level change. Sysop triggered by BumpLevels.baud */ uplevel: levl=GETCLIP('BBS_level') IF DATATYPE(levl,'W') THEN DO IF levl>data.20 THEN SAY name', your level has been changed from' data.20 'to' levl'.'CR ELSE MSG '*** User has not been told his level has been reduced.' data.20=levl CALL SetData() IF menu='NEW' THEN menu='ALL' CALL sortlibraries() END RETURN /* online ratio change. Sysop triggered by BumpLevels.baud */ upratio: rats=GETCLIP('BBS_ratio') IF DATATYPE(rats,'W') THEN DO SAY name', your upload:download ratio has been changed to 1:'rats'.'CR data.17=rats' 'WORD(data.17,2)' 'WORD(data.17,3) CALL SETCLIP('BBS_ratio') END RETURN bytes2user: PARSE ARG indx bytes . tfiles=WORD(data.indx,1) tbytes=WORD(data.indx,3) IF ~DATATYPE(tfiles,'W') THEN tfiles=0 IF ~DATATYPE(tbytes,'W') THEN tbytes=0 tbytes=tbytes+bytes tfiles=tfiles+1 IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.' ELSE data.indx='1 file' bytes 'bytes.' data.indx=data.indx DATE() CALL saveData(0) RETURN stats: ARG indx tfail='' bytes='' Status z string=RESULT IF RIGHT(BB_VERS,4)>1.59 THEN DO PARSE VAR string . 'Local Name: 'temp . 'Xfer''ed: 'bytes . 'Elapsed Time: 'min':'sec'0A'x . slash=LASTPOS('/',temp) IF slash=0 THEN slash=LASTPOS(':',temp) IF slash~=0 THEN temp=SUBSTR(temp,slash+1) END ELSE PARSE VAR string temp' 'min':'sec . 'Bytes:'bytes . temp=STRIP(temp) min=STRIP(min) sec=STRIP(sec) bytes=STRIP(bytes) IF temp~='' & LEFT(UPPER(STRIP(temp)),8)~=LEFT(UPPER(arg),8) THEN tfail='wrong file' temp ELSE IF DATATYPE(min,'W') & DATATYPE(sec,'W') & DATATYPE(bytes,'W') THEN DO secs=(min*60)+sec IF indx=14 THEN CALL DELAY(100) /* wait for dos to finish upload */ temp=STATEF(PRAGMA('D')'/'arg) temp=WORD(temp,2) IF ~DATATYPE(temp,'W') THEN temp=0 IF indx=14 & (temp+1024)(bytes+1024) THEN tfail='dl size' END ELSE tfail='not numeric: min='min 'sec='sec 'bytes='bytes IF tfail~='' THEN DO line=plaindir'/'arg pen3'*** Transfer failed! ***'def SAY line||CR CALL send2log(line 'tfail:'tfail) CALL send2log('***' string) CALL sound('TFAIL') IF indx=14 & WORD(STATEF(arg),2)=0 THEN CALL DELETE(arg) RETURN 1 END ELSE IF secs>0 THEN Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR Remote OFF Send '^G' Remote ON line=left(arg,16,' ') IF indx=14 THEN DO temp=countcheck(bbspath'Numbers/Bytes.UpLoad' 0)+bytes CALL countcheck(bbspath'Numbers/Bytes.UpLoad' temp) line=line 'uled' END ELSE DO temp=countcheck(bbspath'Numbers/Bytes.DownLoad' 0)+bytes CALL countcheck(bbspath'Numbers/Bytes.DownLoad' temp) temp=countcheck(bbspath'Numbers/Files.DownLoad' 0)+1 CALL countcheck(bbspath'Numbers/Files.DownLoad' temp) temp=PRAGMA('D') xdev=SPACE(LEFT(temp,POS(':',temp)-1),1,'_') tfiles=1 IF EXISTS(arg'.xdl') THEN DO IF readopen(arg'.xdl') THEN DO xdev=READLN(f) tfiles=READLN(f) CALL CLOSE(f) END END temp=countcheck(bbspath'Numbers/Bytes.X.'xdev 0)+bytes CALL countcheck(bbspath'Numbers/Bytes.X.'xdev temp) temp=countcheck(bbspath'Numbers/Files.X.'xdev 0)+tfiles CALL countcheck(bbspath'Numbers/Files.X.'xdev temp) line=line 'dled' END line=line protocol TIME('C') bytes 'bytes' PRAGMA('D') CALL send2log(line) RETURN 0 bbsspace: ARG tabspace . ADDRESS COMMAND 'C:info >ram:infout' bbsdevice ok=OPEN(f,'ram:infout','R') IF ok=0 THEN RETURN 20 line=READLN(f) line=READLN(f) line=READLN(f) line=READLN(f) CALL CLOSE(f) IF tabspace<14 THEN SAY CR bbsk=WORD(line,4) IF ~DATATYPE(bbsk,'N') THEN DO line=bbsdevice 'is not an info compatible device!' CALL send2log(line) SAY pen3||line||def||CR bbsk=0 RETURN END bbsk=bbsk*512-SYSTEM_SPACE_LIMIT IF bbsk<1 THEN bbsk=0 SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR RETURN comma: ARG num . dgt=LENGTH(num) numtext='' IF dgt>3 THEN numtext=','RIGHT(num,3) IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext IF dgt>12 THEN DO numtext=','LEFT(RIGHT(num,12),3)||numtext numtext=LEFT(num,dgt-12)||numtext END ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext ELSE numtext=num RETURN numtext is_here: ARG newname CALL WRITECH(STDOUT,'Checking filelist') DO wi=1 TO 99 IF wi//3=0 THEN CALL WRITECH(STDOUT,'.') IF dirs.wi='' THEN ITERATE wi IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi line=pen3'*** File' newname 'already exists here' IF wi<=level THEN line=line 'in the' dirs.wi 'directory' line=line'.'def SAY CR SAY line||CR SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR CALL waiting() RETURN 1 END SAY CR CALL cleanline(1) RETURN 0 uload: ARG frommenu IF frommenu THEN DO SAY CR SAY pen3'PLEASE!'def 'Only upload 1 (one) archive at a time. NO BATCH UPLOADING! Thanks.'CR END CALL bbsspace(12) SAY CR IF bbsk<1 THEN DO line='Upload area is full!' CALL send2log(line) SAY pen3||line||def||CR RETURN 1 END IF arg='' THEN arg=getinput(0 0 'Filename: ') /* no filename given */ arg=cleanstring('0:'arg) arg=COMPRESS(arg,' :/,;|#?*') /* be sure no illegals here */ x=LASTPOS('/',arg) IF x=0 THEN x=LASTPOS(':',arg) IF x>0 THEN DO IF DATATYPE(SUBSTR(arg,x+1),'W') THEN DO SAY 'Whole numbers are not allowed as filenames!'CR CALL waiting() RETURN 1 END END tempnum=LENGTH(arg)-16 DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 temp=' 'pen3||arg def'is'pen3 tempnum||def IF tempnum=1 THEN temp=temp 'character' ELSE temp=temp 'characters' temp=temp 'too long for a filename.' SAY temp||CR arg=getinput(0 0 'Filename: ') arg=cleanstring('0:'arg) arg=COMPRESS(arg,' :/,;|#?*()+[]"{}') tempnum=LENGTH(arg)-16 END IF arg='' THEN RETURN 1 IF frommenu THEN DO IF is_here(arg) THEN RETURN 1 IF wi=999999 THEN RETURN 1 IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops') ELSE DO loop=1 SAY 'Please select an appropriate library for -' pen3||arg def'-'CR temp=chdir() IF temp=0 THEN LEAVE loop IF temp=2 THEN RETURN 1 END END checkproto='T' targ=arg DO WHILE checkproto='T' arg='' SAY CR SAY 'Library:'pen3 plaindir def' Filename:'pen3 targ def' Protocol:'pen3 protocol||def||CR pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol' pline=pline '['pen3'U'def']pload (qtU) > ' checkproto=getinput(1 1 pline) IF checkproto='Q' THEN RETURN 1 IF checkproto='T' THEN CALL chpro() END arg=targ CALL postuser(4) CALL sound('UPLOAD') uploadtime=TIME('E') SAY 'Starting' protocol 'transfer. Press' pen3'Esc'def 'to abort.'CR CALL whodat() DownLoad arg IF RC>0 | stats(14) THEN RETURN 2 rbytes=WORD(STATEF(arg),2) IF rbytes<1 THEN DO CALL DELETE(arg) RETURN 2 END temp='' DO WHILE temp~='N' & temp~='Y' temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ') END IF temp='N' THEN RETURN 2 IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN DO SAY CR SAY pen3'***'def arg pen3'failed archive check!'def||CR SAY CR temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ') IF temp~='Y' THEN DO CALL DELETE(arg) SAY CR RETURN 2 END END CALL bytes2user(14 rbytes) ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg IF bbsprefs.9 & name~=sysop THEN DO newufile=bbspath'EMail/'sysop'/NEW_FILES' IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A') ELSE DO ok=OPEN(f,newufile,'W') IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') END IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg' 'DATE() TIME()) CALL CLOSE(f) CALL sound('NEW_FILE') END IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0 DO ui=sysoplevel+2 TO 100 IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0 /* no filenotes */ END IF frommenu THEN DO uploadtime=TIME('E')-uploadtime IF bbsprefs.11 THEN DO maxtime=maxtime+uploadtime line='This session''s time has been increased by' line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.' SAY CR SAY line||CR END DO WHILE editnote(arg) /* INSIST on a filenote */ END SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR END waitchar='' RETURN 0 findfiles: PARSE ARG ffile . IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile wi=0 IF DATATYPE(ffile,'W') THEN DO IF WORDS(files.ffile)<2 THEN RETURN 0 dirtemp=WORD(files.ffile,1) IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN DO CALL illegal_access() RETURN 0 END CALL setdir(libpath||dirtemp) END ELSE IF EXISTS(ffile) THEN DO IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN DO IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN DO line=READLN(f) CALL CLOSE(f) ffile=WORD(line,2) END END END ELSE IF EXISTS(bbspath'Information'ffile) THEN RETURN bbspath'Information/'ffile ELSE DO nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1 CALL busywait(4 1) DO ni=nextfilenum TO 0 BY -1 IF ni=0 THEN DO CALL busywait(4 0) SAY CR SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR SAY CR RETURN 0 END IF ni>1 THEN CALL busywait(60 ni nextfilenum) argtemp=WORD(files.ni,2) IF UPPER(argtemp)=UPPER(ffile) THEN DO dirtemp=WORD(files.ni,1) jj=files.ni.0 IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN DO CALL busywait(4 0) CALL illegal_access() RETURN 0 END ffile=ni CALL setdir(libpath||dirtemp) LEAVE ni END END CALL busywait(4 0) END IF wi=999999 THEN RETURN 0 ftemp=ffile IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2) IF ~EXISTS(ftemp) THEN DO finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp) IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8) IF ~EXISTS(ftemp) THEN DO IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR ELSE DO SAY CR IF WORDS(finfo)<8 THEN ftemp=plaindir'/'ftemp SAY '***'pen3 ftemp def'is not currently available online.'CR SAY ' Would you like me to notify the sysop'CR SAY ' that you''d like to receive this file?'CR IF getinput(1 1 ' (Ny) > ')='Y' THEN DO enum=countcheck(bbspath'Numbers/LastMail' 0)+1 CALL countcheck(bbspath'Numbers/LastMail' enum) IF writeopen(bbspath'email/'sysop'/'name'.'enum)=0 THEN RETURN CALL WRITELN(f,' Mail: 'enum ) CALL WRITELN(f,' From: 'name) CALL WRITELN(f,' To: 'sysop) CALL WRITELN(f,' Subj: File Request') CALL WRITELN(f,' Date: 'DATE()' 'TIME('C')) CALL WRITELN(f,'====================================================================') CALL WRITELN(f,' Mr. Sysop, I would like to have this file : ') CALL WRITELN(f,' 'ftemp) CALL WRITELN(f,' ') CALL CLOSE(f) SAY CR ADDRESS AREXX bbsSpeak.rexx 'FILE_REQUEST' name bbspath saypath SAY 'Your file request has been sent!'CR SAY 'The file should be in your Email soon.'CR END SAY CR END RETURN 0 END END RETURN ffile illegal_access: SAY CR SAY '*** You are not authorized to access' ffile'!'CR SAY '*** Send Email to' sysop 'to receive a higher level.'CR SAY CR IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2) CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp) RETURN statuscheck: PARSE ARG ffile updownratio=WORD(data.17,1) IF ~DATATYPE(updownratio,'N') THEN updownratio=100 upbytes=WORD(data.14,3) IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1 dnbytes=WORD(data.15,3) IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1 dbytes=WORD(STATEF(ffile),2) IF ~DATATYPE(dbytes,'W') THEN dbytes=1 IF ~DATATYPE(bps,'W') THEN bps=2400 needtime=dbytes%(bps%10)+10 /* plus 10 seconds for handshaking? */ SAY CR SAY CR CALL showtime() SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR IF level>(sysoplevel+1) | POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0 IF (needtime+TIME('E'))>maxtime THEN DO SAY CR SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR IF needtime>(WORD(data.11,1)*60) THEN SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR SAY CR RETURN 1 END IF updownratio>0 & (dnbytes/upbytes)>updownratio THEN DO SAY CR line=pen3' *** You must upload before you do any more downloading! ***'def SAY line||CR SAY ' Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR IF bbsprefs.4 THEN RETURN 1 SAY pen3' - This requirement is temporarily suspended. -'def||CR SAY CR END RETURN 0 ext_dload: SAY CR CALL checkdcd() allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs) IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN CALL dload2() RETURN dload: arg=STRIP(arg data.25) data.25='' curdir=PRAGMA('D') OPTIONS PROMPT 'Filenames and/or numbers: ' IF arg='' THEN PARSE PULL arg /* no filename given */ IF arg='' THEN RETURN 0 allargs=TRANSLATE(arg,' ',':/,;|') tempargs=SPACE(allargs,1) numchk=1 DO ui=1 TO WORDS(tempargs) WHILE STRIP(allargs)~='' arg=WORD(tempargs,ui) IF ~DATATYPE(arg,'W') THEN numchk=0 wloc=WORDINDEX(allargs,FIND(allargs,arg)) wi=0 temp=findfiles(arg) IF wi=999999 THEN RETURN 0 IF temp~=arg THEN DO allargs=DELWORD(allargs,FIND(allargs,arg),1) IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1) END END IF numchk=0 THEN IF countcheck(bbspath'Numbers/LastFile' 0)>500 THEN DO SAY LEFT('',20)||CR SAY bak2' BBBBS Tip:'def' Next time try using fileNUMBERS instead of fileNAMES.'CR SAY ' The BBS is MUCH faster at locating files by number.'CR END dload2: curdir=PRAGMA('D') allargs=STRIP(allargs data.25) data.25='' IF allargs='' THEN RETURN 0 sleepy='T' DO WHILE sleepy='T' arg='' SAY LEFT('',20)||CR temp=WORD(allargs,1) IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2) test='' IF LENGTH(temp)>40 THEN DO test=temp temp='' END SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR IF test~='' THEN SAY ' 'pen3 test||def||CR DO di=2 TO WORDS(allargs) temp=WORD(allargs,di) IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2) SAY ' 'pen3 temp||def||CR END pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload' pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)' sleepy=getinput(1 1 pline '> ') IF sleepy='Q' THEN RETURN 0 IF sleepy='A' THEN sleepy='LOGOFF' IF sleepy='T' THEN CALL chpro() END DO WHILE allargs~='' errorflag=0 extdir='' arg=WORD(allargs,1) allargs=STRIP(DELWORD(allargs,1,1)) IF DATATYPE(arg,'W') THEN DO CALL setdir(libpath||WORD(files.arg,1)) arg=WORD(files.arg,2) END notename=bbspath'FileNotes/'plaindir'/'arg finfo='' IF ~EXISTS(arg) THEN DO finfo=STATEF(notename) IF WORDS(finfo)>7 THEN DO temp=plaindir x=lastslash(WORD(finfo,8)) arg=WORD(x,1) CALL setdir(WORD(x,2)) plaindir=temp END END x=lastslash(arg) IF WORDS(x)>1 THEN DO arg=WORD(x,1) extdir=WORD(x,2) CALL setdir(extdir) END DO dloadloop=1 IF statuscheck(arg) THEN DO errorflag=1 LEAVE dloadloop END CALL postuser(5) CALL sound('DOWNLOAD') SAY 'Starting' protocol 'transfer. Press' pen3'Esc'def 'to abort.'CR CALL checktime() UpLoad arg IF RC>0 | stats(15) THEN DO errorflag=1 LEAVE dloadloop END CALL bytes2user(15 WORD(STATEF(arg),2)) IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN DO dloadloop2=1 TO 1 DO di=sysoplevel+2 TO 100 IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2 END IF readlines(notename 1) THEN DO CALL send2log('Unable to increment download count for' plaindir'/'arg) LEAVE dloadloop2 END dls=WORD(lynes.2,7) IF ~DATATYPE(dls,'W') THEN dls=0 lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1 finfo=STATEF(notename) IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8)) ELSE finfo='' CALL DELETE(notename) CALL savelines(notename) CALL DELAY(28) IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo IF WORD(data.16,1)2 THEN sdir=LEFT(sarg,slash-1) ELSE DO slash=LASTPOS(':',sarg) IF slash>0 THEN sdir=LEFT(sarg,slash) END IF slash>0 THEN sarg=SUBSTR(sarg,slash+1) RETURN sarg sdir editnote: IF arg='' THEN DO PARSE PULL arg . IF arg='' THEN RETURN 0 END comment='' IF ~EXISTS(arg) THEN DO finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg) temp='' IF WORDS(finfo)>7 THEN comment=WORD(finfo,8) ELSE DO IF level ' PARSE PULL comment comment=STRIP(comment) IF comment='' THEN RETURN 0 IF ~EXISTS(comment) THEN comment='' END ELSE IF temp='Q' THEN RETURN 0 END IF comment='' THEN DO arg=findfiles(arg) IF arg=0 THEN RETURN 0 IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2) END filedir=plaindir CALL MAKEDIR(bbspath'FileNotes/'filedir) IF ~EXISTS(bbspath'FileNotes/'filedir) THEN DO SAY pen3'*** Failed to open directory!' filedir||def||CR RETURN 0 END notename=bbspath'FileNotes/'filedir'/'arg lynes.='' filenum=countcheck(bbspath'Numbers/LastFile' 0) IF level>sysoplevel THEN firstedit=1 ELSE firstedit=5 IF EXISTS(notename) THEN DO IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment CALL bbsED(firstedit notename) RETURN 0 END IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg) ELSE filedata=STATEF(comment) IF filedata='' THEN DO IF comment='' THEN line=filedir'/'arg ELSE line=comment SAY line 'does not exist!'CR RETURN 0 END bytes=WORD(filedata,2) filenum=filenum+1 lynes.0=4 lynes.1='File: 'LEFT(filenum,5)' KeyWords:' lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes Downloads: 0' lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')' Lib: 'filedir lynes.4=LEFT('',74,'=') lynes.1=lynes.1 edkeywords(arg filedir) CALL seelines(1) edtype='' CALL writebuffer(scratch'/NoteFile') IF savelines(notename) THEN RETURN 0 IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment fncom='R' DO WHILE fncom='R' CALL seelines(1) nonstop=0 line='['pen3'E'def']dit' IF level>sysoplevel THEN line=line '['pen3'K'def']ill' line=line '['pen3'R'def']ead ['pen3'S'def']ave' IF level>sysoplevel THEN line=line '(ekrS) 'def ELSE line=line '(erS) 'def fncom=getinput(1 1 line) IF fncom='K' & level>sysoplevel THEN DO SAY 'Killing FileNote..'CR CALL DELETE(notename) RETURN 1 END ELSE IF fncom='E' THEN DO IF bbsED(firstedit notename)>0 THEN RETURN 0 fncom='R' END ELSE IF fncom~='R' THEN DO SAY 'Adjusting filelist...'CR IF filenum<1 THEN filenum=1 IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1) CALL countcheck(bbspath'Numbers/LastFile' filenum) files.0=files.0+1 newcount=alpha.0+1 alpha.0=newcount files.filenum=plaindir arg files.filenum.0=newcount libnum=finddirnum(plaindir) PARSE VAR lynes.1 . 'KeyWords:' keywords alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4))) alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5) alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12) alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32)) IF EXISTS(bbspath'Lists/Files') THEN x=OPEN(f,bbspath'Lists/Files','A') ELSE x=OPEN(f,bbspath'Lists/Files','W') IF x=0 THEN DO SAY '*** Failed to open' bbspath'Lists/Files'CR RETURN 0 END CALL WRITELN(f,filenum files.filenum) CALL CLOSE(f) IF EXISTS(bbspath'Lists/Files.ALPHA') THEN x=OPEN(f,bbspath'Lists/Files.ALPHA','A') ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W') IF x=0 THEN DO SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR RETURN 0 END CALL WRITELN(f,alpha.newcount) CALL CLOSE(f) sortalphaflag=1 savefileflag=1 CALL cleanline(1) END END RETURN 0 edkeywords: PARSE ARG kwarg templine='' DO WHILE LENGTH(templine)<3 SAY CR SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR SAY ' Note that only the first 32 characters will be used.'CR SAY LEFT('',43)'|'LEFT('',31,'=')'|'CR templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def) templine=cleanstring('0:'templine) templine=STRIP(LEFT(templine,32)) END SAY CR RETURN templine loadfiles: SAY def||CR SAY 'Loading filelist...'CR files.='' files.0=0 IF readopen(bbspath'Lists/Files') THEN DO DO i=1 line=READLN(f) IF EOF(f) THEN BREAK num=WORD(line,1) IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3) END files.0=i-1 CALL CLOSE(f) END RETURN savefilelist: IF level=99 THEN IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN savefilelist2: SIGNAL OFF BREAK_E IF ckmaint('FILES') THEN RETURN CALL savealphalist() SAY 'Saving filelist...'CR CALL SETCLIP('BBS_maint',1) xarg=bbspath'Lists/Files' CALL DELETE(xarg) filenum=countcheck(bbspath'Numbers/LastFile' 0) IF filenum<1 | writeopen(xarg)=0 THEN RETURN DO i=1 TO filenum IF files.i='' THEN ITERATE i CALL WRITELN(f,i files.i) END CALL CLOSE(f) CALL SETCLIP('BBS_maint') savefileflag=0 IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2) RETURN loadalpha: SAY def||CR SAY 'Loading the alphabetical filelist...'CR IF readopen(bbspath'Lists/Files.ALPHA') THEN DO alpha.='' alpha.0=0 DO i=1 line=READLN(f) IF EOF(f) THEN BREAK fnum=WORD(line,3) IF DATATYPE(fnum,'W') THEN DO alpha.i=line files.fnum.0=i END ELSE i=i-1 END CALL CLOSE(f) alpha.0=i-1 IF alpha.023 THEN DO line='*** unable to update' ckfile 'list.' CALL send2log(line DATE() TIME('C')) SAY line||CR RETURN 1 END END RETURN 0 savealphalist: SIGNAL OFF BREAK_E IF ckmaint('ALPHA') THEN RETURN CALL SETCLIP('BBS_maint',1) IF GETCLIP('BBS_localfiles')~='' THEN DO CALL SETCLIP('BBS_localfiles') CALL loadfiles() CALL loadalpha() END aarg=bbspath'Lists/Files.ALPHA' CALL DELETE(aarg) IF sortalphaflag=1 THEN DO SAY 'Alphabetizing' alpha.0 'files...'CR CALL QSORT(1,alpha.0,alpha) DO i=1 TO alpha.0 fnum=WORD(alpha.i,3) files.fnum.0=i END END sortalphaflag=0 IF writeopen(aarg)=0 THEN DO SAY '*** Error opening' aarg '!'CR CALL SETCLIP('BBS_maint') RETURN END SAY 'Saving alphabetical filelist...'CR DO i=1 TO alpha.0 ii=WORD(alpha.i,3) IF files.ii='' THEN alpha.i='0 0' ii '100' IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i) END CALL CLOSE(f) CALL SETCLIP('BBS_maint') ADDRESS AREXX bbsALPHA.rexx SUBSTR(extension,2) arccom RETURN viewuser: SAY CR SAY bak2' 'name' 'def||CR DO i=1 TO 18 stuff=data.i IF i=13 | i=14 THEN stuff=DATE(,data.i,'S') SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR END CALL waiting() RETURN edituser: IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN DO SAY CR SAY pen3' - Message Conference Access -'def||CR SAY '[O]ff turns all message conferences OFF.'CR SAY 'Set the last message read by you in ALL message conferences'CR temp=getinput(1 1 ' ['pen3'L'def']ast ['pen3'F'def']irst ['pen3'O'def']ff ['pen3'Q'def']uit (fLoq) > ') IF temp='Q' THEN RETURN SAY 'Resetting...'lineup||CR data.22='' DO i=1 TO level IF temp='F' THEN num=0 ELSE IF temp='O' THEN num=-1 ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0) data.22=data.22 num END CALL SetData() CALL sortconferences() CALL savedata(1) RETURN END new=0 change=0 edata.='' edname=name DO i=0 TO data.0 edata.i=data.i END num=1 DO WHILE num~='' | edname~=name IF num='' | LEFT(num,1)='Q' THEN DO IF change THEN DO CALL SetData() CALL saveData(1) change=0 END IF new THEN DO data.='' DO i=0 TO edata.0 data.i=edata.i END name=edname new=0 END CALL SetData() END maxnum=10 IF edata.20>sysoplevel THEN maxnum=20 IF edata.20=99 THEN maxnum=27 SAY bak2' 'name' 'def||CR maxlines=21 IF maxnum=10 THEN maxlines=20 DO i=1 TO maxlines IF i=5 & name~=edname & edata.20<99 THEN ITERATE SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR END IF edata.20>sysoplevel THEN DO line=LEFT(' ',50) IF name=edname THEN line=line'NEW = Change User.' line=pen3||line||def||lineup SAY line||CR END num=getinput(1 0 'Select Line Number To Edit: ') IF num='NEW' & edata.20>sysoplevel & edname=name THEN /* select a new user */ DO new=1 IF change THEN DO CALL SetData() CALL saveData(1) END change=0 nufile=bbspath'Lists/NEW_USERS' IF EXISTS(nufile) THEN IF ~readlines(nufile 1) THEN CALL seelines(0) savename=name name=getinput(1 0 'New User Name: 'def) name=cleanstring(1':'name) IF loadData()=0 THEN name=savename IF data.20>=edata.20 THEN DO SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.' name=savename CALL loadData() END END ELSE IF DATATYPE(num,'W') & num>0 THEN DO IF num>maxnum THEN DO SAY CR SAY pen3'You are not authorized to change that information!'def||CR SAY CR END ELSE DO dummy=1 TO 1 IF num=8 THEN DO SAY CR SAY 'Use spaces to separate options.'CR SAY 'If the option word is in line 8, it is ON.'CR SAY 'Valid Options:'CR SAY ' COLOR turns ANSI color codes ON.'CR SAY ' MENU combines all main commands into 1 menu.'CR SAY ' MENUS splits main commands into 3 menus.'CR SAY ' PHONE makes your phone number public.'CR SAY ' QUICK activates offline options. See bbsQUICK.DOC'CR SAY ' STREET makes your street address public.'CR SAY ' TERSE skips some of the logon procedures.'CR SAY CR END line=RIGHT(num,2)||pen3 text.num||def': ' SAY line||data.num||CR temp=getinput(0 0 line) IF temp='' THEN DO IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy END IF num=5 | num=8 THEN temp=UPPER(temp) IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN temp=data.20 IF edata.20>sysoplevel & name~=edname THEN line2=name' ' ELSE line2='' IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy line=text.num':' data.num pen6'CHANGED TO'def temp CALL send2log(line2||line) data.num=temp SAY line||CR SAY CR change=1 END END END IF change THEN DO CALL SetData() CALL saveData(1) END RETURN getnumber: PARSE ARG tprompt tnum=getinput(1 0 ' 'tprompt' > ') mask=COMPRESS(XRANGE(),'0123456789') tnum=COMPRESS(tnum,mask) IF ~DATATYPE(tnum,'W') THEN tnum=0 tnum=tnum%1 IF tnum>0 & tnum<10 THEN tnum='0'tnum RETURN tnum getbirth: data.12=WORD(data.12,1)' 'WORD(data.12,2)' Birthday:' SAY pen3'Please enter your birthday.'def||CR month=getnumber('month: (1-12)') day=getnumber(' day: (1-31)') year=getnumber(' year: ') IF year<100 THEN year=year+1900 born=year||month||day IF born<18750101 | born>(DATE('S')-50000) THEN /* must be older than 4 */ DO born='' IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN CALL getbirth() END data.12=WORD(data.12,1)' 'WORD(data.12,2)' 'WORD(data.12,3)' 'WORD(born,1) RETURN getname: CALL showuserlist() SAY CR pline='Please enter your full Email name : ' name=getinput(1 0 pline) IF name='' THEN DO name=getinput(1 0 pline) IF name='' THEN DO SAY 'No name, no entry. Bye!'CR SIGNAL DONE END END name=cleanstring(1':'name) IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN DO SAY 'Sorry! That name is taken. Please try again.'CR RETURN 1 END RETURN 0 /** see if name is in data */ checkUser: tries=0 IF name='NEW' THEN DO name='' DO WHILE getname() END CALL postuser(7) END IF FIND(userlist,name)=0 THEN DO IF EXISTS(bbspath'BBS_TEXT/NEW') THEN DO nonstop=0 CALL readlines(bbspath'BBS_TEXT/NEW' 1) CALL seelines(0) CALL waiting() END SAY CR IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN DO SAY 'Thanks anyway, bye!'CR line=name 'did not want to register.' SIGNAL OUT2 END defile=bbspath'BBS_TEXT/DEF.NEW_USER' CALL loadcourtesy() wordnum=FIND(courtesy,name) IF wordnum>0 THEN DO SAY name', is on the Courtesy List. You will be granted immediate access.'CR courtesy=STRIP(DELWORD(courtesy,wordnum,1)) IF writeopen(bbspath'Lists/Courtesy') THEN DO DO i=1 TO WORDS(courtesy) CALL WRITELN(f,WORD(courtesy,i)) END CALL CLOSE(f) END defile=bbspath'BBS_TEXT/DEF.COURTESY' END ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR IF readlines(defile 1) THEN SIGNAL DONE CALL sound('NEW_USER') data.='' data.0=24 DO i=6 TO 22 data.i=lynes.i END data.12=DATE('S')' 'TIME('C') data.13=data.12 lastondate=DATE('I')-1 lastontime=TIME('C') x=FIND(UPPER(data.8),'COLOR') test=getinput(1 1 'Does your terminal handle' pen3'ANSI color'def 'codes? (nY) > ') IF test='N' THEN DO IF x>0 THEN data.8=DELWORD(data.8,x,1) CALL colors(0) END ELSE IF x=0 THEN DO data.8=data.8 'COLOR' CALL colors(1) END SAY 'Please enter the password you would like to use here.'CR data.5=getinput(1 0 'Password: ') IF data.5='' THEN DO line=''name 'refused to enter a password.' SIGNAL DONE END data.1='' DO WHILE data.1='' data.1=getinput(0 0 'Full Name: ') IF data.1='' THEN SAY 'You MUST leave your real name!'CR END data.2=getinput(0 0 'Street: ') data.3=getinput(0 0 'City, State Zip: ') data.4='' DO WHILE data.4='' data.4=getinput(0 0 'Phone: ') IF data.4='' THEN SAY sysop 'MUST be able to reach you by phone to validate you!'CR END CALL getbirth() IF bbsprefs.8 THEN DO newufile=bbspath'Lists/NEW_USERS' IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A') ELSE DO ok=OPEN(f,newufile,'W') IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***') END IF ok~=0 THEN DO temp=RIGHT(TIME('C'),7) COMPRESS(DATE()) temp=temp LEFT(name,24)'=' data.1' 'data.4 CALL WRITELN(f,temp) END CALL CLOSE(f) END data.9=getinput(0 0 'Computer: ') data.10=getinput(0 0 'Interests: ') test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def) IF test='Y' THEN data.8=data.8 'STREET' test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def) IF test='Y' THEN data.8=data.8 'PHONE' IF bbsprefs.7>0 THEN DO data.20=bbsprefs.7 data.11='60 minutes' bbsprefs.16-1 'more times today' END SAY CR CALL SetData() IF data.20=0 THEN SAY 'Thank you, the sysop will give you higher access soon.'CR ELSE IF bbsprefs.25=1 THEN DO data.22='' data.23='' SAY CR SAY 'Setting message counters to last 10 messages in each conference...'CR DO i=1 TO level num=countcheck(bbspath'Numbers/LastMessage'i 0)-10 IF num<0 | msg.i.0<10 THEN num=0 lastread.i=num data.22=data.22 num data.23=data.23 0 END SAY 'Setting file counter to last file uploaded...'CR lastbrowse=countcheck(bbspath'Numbers/LastFile' 0) newfilesdate='19900101 00:00:00' END SAY CR SAY 'Please feel free to leave additional info by using [C]omment.'CR SAY CR CALL saveData(1) SAY 'Adding' name 'to the user list...'CR newpassword=data.5 sortuserflag=1 temp=countcheck(bbspath'Numbers/Users' 0)+1 CALL countcheck(bbspath'Numbers/Users' temp) CALL DELETE(bbspath'Lists/USERS') END ELSE DO IF loadData()=0 THEN SIGNAL DONE PARSE VAR data.11 amins . atimes . lastondate=DATE('I',WORD(data.13,1),'S') lastontime=WORD(data.13,2) IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16 IF level=99 THEN amins=120 data.13=DATE('S')' 'TIME() data.11=amins 'minutes' atimes-1 'more times today' IF atimes<1 & DATE('I')=lastondate THEN DO SAY CR SAY CR line= 'Too many calls today. Call tomorrow.' SAY line||CR SAY CR SAY CR CALL send2log(line) city=docity(data.3) SIGNAL LOGOUT END data.13=DATE('S')' 'TIME('C') SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR SAY CR passprompt='Enter Password: ' DO tries=1 TO 3 Send passprompt Remote OFF OPTIONS PROMPT '' newpassword=getinput(1 0 '') Remote ON IF(password=newpassword) THEN DO SAY ''CR LEAVE tries; /* correct password */ END IF tries=3 THEN DO /* 3 tries, hang up */ SAY ''CR SAY 'Access terminated.'CR line='*** Bad password ***' newpassword '***' SAY line||CR city=line CALL postuser(6) SIGNAL OUT2 END SAY ''lineup' 'CR passprompt='Incorrect. Password: ' /* ask again */ END END SAY CR IF bbsprefs.23=1 THEN ADDRESS AREXX bbsSpeak.rexx 'LOGON' name bbspath saypath RETURN saveData: ARG messflag . IF data.5='' THEN RETURN temp=GETCLIP(name'_UPDATE') IF temp~='' THEN DO CALL SETCLIP(name'_UPDATE') PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg IF upfiles>0 THEN DO files=WORD(data.14,1) bytes=WORD(data.14,3) IF DATATYPE(files,'W') THEN upfiles=upfiles+files IF DATATYPE(bytes,'W') THEN bytes=upbytes data.14=upfiles 'files' bytes 'bytes.' DATE() END IF upmail>0 THEN DO mail=WORD(data.17,2) IF DATATYPE(mail,'W') THEN upmail=upmail+mail data.17=WORD(data.17,1) upmail WORD(data.17,3) END IF upmsg~='' THEN DO temp=data.23 DO i=1 TO level msg=WORD(temp,i) IF ~DATATYPE(msg,'W') THEN msg=0 IF FIND(upmsg,i) THEN msg=msg+1 data.23=data.23 msg END END END SAY 'Updating... 'lineup||CR SIGNAL OFF BREAK_E Status Trans data.6=STRIP(RESULT) IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate ELSE IF lastbrowse>0 THEN DO IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1) ELSE data.16=DATE('S') TIME() data.16=lastbrowse data.16 END IF messflag THEN DO userexclude.=0 DO si=1 TO WORDS(data.22) IF WORD(data.22,si)=-1 THEN userexclude.si=1 END data.22='' data.23='' DO si=1 TO level IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0 IF userexclude.si THEN data.22=data.22 '-1' ELSE data.22=data.22 lastread.si IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0 data.23=data.23 totwrit.si END END IF writeopen(bbspath'USERS/'name)=0 THEN RETURN IF data.0<27 THEN data.0=27 DO i=1 TO data.0 CALL WRITELN(f,data.i) END CALL CLOSE(f) SAY 'User' name 'has been updated.'CR RETURN loadData: IF name='' THEN RETURN 0 IF ~readopen(bbspath'USERS/'name) THEN RETURN 0 data.='' DO i=1 line=READLN(f) IF EOF(f) THEN BREAK data.i=line END data.0=i-1 CALL CLOSE(f) winnings=WORD(data.18,1) IF ~DATATYPE(winnings,'N') THEN winnings=0 setData: IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00' lastbrowse=WORD(data.16,1) IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0 level=data.20 DO i=1 TO level lastread.i=WORD(data.22,i) IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0 totwrit.i=WORD(data.23,i) IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0 END password=data.5 IF data.6='' THEN DO Status Trans data.6=RESULT END ELSE DO IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G' IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K' IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z' Set UPPER(LEFT(data.6,1)) END IF ~DATATYPE(data.7,'W') THEN data.7=20 IF data.7<5 THEN data.7=5 linesperpage=data.7 IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1 ELSE terseflag=0 IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1 ELSE colorflag=0 CALL colors(colorflag) menu='ALL' IF FIND(UPPER(data.8),'MENUS')>0 THEN DO menuflag=1 menu='MAIN' END ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1 ELSE menuflag=0 IF level=0 THEN menu='NEW' data.21=UPPER(data.21) maxtime=WORD(data.11,1)*60 loadFriends: CALL MAKEDIR(bbspath'Friends') alias.='' alias.0=0 realname.='' CALL CLOSE(f) IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1 DO i=1 line=READLN(f) IF EOF(f) THEN LEAVE i alias.i=WORD(line,1) realname.i=WORD(line,2) END alias.0=i-1 CALL CLOSE(f) RETURN 1 switchmenuflag: IF menuflag=1 THEN DO menuflag=0 noff='OFF' END ELSE DO menuflag=1 noff='ON' END SAY 'Menus turned' pen3||noff||def'.'CR SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR RETURN switchcolors: IF colorflag=1 THEN DO colorflag=0 noff='OFF' END ELSE DO colorflag=1 noff='ON' END CALL colors(colorflag) SAY 'Color turned' pen3||noff||def'.'CR SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR RETURN /* ANSI pen color codes */ colors: ARG onoff IF onoff THEN DO lineup='1B'x'M' def=''; /* default */ pen0=''; pen1=''; pen2=''; pen3='' pen4=''; pen5=''; pen6=''; pen7='' bak0=''; bak1=''; bak2=''; bak3='' bak4=''; bak5=''; bak6=''; bak7='' END ELSE DO pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7='' bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7='' def=''; lineup='' END RETURN chpro: arg=UPPER(LEFT(arg,1)) IF(arg='') THEN DO SAY CR SAY '['pen3'W'def']- WXModem'CR SAY '['pen3'X'def']- XModem-CRC'CR SAY '['pen3'K'def']- XModem-1K'CR SAY '['pen3'Y'def']- YModem'CR SAY '['pen3'G'def']- YModem-G'CR SAY '['pen3'Z'def']- ZModem'CR SAY CR arg=getinput(1 0 STRIP(protocol) '> ') END IF LEFT(UPPER(arg),1)='A' THEN arg='Z' Set arg Status Transfer protocol=STRIP(RESULT) SAY protocol||CR RETURN sortinfofiles: infolist=SHOWDIR(bbspath'Information') IF infolist='' THEN DO SAY CR SAY pen3'No files are currently in the Information drawer.'def||CR SAY CR RETURN 1 END IF ~DATATYPE(sortinfo.0,'W') THEN DO info.='' sortinfo.='' info.0=WORDS(infolist) DO i=1 TO info.0 info.i=WORD(infolist,i) END SAY 'Sorting..'CR CALL QSORT(1,info.0,info) sortinfo.0=info.0%3 IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1 DO i=1 TO sortinfo.0 sortinfo.i='' DO j=0 TO 2 k=i+j*sortinfo.0 IF k<=info.0 THEN DO sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19) infocount=WORD(STATEF(bbspath'Information/'info.k),8) sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19) END END END SAY lineup' 'lineup||CR END RETURN 0 information: IF sortinfofiles() THEN RETURN CALL sound('INFO') SAY pen3'These text files are available for reading online...'def||CR num=1 readcount=-1 DO infoloop=1 IF num=0 THEN DO IF readcount~=-1 THEN DO sortinfo.0='' IF sortinfofiles() THEN RETURN END SAY CENTER('- Number of accesses per file -',75)||CR END SAY pen3||LEFT('-',75,'-')||def||CR DO i=1 TO sortinfo.0 IF num=0 THEN SAY sortinfo.i.0||CR ELSE SAY sortinfo.i||CR END CALL checktime() IF num=0 THEN DO CALL waiting() num=1 ITERATE infoloop END num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def) IF num=0 THEN ITERATE infoloop IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN readcount=STATEF(bbspath'Information/'info.num) readbytes=WORD(readcount,2) SAY ' 'info.num 'is' readbytes 'bytes.'CR IF getinput(1 1 '['pen3'R'def']ead or ['pen3'D'def']ownload? (dR) > ')='D' THEN DO allargs=bbspath'Information/'info.num CALL dload2() END ELSE DO SAY 'Loading File...'CR readcount=WORD(readcount,8) IF ~DATATYPE(readcount,'W') THEN readcount=0 ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1 CALL DELAY(28) CALL readlines(bbspath'Information/'info.num 1) CALL cleanline(0) SAY lineup' 'lynes.0 'lines.'CR SAY CR CALL seelines(0) END CALL showtime() IF waitchar~='Q' THEN CALL waiting() nonstop=0 END RETURN newfiles: SAY CR test='' test=getinput(1 1 'Show one library only? (Ny) > ') IF test='Y' THEN IF chdir()>0 THEN RETURN SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR lastbrowz=WORD(data.16,1) lastfileup=countcheck(bbspath'Numbers/LastFile' 0) newfiles2: IF lastbrowz>=lastfileup THEN DO lastbrowz=0 SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR END ELSE newfilesflag=1 j=0 IF test='Y' THEN DO filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir)) CALL busywait(4 1) END DO ni=lastfileup TO lastbrowz+1 BY -1 IF files.ni~='' THEN DO IF test='Y' THEN DO IF ni>1 THEN CALL busywait(60 ni lastfileup-lastbrowz) IF j>=filecount THEN LEAVE ni IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN ITERATE ni END jj=files.ni.0 IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN ITERATE ni /* unauthorized */ IF test='Y' THEN CALL busywait(4 0) j=j+1 IF j=1 THEN CALL fileheader() SAY alpha.jj||CR IF (j+2)//(linesperpage-1)=0 THEN IF waiting2() THEN LEAVE ni IF test='Y' THEN CALL busywait(4 1) END END IF test='Y' THEN CALL busywait(4 0) IF j//linesperpage~=0 THEN CALL waiting() IF j=0 & newfilesflag=1 THEN DO lastbrowz=999999 newfilesflag=0 CALL newfiles2() END IF test~='Y' THEN DO CALL newinfo() IF lynes.0>0 THEN CALL waiting() END nonstop=0 RETURN newinfo: lynes.='' lynes.0=0 dm=DATE(,WORD(data.16,2),'S') PARSE VAR dm da' 'mo' 'yr . yr=RIGHT(yr,2) sincedate=da'-'mo'-'yr startline=1 arg=bbspath'Information' IF WORD(STATEF(arg),5)>lastondate THEN DO ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate IF WORD(STATEF('ram:dirlist'),2)>3 THEN DO lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def CALL readlines('ram:dirlist' startline+1) END END arg=bbspath'Profiles' IF level>0 & WORD(STATEF(arg),5)>lastondate THEN DO ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate IF WORD(STATEF('ram:dirlist'),2)>3 THEN DO startline=lynes.0+2 lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def CALL readlines('ram:dirlist' startline+1) END END arg=bbspath'rexxDoors/Data/Polls' IF level>0 & WORD(STATEF(arg),5)>lastondate THEN DO startline=lynes.0+2 lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def lynes.0=startline END IF logonflag=1 THEN nonstop=1 IF lynes.0>0 THEN CALL seelines(1) nonstop=0 RETURN areaselect: SAY pen3||LEFT('-',75,'-')||def||CR DO i=1 TO msgs.0 SAY msgs.i||CR IF i//linesperpage=0 THEN CALL waiting() END temp=getinput(1 0 pen3'Select Message Conference: 'def) IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1 msgdir=temp RETURN 0 chdir: string='' SAY pen3||LEFT('-',75,'-')||def||CR DO i=1 TO libs.0 SAY libs.i||CR END dirnum=getinput(1 0 pen3'Select Library Number: 'def) IF ~DATATYPE(dirnum,'W') THEN DO waitchar=dirnum RETURN 2 END chdir2: IF dirnum<1 | dirnum>99 THEN DO waitchar=dirnum RETURN 1 END IF dirs.dirnum='' THEN DO SAY pen3'That library number is currently un-assigned.'def||CR RETURN 1 END IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN DO SAY pen3'You do not have authorization for that library!'def||CR RETURN 1 END CALL MAKEDIR(libpath||dirs.dirnum) CALL setdir(libpath||dirs.dirnum) t=libpath||plaindir'.txt' IF ~EXISTS(t) THEN RETURN 0 nonstop=1 SAY CR CALL readlines(t 1) CALL seelines(1) SAY CR nonstop=0 RETURN 0 since: dm=DATE(,WORD(data.16,2),'S') SAY CR SAY 'New files or files moved since' dm||CR CALL listsince() CALL readlines('RAM:dirlist' 1) CALL seelines(1) nonstop=0 CALL waiting() RETURN listsince: dm=DATE(,WORD(data.16,2),'S') PARSE VAR dm da' 'mo' 'yr . yr=RIGHT(yr,2) sincedate=da'-'mo'-'yr ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES SINCE' sincedate RETURN list: onetime=0 IF DATATYPE(arg,'W') THEN onetime=1 ELSE arg='' DO listloop=1 IF DATATYPE(arg,'W') THEN DO dirnum=arg arg='' IF chdir2()>0 THEN RETURN CALL listsimple() IF waitchar='Q' | onetime THEN LEAVE listloop END ELSE IF arg='' THEN DO IF chdir()>0 THEN RETURN test='Y' CALL showalpha2() arg='' IF waitchar='Q' THEN waitchar='' IF waitchar~='' THEN RETURN ITERATE listloop END ELSE RETURN END RETURN listsimple: ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES' IF readlines('RAM:dirlist' 1) THEN RETURN IF lynes.0>3 THEN DO SAY pen3'Sorting...'def||lineup||CR linesave=lynes.1 /* these 4 lines put in to leave dir title at top */ lynes.1='0' CALL QSORT(1,lynes.0-1,lynes) CALL DELAY(14) lynes.1=linesave END CALL seelines(1) nonstop=0 CALL waiting() RETURN browse: curdironly=0 brdir=PRAGMA('D') brfilenum=1 nonstop=0 IF files.0<1 THEN RETURN lastfilenum=countcheck(bbspath'Numbers/LastFile' 0) IF lastfilenum<1 THEN RETURN onearg=0 IF arg='' THEN DO lin='Browsing' test=getinput(1 1 'Browse one library only? (Ny) > ') IF test='Y' THEN DO IF chdir()>0 THEN RETURN curdironly=1 lin=lin 'the' pen3||plaindir||def 'library' t=libpath||plaindir'.txt' IF level>sysoplevel THEN IF getinput(1 1 'Edit the'pen3 Plaindir def'library info file? (Ny) > ')='Y' THEN DO IF ~EXISTS(t) THEN DO IF writeopen(t)~=0 THEN DO CALL WRITELN(f,TRIM(CENTER('***' plaindir '***',77))) CALL WRITELN(f,LEFT('',75,'=')) CALL CLOSE(f) CALL DELAY(28) END END CALL bbsED(1 t) RETURN END END ELSE lin=lin 'all file libraries' lin=lin 'backwards from latest file.' SAY lin||CR SAY CR END ELSE onearg=1 i=0 IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN DO lastfileloop=1 IF lastfilenum<1 THEN RETURN arg=WORD(files.lastfilenum,2) brfilenum=lastfilenum IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop lastfilenum=lastfilenum-1 END ELSE IF DATATYPE(arg,'W') & files.arg~='' THEN DO brfilenum=arg arg=WORD(files.arg,2) IF arg='' THEN DO SAY 'File number' brfilenum 'does not exist in the current libraries!'CR RETURN END END ELSE DO IF onearg THEN CALL busywait(4 1) DO ni=lastfilenum TO 1 BY -1 IF onearg THEN CALL busywait(60 ni lastfilenum) IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni brfilenum=ni CALL busywait(4 0) LEAVE ni END IF ni<1 THEN DO SAY 'Unable to find a file description for' pen3||arg||def'.'CR RETURN END END IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1)) savearg=arg IF brfilenum>lastfilenum THEN brfilenum=lastfilenum newfilesdate=DATE('S') TIME() DO browseloop=1 IF curdironly THEN CALL busywait(4 1) DO ni=brfilenum TO 0 BY -1 IF ni=0 THEN LEAVE browseloop IF files.ni='' THEN ITERATE ni IF onearg THEN DO CALL busywait(60 ni lastfilenum) IF UPPER(arg)=UPPER(WORD(files.ni,2)) THEN LEAVE ni ELSE ITERATE ni END testdir=UPPER(WORD(files.ni,1)) IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN DO IF ni>lastbrowse THEN lastbrowse=ni IF ni>0 THEN CALL busywait(60 ni lastfilenum) ITERATE ni END IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN DO IF ni>lastbrowse THEN lastbrowse=ni ITERATE ni END LEAVE ni END IF curdironly | onearg THEN CALL busywait(4 0) onearg=0 IF ni=0 THEN brfilenum=lastbrowse ELSE brfilenum=ni argname=WORD(files.brfilenum,2) IF argname='' THEN RETURN CALL setdir(libpath||WORD(files.brfilenum,1)) arg=bbspath'FileNotes/'plaindir'/'argname CALL readlines(arg 1) IF nonstop=1 THEN brostop=1 ELSE brostop=0 CALL seelines(1) IF brfilenum>lastbrowse THEN lastbrowse=brfilenum CALL checktime() IF brostop THEN DO SAY CR nonstop=1 brfilenum=brfilenum-1 END ELSE DO line='' endtest=UPPER(RIGHT(argname,4)) IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN line='['pen3'C'def']ontents ['pen3'D'def']ownload' ELSE line='['pen3'D'def']ownload' IF level>sysoplevel | name=WORD(lynes.3,2) THEN line=line '['pen3'E'def']dit' IF level>sysoplevel | name=WORD(lynes.3,2) THEN line=line '['pen3'K'def']ill' IF level>sysoplevel THEN line=line '['pen3'L'def']ib' line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop' IF endtest='.TXT' THEN line=line '['pen3'R'def']ead' line=line '['pen3'Q'def']uit ['pen3'?'def'] > ' brcom=getinput(1 0 line) IF DATATYPE(brcom,'W') THEN DO brfilenum=brcom+1 IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1 IF brfilenum<1 THEN brfilenum=1 SAY CR END ELSE brcom=LEFT(brcom,1) CALL cleanline(0) IF brcom='Q' THEN LEAVE browseloop IF brcom='M' THEN DO wordnum=FIND(data.25,brfilenum) IF wordnum=0 THEN DO data.25=STRIP(data.25 brfilenum) SAY lineup||argname 'marked for next download.'CR SAY CR END ELSE DO data.25=STRIP(DELWORD(data.25,wordnum,1)) SAY argname 'removed from download list.'CR END END IF brcom='H' | brcom='?' THEN DO SAY pen3' - HELP with the Browse Files commands -'def||CR SAY ' RETURN reads the next file description in line.'CR SAY ' 34 will display the description of file number 34, if it exists.'CR SAY ' C displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR SAY ' D displays the download menu.'CR IF level>sysoplevel | name=WORD(lynes.3,2) THEN DO SAY ' E puts this file description into the online Editor.'CR SAY ' K deletes a file you uploaded. you cannot Kill others!'CR END IF level>sysoplevel THEN SAY ' L move file and description to new Library and/or rename.'CR SAY ' M mark/unmark the current file for the next download'CR SAY ' N displays all descriptions without pausing. CTRL-E to Exit!'CR SAY ' R displays file as text. - ONLY FILES THAT END IN .TXT -'CR SAY ' Q returns to the main menu(s). (Quit)'CR SAY CR CALL waiting() IF waitchar='Q' THEN LEAVE browseloop END ELSE IF brcom='L' & level>sysoplevel THEN DO curdir=PRAGMA('D') IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN DO newarg=getinput(0 0 'Rename' argname 'to ') IF newarg~='' THEN DO IF is_here(newarg) THEN ITERATE browseloop IF wi=999999 THEN ITERATE browseloop IF EXISTS(libpath||filedir'/'newarg) THEN DO SAY CR SAY '***' newarg 'already exists!'CR SAY CR ITERATE browseloop END junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ') IF junk='Y' THEN DO lynes.2=OVERLAY(newarg,lynes.2,7,25) comment=WORD(STATEF(arg),8) CALL DELETE(arg) arg=bbspath'FileNotes/'plaindir'/'newarg CALL savelines(arg) IF comment='' THEN DO mpath=libpath||plaindir IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN SAY 'Rename failed on main file!'CR END ELSE DO t=LASTPOS('/',comment) IF t=0 THEN t=LASTPOS(':',comment) mpath=LEFT(comment,t-1) IF RENAME(comment,mpath'/'newarg)=1 THEN ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg ELSE SAY 'Rename failed on external file!'CR END files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg anum=files.brfilenum.0 alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2) CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir) argname=newarg sortalphaflag=1 savefileflag=1 END END END mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ') IF mvdir~='' THEN DO IF DATATYPE(mvdir,'W') THEN DO dirnum=mvdir IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN DO IF chdir2()=0 THEN DO CALL readlines(arg 1) CALL movefile(brfilenum dirs.dirnum) END END END ELSE DO mvdir=STRIP(mvdir) IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN DO DO mj=1 TO level+1 IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj END IF mj<=level THEN CALL movefile(brfilenum mvdir) END END END IF savefileflag>0 THEN CALL savefilelist() CALL setdir(curdir) END ELSE IF brcom='N' THEN DO brfilenum=brfilenum-1 nonstop=1 SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR SAY CR CALL DELAY(100) brcom='' END ELSE IF brcom='C' THEN DO temp=STRIP(WORD(STATEF(arg),8)) IF temp='' THEN temp=libpath||plaindir'/'argname CALL Contents.rexx(temp) IF EXISTS('RAM:CONTENTS') THEN DO CALL cleanline(1) CALL readlines('RAM:CONTENTS' 1) CALL seelines(0) IF waitchar~='Q' THEN CALL waiting() nonstop=0 END ELSE SAY pen3'Not an archived file.'def||CR END ELSE IF brcom='D' THEN DO arg2=arg arg=brfilenum CALL dload() arg=arg2 END ELSE IF brcom='E' THEN DO IF level>sysoplevel | name=WORD(lynes.3,2) THEN DO firstedit=5 IF level>sysoplevel THEN firstedit=1 CALL bbsED(firstedit arg) END END ELSE IF brcom='K' THEN DO IF level>sysoplevel | name=WORD(lynes.3,2) THEN DO IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN DO tempnum=WORD(lynes.1,2) IF tempnum=lastfilenum THEN DO CALL DELETE(bbspath'Numbers/LastFile') CALL DELAY(28) lastfilenum=lastfilenum-1 CALL countcheck(bbspath'Numbers/LastFile' lastfilenum) END files.tempnum='' tempnum2=files.tempnum.0 alpha.tempnum2='0 0' tempnum '100' IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist() ELSE savefileflag=1 finfo=STATEF(arg) IF WORDS(finfo)>7 THEN argname=WORD(finfo,8) CALL DELETE(argname) CALL DELETE(arg) CALL send2log('Killed:' argname) SAY argname pen3'has been deleted.'def||CR END END END ELSE IF brcom='R' & endtest='.TXT' THEN DO vcount=WORD(lynes.2,7)+1 lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount edtype='' CALL savelines(arg) CALL showtext(argname) END ELSE brfilenum=brfilenum-1 END END CALL setdir(brdir) waitchar='' IF nonstop THEN CALL waiting() nonstop=0 CALL savedata(0) RETURN movefile: PARSE ARG fnum movdir . fromdir=STRIP(WORD(files.fnum,1)) farg=STRIP(WORD(files.fnum,2)) CALL MAKEDIR(libpath||movdir) ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg) files.fnum=movdir farg lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1) lynes.3=STRIP(lynes.3) movdir CALL MAKEDIR(bbspath'FileNotes/'movdir) CALL savelines(bbspath'FileNotes/'movdir'/'farg) ndx=files.fnum.0 dnum=finddirnum(movdir) alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15) IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN DO temp=bbspath'FileNotes/'fromdir'/'farg comment=WORD(STATEF(temp),8) CALL DELETE(temp) IF comment~='' THEN ADDRESS COMMAND 'C:FileNote' bbspath'FileNotes/'movdir'/'farg comment END savefileflag=1 line='Moved:' fromdir'/'farg 'to' movdir CALL send2log(line) SAY line||CR RETURN textsearch: PARSE ARG sfile' 'sarg IF sarg='' THEN RETURN 0 x=OPEN(f,sfile,'R') IF x=0 THEN RETURN 0 sarg=UPPER(sarg) stemp=UPPER(READCH(f,65000)) CALL CLOSE(f) retflag=0 IF POS(sarg,stemp)>0 THEN retflag=1 DROP stemp RETURN retflag bbsSEARCH: smenu=menu test=UPPER(LEFT(arg,1)) IF test='F' THEN smenu='FILE' IF test='M' THEN smenu='MSG' IF test='U' THEN smenu='MAIN' IF smenu='ALL' THEN DO junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ') IF junk='F' THEN smenu='FILE' ELSE IF junk='M' THEN smenu='MSG' ELSE IF junk='U' THEN smenu='MAIN' ELSE RETURN END IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2))) ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def) IF LENGTH(STRIP(searcharg))=0 THEN RETURN searcharg=COMPRESS(searcharg,'*') CALL send2log('SEARCH:' smenu 'for' searcharg) IF smenu='NEW' | smenu='MAIN' THEN DO SAY 'Searching Userlist...'CR DO i=1 TO WORDS(userlist) IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN SAY WORD(userlist,i)||CR END END IF smenu='MSG' THEN DO IF getinput(1 1 'Search one conference only? (Ny) > ')='Y' THEN DO IF areaselect() THEN RETURN SAY 'Searching' msg.msgdir 'Message Conference for'pen3 searcharg||def'...'CR SAY CR CALL searchmsgdir() END ELSE DO SAY 'Searching All Public Message Conferences for'pen3 searcharg||def'...'CR SAY CR DO i=1 TO level msgdir=i IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE i CALL searchmsgdir() i=msgdir IF msgcom='Q' THEN i=999999 END END END IF smenu='FILE' THEN DO line=pen3'Searching' curdironly=0 IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN DO IF chdir()>0 THEN RETURN curdironly=1 line=line 'the' pen3||plaindir||def 'library' SAY CR END ELSE DO line=line 'all file libraries' SAY CR SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR END test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ') IF test='Q' THEN RETURN SAY CR SAY line 'for'def UPPER(searcharg)||CR SAY pen3' - To ABORT, press CTRL-E -'def||CR SAY CR IF test~='F' THEN DO CALL fileheader() DO i=1 TO alpha.0 CALL busywait(60 i alpha.0) ii=WORD(alpha.i,4) IF ii>level THEN ITERATE i IF curdironly=1 & ii~=dirnum THEN ITERATE i ii=WORD(alpha.i,3) IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i tempnum=POS(UPPER(searcharg),UPPER(alpha.i)) IF tempnum>0 THEN DO CALL busywait(4 0) SAY alpha.i||CR IF colorflag=1 THEN SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR CALL busywait(4 1) END END END ELSE DO cck=countcheck(bbspath'Numbers/LastFile' 0) nonstop=1 DO i=1 TO cck iii=cck+1-i IF files.iii='' THEN ITERATE i ii=files.iii.0 ii=WORD(alpha.ii,4) IF ii>level THEN ITERATE i IF curdironly=1 & ii~=dirnum THEN ITERATE i IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i farg=WORD(files.iii,1)'/'WORD(files.iii,2) SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR IF textsearch(bbspath'FileNotes/'farg searcharg) THEN DO savei=i CALL readlines(bbspath'FileNotes/'farg 1) CALL seelines(2) i=savei SAY CR SAY CR END END END CALL busywait(4 0) END searcharg='' nonstop=0 SAY CR IF i<999999 THEN SAY 'All available items have been searched.'CR SAY CR CALL waiting() RETURN searchmsgdir: msglist=SHOWDIR(msgpath||msgdir) IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR qi=WORDS(msglist) DO wi=1 TO qi CALL busywait(8 wi qi) messnum=WORD(msglist,wi)%1 IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN DO CALL busywait(4 0) savelast=lastread.msgdir CALL readmsg(0 messnum) lastread.msgdir=savelast IF msgcom='Q' THEN RETURN CALL busywait(4 1) END END CALL busywait(4 0) RETURN finddirnum: ARG fdirname . DO fdir=1 TO 99 IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir END RETURN 100 writebuffer: PARSE ARG bufname . Capture OFF CALL DELETE(bufname) SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR IF EXISTS(bufname) THEN DO CALL DELAY(56) CALL DELETE(bufname) CALL DELAY(56) END CaptWrap 74 Send pen3 Capture bufname Send def TimeOut 120 DO bufloop=1 Wait '/E,/S,RING,NO CARRIER' Status 'L' test=LEFT(UPPER(cleanstring(0':'RESULT)),2) CALL checkdcd() IF test='/E' | test='/S' THEN LEAVE bufloop END Send '\b\b'pen3 Capture OFF CALL checkdcd() TimeOut maxidle SAY def||CR startnum=lynes.0+1 CALL readlines(bufname startnum) CALL wrapbuf(startnum) QUEUE CR RETURN wrapbuf: ARG startnum . CALL cleanline(1) SAY pen3'Wordwrapping...'def||CR lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x) lynes.startnum=cleanstring(2':'lynes.startnum) DO wi=startnum WHILE wi<=lynes.0 wj=wi+1 lynes.wj=TRANSLATE(lynes.wj,' ','09'x) lynes.wj=cleanstring(2':'lynes.wj) IF LENGTH(lynes.wi)>75 THEN DO testchar='' IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1) IF testchar=' ' | testchar='.' | testchar=':' THEN DO DO wjj=lynes.0 TO wi+1 BY -1 wk=wjj+1 lynes.wk=lynes.wjj END lynes.wj='' lynes.0=lynes.0+1 END DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74 IF WORDS(lynes.wi)=1 THEN lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75) lynes.wj=WORD(lynes.wi,wl) lynes.wj lynes.wi=STRIP(DELWORD(lynes.wi,wl,1)) END END END RETURN seelines: ARG fancy . DO i=1 TO lynes.0 IF fancy=0 THEN SAY lynes.i||def||CR ELSE DO IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN SAY pen3||lynes.i||def||CR ELSE SAY lynes.i||CR IF fancy=2 & colorflag=1 & searcharg~='' THEN DO testpos=POS(UPPER(searcharg),UPPER(lynes.i)) IF testpos>0 THEN SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR END END IF i//linesperpage=0 THEN IF waiting2() THEN LEAVE i END nonstop=0 RETURN readlines: CALL CLOSE(f) PARSE ARG tempname readstart . IF ~readopen(tempname) THEN RETURN 1 IF readstart<2 THEN lynes.='' DO ri=readstart line=READLN(f) IF EOF(f) THEN BREAK lynes.ri=line END lynes.0=ri-1 CALL CLOSE(f) DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S' END lynes.0=ri RETURN 0 savelines: PARSE ARG tempname . IF EXISTS(tempname) & edtype='MAIL' THEN DO ok=OPEN(f,tempname,'A') IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^')) END ELSE ok=OPEN(f,tempname,'W') IF ok=0 THEN DO line='***' tempname 'failed to open for saving!' CALL send2log(line) SAY line||CR RETURN 1 END DO wi=1 TO lynes.0 CALL WRITELN(f,lynes.wi) END CALL CLOSE(f) RETURN 0 loaduserlist: userlist=SHOWDIR(bbspath'Users') ulynes.='' IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist() ELSE IF readopen(bbspath'Lists/USERS') THEN DO SAY 'Loading Userlist...'CR DO lui=1 line=READLN(f) IF EOF(f) THEN BREAK ulynes.lui=line END ulynes.0=lui-1 CALL CLOSE(f) END RETURN saveuserlist: SIGNAL OFF BREAK_E IF writeopen(bbspath'Lists/USERS') THEN DO DO i=1 TO ulynes.0 CALL WRITELN(f,ulynes.i) END CALL CLOSE(f) END RETURN sortuserlist: SAY 'Rebuilding Userlist...'CR sortuserflag=0 userlist=SHOWDIR(bbspath'Users') user.='' users=WORDS(userlist) user.0=users DO uli=1 TO users user.uli=WORD(userlist,uli) uscore=LASTPOS('_',user.uli) IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1) END CALL QSORT(1,users,user) DO uli=1 TO users uscore=POS('@',user.uli) IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1) END ulynes.='' ulynes.0=user.0%3 IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1 DO i=1 TO ulynes.0 ulynes.i=LEFT(user.i,25) DO j=1 TO 2 k=i+j*ulynes.0 IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25) END END CALL saveuserlist() RETURN showuserlist: IF data.5='' THEN line='Here are the EMail names of your fellow users.' ELSE line=' 'WORDS(userlist) 'users. Use these names to address messages.' SAY pen3||line||def||CR DO uli=1 TO ulynes.0 SAY ulynes.uli||CR IF uli//linesperpage=0 & ulilevel | FIND(data.21,i)>0 THEN RETURN lastread.countdir=WORD(data.22,countdir) IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0 lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0) IF lastread.countdir<0 THEN RETURN firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0) IF lastread.countdir0 THEN IF lastread.countdir>=0 THEN DO IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1 unred=lastmess-lastread.countdir IF unred>totmsgs THEN unred=totmsgs cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6) cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.' IF unred>0 | ~logonflag THEN SAY pen6||cline||def||CR END RETURN counts: SAY CR SAY 'Working...'CR SAY CR temp='' DO i=1 TO 4 temp=temp||CENTER(copyright.i,75)||'0D0A'x END CALL SETCLIP('BBS_copyright',temp||CR) CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 WORDS(userlist)) SAY CR CALL waiting2() IF waitchar='Q' THEN RETURN CALL showmarked(1) CALL logonstats() nonstop=0 CALL waiting() RETURN countmail: SAY ' Counting online email...'lineup||CR emailonline=0 DO ti=1 TO WORDS(userlist) emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti))) END SAY lineup' 'emailonline' letters online.'CR RETURN hourly: IF level=99 & nonstop~=1 THEN DO IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?' CALL cleanline(1) END CALL ShowHourly.rexx(name linesperpage colorflag nonstop) RETURN logonstats: IF level=0 THEN RETURN SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse IF tempnum>files.0 THEN tempnum=files.0 line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'CR IF tempnum>0 THEN SAY RIGHT(tempnum,6) ' new of' RIGHT(files.0,6) 'files online 'line ELSE SAY ' No new' line totmsg=0 grand=0 grand2=0 DO i=1 TO 99 IF msg.i='' THEN ITERATE i CALL msgcount(i) totmsg=totmsg+unred grand=grand+totmsgs grand2=grand2+lastmess END line=RIGHT(grand2,6) 'public messages written' IF totmsg>0 THEN SAY RIGHT(totmsg,6) ' new of' line',' grand 'messages still online.'CR ELSE SAY ' No new of' line'.'CR callsleft: test=WORD(data.11,3) IF test<1 THEN DO IF DATE('S')=WORD(data.13,1) THEN DO line=pen0||bak1' Attention! 'def 'This is your last call for' line=line DATE('W')',' DATE() END ELSE line='It''s after midnight here, you may call' bbsprefs.16 'more times today.' END ELSE DO line='You may call' test 'more time' IF test~=1 THEN line=line's' line=line 'today.' END SAY line||CR RETURN checkdcd: IF GETCLIP('BBS_interpret')='' THEN DO dcd IF RC=0 THEN DO DO dcds=1 TO 3 /* 5 second delay */ CALL DELAY(50) dcd IF RC~=0 THEN RETURN END dcd IF RC=0 THEN DO SAY CR Capture OFF Remote OFF CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name) line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^' SAY line||CR Send '\dATH1\r' CALL send2log(line) CALL sound('LOST') IF newpassword='' THEN SIGNAL DONE ELSE SIGNAL OUT END END END CALL checkexternal() RETURN sound: ARG snd IF bbsprefs.13=1 THEN RETURN ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd RETURN checkexternal: xmsg=GETCLIP('BBS_MESSAGE') Capture IF RC=0 & xmsg~='' THEN DO SAY CR SAY bak2' Message From BBBBS: 'def||CR SAY xmsg||CR SAY CR CALL SETCLIP('BBS_MESSAGE') END xstring=GETCLIP('BBS_interpret') IF xstring~='' THEN DO CALL SETCLIP('BBS_interpret') INTERPRET xstring END xcom=GETCLIP('BBS_COMMAND') IF xcom~='' THEN DO CALL SETCLIP('BBS_COMMAND') IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2 IF opt~='' THEN DO IF POS('B',xcom)>0 THEN test='/E' IF POS('L',xcom)>0 THEN CALL uplevel() IF POS('M',xcom)>0 THEN CALL validate('DEF.MEMBER') IF POS('R',xcom)>0 THEN CALL upratio() IF POS('T',xcom)>0 THEN CALL uptime() IF POS('V',xcom)>0 THEN CALL validate('DEF.CBV') END IF POS('C',xcom)>0 THEN CALL chat() END RETURN chat: chatrequest=0 chattime=TIME('E') SAY 'Entering chat mode with sysop.'CR MSG pen3'- Press backslash [\] to exit -'def SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR SAY CR OPTIONS PROMPT '' string='' DO WHILE(string~='\') PULL string CALL checkdcd() END maxtime=maxtime+(TIME('E')-chattime)%1 RETURN readopen: PARSE ARG fname ok=OPEN(f,fname,'R') IF ok~=0 THEN RETURN 1 line=fname 'failed to open for reading!' SAY line||CR CALL send2log(line) RETURN 0 writeopen: PARSE ARG fname CALL CLOSE(f) ok=OPEN(f,fname,'W') IF ok~=0 THEN RETURN 1 line=fname 'failed to open for writing!' SAY line||CR CALL send2log(line) RETURN 0 set_grand: SAY 'Setting up public message conferences...'CR grand=0 DO i=1 TO 99 IF msg.i='' THEN ITERATE i msg.i.0=WORDS(SHOWDIR(msgpath||i,'F')) msg.i.1=STATEF(msgpath||i) grand=grand+msg.i.0 END RETURN checkstats: /* clip is set and cleared by stats programs */ IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN DO IF EXISTS(bbspath'Information/STATS.ULDL') THEN DO lfinfo=STATEF(bbspath'Information/STATS.ULDL') IF WORD(lfinfo,5)4 & GETCLIP('BBS_STAT')='' & EXISTS(bbspath'Information/STATS.USER') THEN DO ufinfo=STATEF(bbspath'Information/STATS.USER') IF WORD(ufinfo,5)SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 & GETCLIP('BBS_STAT')='' THEN DO SAY 'Doing Message Conference Maintenence...'CR Send 'ATH1\r' CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop) CALL set_grand() Send 'ATZ\r' END END RETURN zerovars: lastread.=0 totwrit.=0 data.='' libs.='' smsg.='' msgs.='' sdirs.='' pasted.='' pasted.0=0 clear_marked=0 sortalphaflag=0 savefileflag=0 sortuserflag=0 linesperpage=22 chatrequest=0 lastbrowse=0 buildalpha=0 terseflag=0 warnings=0 winnings=0 menuflag=0 nonstop=0 dirnum=1 msgdir=1 level=0 newfilesflag=0 newfilesdate='' newpassword='' replymsg='' waitchar='' string='' name='' city='?' opt='' RETURN SYNTAX: FAILURE: lin.1=pen7||ERRORTEXT(RC)||def lin.2=SIGL-1 SOURCELINE(SIGL-1) lin.3=SIGL pen7||SOURCELINE(SIGL)||def lin.4=SIGL+1 SOURCELINE(SIGL+1) DO er=1 TO 4 IF level>sysoplevel THEN SAY lin.er||CR CALL send2log(lin.er) END CALL CLOSE(f) IF newpassword='' THEN SIGNAL DONE /* no user logged on, quit quietly */ SAY CR CALL checkdcd() waitchar='' IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0) SIGNAL RESTART BREAK_E: CALL CLOSE(f) SAY pen3'*** CTRL-E BREAK ***'def||CR waitchar='' string='' nonstop=0 rnonstop=0 brostop=0 i=999999 wi=999999 ui=999999 ni=-1 QUEUE CR RETURN 0 HALT: BREAK_C: SIGNAL OFF BREAK_C SIGNAL OFF BREAK_E CALL CLOSE(f) IF newpassword='' THEN DO CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name) SIGNAL DONE /* no user logged on, quit quietly */ END CALL checkdcd() SAY CR IF warnings<1 THEN /* just 1 warning */ DO warnings=warnings+1 SAY CR SAY CR SAY CR SAY 'If you didn''t press CTRL-C then... HEY! Wake up!'CR SAY ' Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR SAY CR SAY 'If you DID press CTRL-C, PLEASE use CTRL-E next time instead.'CR SAY CR Remote OFF Send '^G\w^G\w^G^G^G^G' Remote ON waitchar='' string='' nonstop=0 CALL SETCLIP('BBS_door') SIGNAL ON BREAK_C CALL waiting() SIGNAL RESTART END CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name) SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR Send '\d' CALL sound('TIMEOUT') SIGNAL OUT LOGOUT: junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def) IF junk='Y' THEN DO opt='C' /* to trigger Feedback as Subject */ CALL editor('MAIL' sysop) END LOGOUT2: CALL checkexternal() SIGNAL OFF BREAK_E CALL SETCLIP('BBS_level') CALL callsleft() secs=TIME('E') mins=secs%60 secs=TRUNC(secs//60) IF secs<10 THEN secs='0'secs SAY SAY 'Public files online: 'RIGHT(comma(files.0),9)||CR SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR SAY CR SAY 'Time used this call:' mins':'secs||CR SAY 'Goodbye' name', thank you for calling' bbsname'.'CR linesperpage=99 arg=bbspath'BBS_TEXT/GOODBYE' IF EXISTS(arg) THEN DO CALL DELAY(14) CALL readlines(arg 1) CALL seelines(0) END SAY CR IF bbsprefs.2 & ~terseflag THEN CALL doGrin() OUT: SIGNAL OFF BREAK_E Remote OFF CALL sound('LOGOFF') data.18=winnings line=left(name,16,' ') 'logged off at' time('C') dcd IF RC~=0 THEN Send '\ah' IF data.20~='' THEN DO Status 'Y' elapsed=RESULT line=line 'Total:'elapsed PARSE VAR elapsed thour':'tmin':'. ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly' PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls . IF ~DATATYPE(tmin,'W') THEN tmin=0 IF ~DATATYPE(thour,'W') THEN thour=0 IF ~DATATYPE(dhour,'W') THEN dhour=0 IF ~DATATYPE(dmin,'W') THEN dmin=0 IF ~DATATYPE(calls,'W') THEN calls=0 IF thour=0 & tmin<3 THEN /* free call if less than 3 minutes */ DO wordloc=WORDINDEX(data.11,3)-1 wordval=WORD(data.11,3)+1 data.11=DELWORD(data.11,3,1) data.11=INSERT(wordval' ',data.11,wordloc) END ufile=LEFT(DATE('S'),6) mmins=thour*60+tmin+countcheck(bbspath'Usage/'ufile 0) CALL countcheck(bbspath'Usage/'ufile mmins) mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0) CALL countcheck(bbspath'Numbers/Minutes' mins) mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes'bps 0) CALL countcheck(bbspath'Numbers/Minutes'bps mins) cals=countcheck(bbspath'Numbers/Calls' 0)+1 CALL countcheck(bbspath'Numbers/Calls' cals) cals=countcheck(bbspath'Numbers/Calls'bps 0)+1 CALL countcheck(bbspath'Numbers/Calls'bps cals) thour=thour+dhour tmin=tmin+dmin+1 IF tmin>59 THEN DO thour=thour+tmin%60 tmin=tmin//60 END data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.' CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60) CALL SETCLIP('BBS_userlogoff',TIME('C') DATE()) CALL postuser(6) IF newfilesflag=1 THEN DO newfilesdate=DATE('S') TIME() lastbrowse=countcheck(bbspath'Numbers/LastFile' 0) END IF clear_marked=1 THEN data.24='' CALL saveData(1) data.5='' IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN DO IF sortalphaflag>0 | savefileflag>0 THEN CALL SETCLIP('BBS_QUICK_WAIT',1) ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6 END arg='' lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6) lastline=lastline' 'RIGHT(city,40) lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5) lastline=lastline' Time:'elapsed newpassword='' IF data.20=0 THEN lastline=OVERLAY('UNVALIDATED_USER',lastline,16,38) CALL send2last(lastline) CALL bbsLOGOFF.baud(name level elapsed) SAY lastline||def||CR END OUT2: CALL send2log(line) DONE: CALL send2log('') logonflag=0 DONE2: CBVflag=0 CALL setdir(libpath||dirs.1) CALL SETCLIP('BBS_winnings') CALL SETCLIP('BBS_minutes') CALL SETCLIP('BBS_level') CALL SETCLIP('BBS_door') Capture IF RC~=0 THEN Capture OFF Send '\c\ah' IF WORDS(bbsprefs.27)=8 THEN CALL dimBBcols() ELSE IF bbsprefs.27=1 THEN CALL ScreenToBack('BAUD') ELSE IF bbsprefs.27=2 THEN Screen OFF ELSE CALL DELAY(14) Remote OFF baud maxbps IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN CALL DELAY(128) ELSE DO Send 'ATZH1\r' CALL DELAY(128) Send 'ATH1\r' END IF buildalpha~=0 THEN DO CALL BuildALPHA.rexx() sortalphaflag=0 savefileflag=0 buildalpha=0 END IF sortuserflag=1 THEN DO CALL sortuserlist() IF SHOW('P','BBBBS_LOCAL') THEN DO CALL SETCLIP('BBS_localusers') CALL SETCLIP('BBS_mainusers',1) END END IF sortalphaflag>0 | savefileflag>0 THEN DO IF savefileflag>0 THEN CALL savefilelist2() ELSE CALL savealphalist() IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2) CALL SETCLIP('BBS_QUICK_WAIT') END IF emailonline<0 THEN CALL countmail() bad_atz=ATZreset() /* reset modem */ IF bbsprefs.15=0 THEN /* quit or restart? */ DO IF words(bbsprefs.27)=8 THEN CALL setBBcols() CALL checkstats() EXIT END IF STORAGE()1 & GETCLIP('BBS_maint')='' THEN DO CALL DELAY(150) Send 'ATH1\r' CALL SETCLIP('BBS_localfiles') CALL loadfiles() CALL loadalpha() SIGNAL DONE2 END IF GETCLIP('BBS_localusers')~='' THEN DO CALL DELAY(150) Send 'ATH1\r' CALL SETCLIP('BBS_localusers') CALL loaduserlist() SIGNAL DONE2 END IF bad_atz=1 THEN bad_atz=ATZreset() dcd IF RC~=0 THEN Send '\ah' wres='' Wait 'RING' wres=RESULT IF wres='RING' THEN DO Send 'ATA\r' Timeout 45 /* wait 45 seconds for connect */ wres='' Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG' wres=RESULT IF wres~='CONNECT' THEN SIGNAL DONE2 CALL DELAY(114) SAY ' 'CR CALL DELAY(28) SAY ' 'CR dcd IF RC=0 THEN DO CALL DELAY(128) dcd IF RC=0 THEN DO CALL DELAY(128) dcd IF RC=0 THEN SIGNAL DONE2 END END IF GETCLIP('BBS_maint')='' THEN DO CALL SETCLIP('BBS_interpret') IF words(bbsprefs.27)=8 THEN CALL setBBcols() ELSE IF bbsprefs.27=2 THEN Screen ON ELSE CALL DELAY(114) SAY ''CR /* reset text defaults */ SIGNAL LOGON END Remote ON SAY bbsname 'is busy with periodic maintenance.'CR SAY 'Please try again in a few minutes.'CR Send '\ah' SIGNAL DONE2 END ELSE CALL checkstats() END EXIT dimBBcols: DO i=0 TO 7 Send '\S'i'-'WORD('000 BA3 039 878 094 828 552 835',i+1) END RETURN setBBcols: DO i=0 TO 7 Send '\S'i'-'WORD(bbsprefs.27,i+1) END RETURN ATZreset: TimeOut 10 Send 'ATZ\r' Wait 'OK,RING' IF RESULT~='OK' THEN DO Send '\d\wATZ\r' Wait 'OK' IF RESULT~='OK' THEN DO Send '\w\w+++\w\w\w\wATH\r' CALL sound('ATZ_FAIL') IF WORDS(bbsprefs.27)=8 THEN CALL setBBcols() ELSE IF bbsprefs.27=1 THEN CALL ScreenToFront('BAUD') ELSE IF bbsprefs.27=2 THEN Screen ON line='*** ATZ failed to reset!' TIME('C') DATE() SAY line' Check your modem!!'CR CALL send2log(line) RETURN 1 END END TimeOut 45 Send '\dATH\r' RETURN 0 getbaudrate: PROCEDURE TRACE OFF BaudRate brate=RC TRACE RETURN brate checkalias: addressee='' IF alias.0=0 THEN RETURN 0 DO i=1 TO alias.0 IF UPPER(alias.i)=UPPER(string) THEN DO addressee=realname.i LEAVE i END END IF addressee='' THEN RETURN 0 string='' SAY pen3'Email to 'def||addressee||CR CALL editor('MAIL' addressee) RETURN 0 Friends: ch='' aliasexclude='sysop bye off' DO WHILE ch~='Q' SAY CR SAY pen3||LEFT('=',75,'=')def||CR SAY CENTER('F R I E N D S - L I S T',75)||CR SAY CR SAY CENTER('A L I A S E D I T O R',75)||CR SAY pen3||LEFT('=',75,'=')def||CR SAY CR SAY ' 'pen3'W - 'def'What is the Friends List? 'CR SAY ' 'pen3'A - 'def'Add an Alias 'CR SAY ' 'pen3'D - 'def'Delete an Alias 'CR SAY ' 'pen3'V - 'def'View my Aliases 'CR SAY ' 'pen3'Q - 'def'Return to Main Menu'CR SAY CR ch=getinput(1 1 pen3'Enter Choice > 'def) SELECT WHEN ch='W' THEN CALL whatFriends() WHEN ch='A' THEN CALL addalias() WHEN ch='D' THEN CALL delalias() WHEN ch='V' THEN CALL viewalias() WHEN ch='Q' THEN CALL saveFriends() OTHERWISE SAY 'No such command'CR END END string='' RETURN saveFriends: frn=bbspath'Friends/'name IF alias.0<1 THEN DO CALL DELETE(frn) RETURN END CALL OPEN(f,frn,'W') DO i=1 TO alias.0 CALL WRITELN(f,alias.i' 'realname.i) END CALL CLOSE(f) RETURN whatFriends: CALL readlines(bbspath'Information/BBBBS.Friends' 1) CALL cleanline(0) CALL seelines(0) IF waitchar~='Q' THEN CALL waiting() nonstop=0 RETURN addalias: match=0 username=getinput(1 0 pen3'Enter Users Email Name > 'def) username=cleanstring(1':'username) IF username='' THEN RETURN IF FIND(userlist,username)=0 THEN DO SAY 'Username not found'CR RETURN END newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ') IF newalias='' THEN RETURN IF alias.0>0 THEN DO i=1 TO alias.0 IF UPPER(alias.i)=UPPER(newalias) THEN match=1 END IF FIND(aliasexclude,newalias)>0 THEN match=2 IF match=0 THEN DO alias.0=alias.0+1 num=alias.0 alias.num=newalias realname.num=username SAY alias.num 'alias as ' realname.num 'added'CR END ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'CR ELSE SAY newalias ' is a reserved name'CR RETURN delalias: match=0 dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def) dalias=UPPER(WORD(dalias,1)) IF alias.0>0 THEN DO i=1 TO alias.0 IF UPPER(alias.i)=UPPER(dalias) THEN DO match=1 num=i LEAVE i END END IF match=1 THEN DO IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN DO DO i=num TO alias.0 j=i+1 alias.i=alias.j realname.i=realname.j END alias.0=alias.0-1 END END ELSE SAY dalias' not Found.'CR RETURN viewalias: IF alias.0>0 THEN DO i=1 TO alias.0 SAY RIGHT(alias.i,22) 'is' realname.i||CR END ELSE SAY 'No Aliases assigned'CR RETURN upCBV: ARG res . temp=bbspath'Lists/CBV_USERS' IF EXISTS(temp) THEN t2='A' ELSE t2='W' x=OPEN(f,temp,t2) IF x=0 THEN RETURN 1 IF t2='W' THEN CALL WRITELN(f,'*** Call Back Verify Log ***') temp=RIGHT(TIME('C'),7) COMPRESS(DATE()) temp=temp LEFT(name,24) RIGHT(telnum' RESULT:',20) res CALL WRITELN(f,temp) CALL CLOSE(f) RETURN 0 CBV: IF bbsprefs.22=0 THEN RETURN SAY CR CALL showtext(bbspath'BBS_TEXT/CBV_INFO') SAY CR telnum=getinput(1 0 pen7'Please Enter Phone Number For Call Back: 'def ) mask=COMPRESS(XRANGE(),'0123456789-, @#*') telnum=COMPRESS(telnum,mask) IF telnum='' THEN RETURN DO n=1 WHILE n ' IF getinput(1 1 temp)~='Y' THEN RETURN CALL sound('CBV') telnum=COMPRESS(telnum) data.27=STRIP(data.27 telnum) SAY pen3'Logging Off. Callback to' telnum 'in 30 seconds.'def||CR SAY 'When your modem rings, type ATA and press RETURN.'CR SAY pen2'GoodBye for now,' name '.'def||CR REMOTE OFF Timeout 10 Send '\ah' Wait 'OK,RING' IF RESULT~='OK' THEN DO Send '\d' CALL DELAY(50) DO n=1 TO 10 WHILE ATZreset()=1 END END CALL DELAY(50) Send 'ATH1\r' SAY CR CALL DELAY(100) SAY CR DO n=14 TO 1 BY -1 MSG '1B'x'M' n*2 'seconds left before CBV callback...' CALL DELAY(100) END MSG lineup 'Beginning CBV callback... ' SAY CR Timeout 10 Send '\ah' Wait 'OK' IF RESULT~='OK' THEN DO Send '\d' CALL DELAY(50) DO n=1 TO 10 WHILE ATZreset()=1 END END CALL DELAY(50) Send 'ATL3M1DT'telnum'\r' /* M1 = Speaker ON, L3 = volume up */ Timeout 90 Wait 'CONNECT,NO CARRIER,BUSY,ERROR' IF RESULT~='CONNECT' THEN DO CALL upCBV('FAILED') SIGNAL OUT END REMOTE ON DO i=20 TO 0 BY -1 SAY CENTER(copyright.i,75)||CR END SAY CENTER(bbsname 'Call Back Identity Verification',74)||CR SAY CR CBVflag=1 Timeout maxidle DO cnt=1 TO 3 Namentr=getinput(1 0 pen3' Enter Name: 'def) Namentr=cleanstring('1:'Namentr) IF Namentr=name THEN LEAVE cnt END DO count=1 TO 4 IF cnt>3 | count>3 THEN DO SAY 'Incorrect Entry!'||CR SAY 'Verification Denied.'||CR SAY pen2'Leave a 'pen3'['pen7'C'pen3']omment'pen2'to SysOp,'CR SAY pen2'for manual verification.'CR SAY CR CALL upCBV('DENIED') SIGNAL OUT END pw=getinput(1 0 pen3'Enter Password: 'def) IF UPPER(pw)=data.5 THEN DO CALL upCBV('VERIFIED') v=GETCLIP('BBS_COMMAND')'V' CALL SETCLIP('BBS_COMMAND',v) CBVflag=0 RETURN END END RETURN /* BBBBS.baud */