/* $VER: 5.2 BBBBS.baud 6 Jul 1992 (6.7.92) 1:42PM copyright 1990-91-92 Richard Lee Stockton FREELY DISTRIBUTABLE 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),3)) copyright.2=' from Gramma Software 17730-15th NE Suite 223 Seattle WA 98155' copyright.3=' ARexx portions of this software copyright 1990-91-92 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') /* try to trap everything */ OPTIONS RESULTS OPTIONS FAILAT 999999 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() /* TEXT - 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' name='' CR='0D'x LF='0A'x SAY CR SAY CENTER(copyright.1,75)||CR CALL PRAGMA('W','N') CALL config() 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 WRITELN('log','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 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,'N') THEN msg.num=WORD(line,2) END CALL CLOSE(f) END excuses.='' courtesy='' courtesyflag=0 SAY CENTER(copyright.4,75)||CR SAY CR SAY CR SAY ' Setting up, please wait...'CR SAY CR 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,'N') THEN dirs.num=STRIP(WORD(line,2)) END CALL CLOSE(f) END CALL loaduserlist() SAY ' The larger the BBS gets, the longer it takes to setup...'CR CALL loadfiles() SAY CR SAY ' If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR SAY CR CALL set_grand() CALL loadalpha() dcd IF RC=0 THEN DO logonflag=0 SIGNAL DONE END LOGON: CALL checkdcd() OPTIONS FAILAT 999999 bps=0 SetMark 'CONNECT' IF RC=1 THEN DO GetLine connectline=RESULT PARSE VAR connectline 'CONNECT'bps CALL STRIP(bps) 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=4 WHILE DATATYPE(SUBSTR(bps,i,1),'N') END bps=LEFT(bps,i-1) NUMERIC DIGITS 14 OPTIONS RESULTS SIGNAL ON BREAK_C SIGNAL OFF BREAK_E SIGNAL ON SYNTAX SIGNAL ON FAILURE REMOTE ON TimeOut 120 IF bps<300 THEN bps=getbaudrate() IF bps>14400 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 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 arg=bbspath'BBS_TEXT/HELLO' CALL readlines(arg 1) CALL seelines(0) END SAY CR SAY 'Running on' BB_VERS 'at' bps 'baud.'CR Stat 'Z' CALL checkdcd() Queue CR /* Ask for name */ name='' courtesy='' 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 SAY 'New Users please enter NEW to apply for validation.'CR 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() 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) Beep (bm*10) CALL DELAY(7) Beep (bm*7) Timeout maxidle /* max idle time at prompts */ /* 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 arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4) IF ~EXISTS(arg) THEN DO arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3) IF ~EXISTS(arg) THEN arg=bbspath'BBS_TEXT/WELCOME' END IF EXISTS(arg) THEN DO SAY CR CALL showtext(arg) nonstop=0 END /* 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 sortlibraries() /* Get current protocol */ Status Trans protocol=RESULT CALL readmail(0) lastbrowse=WORD(data.16,1) IF ~DATATYPE(lastbrowse,'N') THEN lastbrowse=0 IF ~terseflag THEN DO IF level>sysoplevel THEN DO lstmail=WORD(data.17,3) IF ~DATATYPE(lstmail,'N') 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') END CALL logonstats() CALL newinfo() END CALL showmarked() 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 */ OPTIONS RESULTS OPTIONS FAILAT 999999 SIGNAL ON FAILURE SIGNAL ON SYNTAX SIGNAL ON BREAK_C SIGNAL ON BREAK_E waitchar='' string='' IF level<1 THEN menu='NEW' DO WHILE(opt~='G') go=0 DO WHILE(~go) IF waitchar='' | waitchar='?' THEN DO commands='cghiqsvwxyz!#,' 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 DO opt='MENU' arg='' CALL postuser(1) CALL menus() END ELSE SAY pen3'COMMANDS:'def commands||CR 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 IF waitchar='' THEN waitchar=getinput(0 0 line' > ') PARSE VAR waitchar string' 'arg CALL checkdcd() string=UPPER(STRIP(string)) IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2 waitchar='' warnings=0 IF DATATYPE(string,'N') THEN DO dirnum=string CALL chdir2() CALL since() END 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 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 IF menu~='ALL' THEN menu='FILE' 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 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='?') & menuflag THEN CALL help('MAIN') OTHERWISE NOP END END SIGNAL LOGOUT EXIT /* an extra margin of safety */ /* FUNCTIONS */ 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 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 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 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'!'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'S'def']earch files 'pen6'|'def||CR SAY pen6' |'def' ['pen3'V'def']iew user log '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'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'D'def']ownload ['pen3'!'def'] YELL for SYSOP 'pen6'|'def||CR SAY pen6' |'def' ['pen3'J'def']ump to doorways ['pen3'U'def']pload ['pen3'X'def']pert (no menus) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'S'def']earch menu ['pen3'T'def']ransfer protocol ['pen3'$'def'] toggle menu(s) 'pen6'|'def||CR SAY pen6' |'def' ['pen3'&'def'] user profiles ['pen3'+'def'] Extra Devices ['pen3'#'def'] toggle colors 'pen6'|'def||CR SAY pen6' |'def' ['pen3'G'def']oodbye (logoff) ['pen3'V'def']iew user log ['pen3','def'] hourly stats '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 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=name city' On:' logontime' 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),'N') 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!' 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!' 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!' 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!' SIGNAL DONE2 END testchar=RIGHT(libpath,1) IF testchar~='/' & testchar~=':' THEN libpath=libpath'/' CALL SETCLIP('BBS_libpath',libpath) spellpath=WORD(lynes.9,1) IF bbsprefs.5 & ~EXISTS(spellpath) THEN DO SAY spellpath 'does not exist!' bbsprefs.5=0 END 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,'N') THEN maxbps=2400 CALL SETCLIP('BBS_baud',maxbps) DO i=16 TO 31 j=i-15 bbsprefs.j=STRIP(WORD(lynes.i,1)) END 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,'N') THEN bbsprefs.16=3 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,'N') 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 IF chdir()>0 THEN RETURN 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 shi=1 TO alpha.0 IF test='Y' THEN DO IF count>=filecount THEN LEAVE shi IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.shi,5),12)) THEN ITERATE shi END jj=WORD(alpha.shi,4) IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN ITERATE shi SAY alpha.shi||CR count=count+1 IF (count+2)//linesperpage=0 THEN IF waiting2() THEN LEAVE shi END 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 pfl1 END emnum=getinput(1 0 pen3'Select User Profile Number > 'def) IF DATATYPE(emnum,'N') & 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),'N') 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() IF GETCLIP('BBS_oldname')='' THEN CALL send2log('Name Change:' cname) cname=GETCLIP('BBS_newname') CALL DELETE(bbspath'Lists/USERS') sortuserflag=1 CALL SETCLIP('BBS_oldname') CALL SETCLIP('BBS_newname') RETURN cname levelreport: minlev=0 maxlev=99 templist='' 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,5)) 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,'N') THEN minlev=0 IF ~DATATYPE(maxlev,'N') 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) IF lynes.20maxlev THEN ITERATE levi line=lynes.20 WORD(templist,levi) SAY line||CR IF ~DATATYPE(WORD(lynes.20,1),'N') | WORD(lynes.20,1)<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 lcom=getinput(1 1 '['pen3'A'def']dd or ['pen3'K'def']ill or ['pen3'R'def']ename or ['pen3'S'def']kip this user? (Akrs) > ') 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>1 THEN templist=STRIP(LEFT(templist,temp-1)) templist=STRIP(templist newname rtemp) END levi=levi-1 CALL SETCLIP('BBS_newname') END ELSE IF lcom~='S' THEN DO IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN DO DO lvi=1 TO 21 line=READLN(f) IF lvi=11 THEN lynes.11=line IF lvi=20 THEN lynes.20=line END lynes.21=line CALL CLOSE(f) edtype='' 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' THEN DO 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 END END END IF newufile~='' THEN CALL DELETE(newufile) DROP templist 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,'N') 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 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 jump2rexx: IF ~DATATYPE(jdoors.0,'N') 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 jdoors.i=LEFT(RIGHT(i,3)'.' LEFT(doors.i,LENGTH(doors.i)-5),24) DO j=1 TO 2 k=i+j*jdoors.0 IF k<=doors.0 THEN jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24) END END END DO doorloop=1 SAY pen3||LEFT('-',75,'-')||def||CR DO jd=1 TO jdoors.0 SAY jdoors.jd||CR IF jd//linesperpage=0 THEN CALL waiting() IF waitchar='Q' THEN RETURN END temp=getinput(1 0 pen3'Select Application Number > 'def) IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN RETURN arg=doors.temp 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 CALL SETCLIP('BBS_demon',timeleft) ADDRESS AREXX doorDemon.baud INTERPRET 'call' doors.temp'('name winnings savewinnings colorflag')' 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') IF SHOW('P','BBS_DEMON') THEN CALL SETCLIP('BBS_demon','QUIT') SAY CR CALL showtime() END RETURN sortlibraries: SAY 'Sorting Libraries...'lineup||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...'lineup||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,'N') 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,'N') 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,'*') CALL searchmsgdir() 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),'N') 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,'N') 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,'N') & 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()=0 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: IF WORDS(data.24)<1 THEN RETURN SAY CR SAY pen6'These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'def||CR tempkk=data.24 DO i=1 TO WORDS(tempkk) tempk=WORD(tempkk,i) PARSE VAR tempk kdir'/'kmsg IF EXISTS(msgpath||kdir'/'kmsg) THEN SAY RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference.'CR ELSE data.24=DELWORD(data24,FIND(data.24,tempk)) END CALL waiting() SAY CR 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,'N') 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,'N') 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 SAY pen3'Scanning'def WORDS(userlist) pen3'email directories...'def||CR firsteditline=0 picklist.='' picklist.0=0 DO ei=1 TO WORDS(userlist) fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,ei)) 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,ei)'/'ejname IF EXISTS(arg) THEN DO pklst=picklist.0+1 picklist.pklst=WORD(userlist,ei) picklist.pklst.0=ejname picklist.0=pklst END END END END 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 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 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 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) arg=bbspath'Email/'name'/'readname /* user has mail! */ CALL readlines(arg 1) 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 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 arg=mailfile DO WHILE dload()=1 END arg=savearg 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 IF getinput(1 1 'Reply to this message? (nY) > ')~='N' 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 IF getinput(1 1 'Forward mail from'pen3 uname def'to other users? (Ny) > ')='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=getinput(1 1 'Delete the mail from'pen3 uname def'you just read? (nqY) > 'def) IF tempchar='Q' THEN IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN RETURN 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) 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 RETURN 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,'N') THEN retval=0 IF ~DATATYPE(cknum,'N') THEN cknum=0 IF retval 'def) IF ~DATATYPE(emnum,'N') | 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 ' 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 texfile to append to this file.'CR SAY ' An empty RETURN indicates you are finished editing.'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,'N') | ~DATATYPE(lastnum,'N') 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,'N') THEN DO IF DATATYPE(edcom,'N') 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,'N') 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,'N') 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' edtype lastwrit+1 'To: 'def) toname=thechosen.1 END ELSE toname=getinput(1 0 pen3'Post 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 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=INSERT('','',1,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~='' & 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,'N') 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,'N') 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)=0 THEN RETURN mlines.='' DO mi=1 TO 24 mlines.mi=READLN(f) END mlines.24=STRIP(mlines.24 markdir'/'markmsg) CALL SEEK(f,0,'B') DO mi=1 TO 24 CALL WRITELN(f,mlines.mi) END CALL CLOSE(f) RETURN shell: SAY CR 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 RETURN yellsnd: IF EXISTS(bbspath'BBS_TEXT/YELL.snd') & EXISTS('c:Sound') THEN ADDRESS COMMAND 'C:Run C:Sound' bbspath'BBS_TEXT/YELL.snd' 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 yellsnd() IF SHOWLIST('H','SPEAK') THEN /* check on SPEAK: device */ DO IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */ ADDRESS COMMAND 'C:Run C:Type >SPEAK:' bbspath'BBS_TEXT/YELL' ELSE IF writeopen('SPEAK:')~=0 THEN DO CALL WRITELN(f,'Yo sissop.') CALL WRITELN(f,'A uzer wants to chat with you.') CALL WRITELN(f,'Yo sissop.') CALL CLOSE(f) END END ELSE IF EXISTS(saypath) THEN /* default to SAY */ DO IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */ ADDRESS COMMAND 'C:Run' saypath '-x' bbspath'BBS_TEXT/YELL' ELSE DO ADDRESS COMMAND saypath 'Yo sissop.' ADDRESS COMMAND saypath 'A uzer wants to chat with you.' ADDRESS COMMAND saypath 'Yo sissop.' END END RETURN /* online change to member. Sysop triggered by BumpMember.baud */ validate: IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') 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 IF lvi=21 THEN data.21=line END data.22=line CALL CLOSE(f) CALL SetData() CALL sortlibraries() CALL logonstats() CALL saveData(0) SIGNAL RESTART END ELSE MSG bak2'You need a default member file in BBS_TEXT! ( BBS_TEXT/DEF.MEMBER )'def 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,'N') 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() CALL SETCLIP('BBS_level') 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,'N') 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,'N') THEN tfiles=0 IF ~DATATYPE(tbytes,'N') 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,'N') & DATATYPE(sec,'N') & DATATYPE(bytes,'N') 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,'N') THEN temp=0 IF indx=14 & (temp+1024)(bytes+1024) THEN tfail='dl size' END ELSE tfail='not numeric' IF tfail~='' THEN DO line=plaindir'/'arg pen3'*** Transfer failed! ***'def SAY line||CR CALL send2log(line 'tfail:'tfail) Remote OFF Send '^G\w^G^G' Remote ON 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=LEFT(temp,POS(':',temp)-1) 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)+1 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 uload: ARG frommenu 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 */ IF arg='' THEN RETURN 1 arg=COMPRESS(arg,' :/,;|') /* be sure no illegals here */ IF frommenu THEN DO SAY 'Checking filelist...'CR filenum=countcheck(bbspath'Numbers/LastFile' 0) DO ui=1 TO filenum-1 IF UPPER(WORD(files.ui,2))=UPPER(arg) THEN DO temp=WORD(files.ui,1) line=pen3'*** File' arg 'already exists here in the' line=line temp 'directory.'def SAY line||CR SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR RETURN 1 END END CALL cleanline(1) IF bbsprefs.6=1 THEN CALL setdir(bbslibs'Sysops') ELSE DO loop=1 SAY 'Please select an appropriate library for -' pen3||arg def'-'CR IF chdir()=0 THEN LEAVE loop 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) 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' OPTIONS PROMPT 'Received' rbytes 'bytes. Was your upload successful? (ny) > ' PULL temp temp=LEFT(temp,1) END IF temp='N' THEN RETURN 2 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) END IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0 DO ui=sysoplevel+2 TO 100 IF UPPER(dirs.ui)=UPPER(temp) 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 IF bbsprefs.6 THEN /* need sysop approval */ DO SAY 'Your upload is being placed in the Sysops area for review...'CR CALL MAKEDIR(libpath'Sysops') CALL MAKEDIR(bbspath'FileNotes/Sysops') lastfilenumber=countcheck(bbspath'Numbers/LastFile' 0) CALL readlines(bbspath'FileNotes/'plaindir'/'arg 1) CALL movefile(lastfilenumber 'Sysops') END END waitchar='' RETURN 0 findfiles: PARSE ARG ffile . IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile IF DATATYPE(ffile,'N') 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 DO nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1 DO ui=nextfilenum TO 0 BY -1 IF ui<1 THEN DO SAY CR SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR SAY CR RETURN 0 END argtemp=WORD(files.ui,2) IF UPPER(argtemp)=UPPER(ffile) THEN DO dirtemp=WORD(files.ui,1) jj=files.ui.0 IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN DO CALL illegal_access() RETURN 0 END ffile=ui CALL setdir(libpath||dirtemp) LEAVE ui END END END ftemp=ffile IF DATATYPE(ftemp,'N') 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 SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.'CR SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.'CR 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 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,'N') | upbytes<1 THEN upbytes=1 dnbytes=WORD(data.15,3) IF ~DATATYPE(dnbytes,'N') | dnbytes<1 THEN dnbytes=1 dbytes=WORD(STATEF(ffile),2) IF ~DATATYPE(dbytes,'N') THEN dbytes=1 IF ~DATATYPE(bps,'N') 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 CALL send2log(needtime%60 'mins needed to dl' ffile 'at' dbytes 'bytes!'def) 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 updownloadratio>0 & (dnbytes/upbytes)>updownratio THEN DO SAY CR line=pen3' *** You must upload before you do any more downloading! ***'def SAY line||CR CALL send2log('*** Exceeded Download Ratio 1:'TRUNC(dnbytes/upbytes)) 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 showxdevs: PROCEDURE EXPOSE bbspath pen3 def CR CALL FileList(bbspath'Numbers/Files.X.*',xfiles,'F','N') IF xfiles.0>1 THEN CALL QSORT(1,xfiles.0,xfiles) DO i=1 TO xfiles.0 ii=LASTPOS('FILES.X.',UPPER(xfiles.i))+8 temp=SUBSTR(xfiles.i,ii) SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.X.'temp 0)),15) 'bytes in' RIGHT(comma(countcheck(bbspath'Numbers/Files.X.'temp 0)),7)' files downloaded from' pen3||temp||def||CR END SAY LEFT('-',74,'-')||CR RETURN 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) SAY 'Working...'lineup||CR IF POS('EMAILFILES',curdir)=0 THEN DO di=1 TO WORDS(tempargs) WHILE STRIP(allargs)~='' arg=WORD(tempargs,di) wloc=WORDINDEX(allargs,FIND(allargs,arg)) temp=findfiles(arg) IF temp~=arg THEN DO allargs=DELWORD(allargs,FIND(allargs,arg),1) IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1) END END dload2: curdir=PRAGMA('D') allargs=STRIP(data.25 allargs) data.25='' IF allargs='' THEN RETURN 0 sleepy='T' DO WHILE sleepy='T' arg='' SAY CR temp=WORD(allargs,1) IF DATATYPE(temp,'N') 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) /* emailfile will not get here */ temp=WORD(allargs,di) IF DATATYPE(temp,'N') 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,'N') 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) 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,'N') 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,'N') 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 ELSE DO 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=INSERT('','',1,74,'=') lynes.1=lynes.1 edkeywords(arg filedir) END 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 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 31 characters will be used.'CR SAY INSERT('','',1,74,'=')||CR templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def) SAY CR RETURN STRIP(LEFT(templine,32)) 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,'N') 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 'Adjusting 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 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) CALL cleanline(0) 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 alpha.i=line fnum=WORD(line,3) files.fnum.0=i 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 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 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='' 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=24 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,'N') & 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 ' MENU combines all main commands into 1 menu.'CR SAY ' MENUS splits main commands into 3 menus.'CR SAY ' COLOR turns ANSI color codes ON.'CR SAY ' PHONE makes your phone number public.'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,'N') & 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='' DO WHILE ~DATATYPE(tnum,'N') tnum=getinput(1 0 ' 'tprompt' > ') mask=COMPRESS(XRANGE(),'0123456789') tnum=COMPRESS(tnum,mask)%1 END 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 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 IF RIGHT(BB_VERS,4)>1.59 THEN DO;Beep 400;Beep 250;Beep 200;Beep 150;END ELSE DO;Beep 600;Beep 400;Beep 300;Beep 200;END /* new user riff */ 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 ANSI color 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 CALL WRITELN(f,DATE() TIME() name' = 'data.1' 'data.4) 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-1 data.11='60 minutes' bbsprefs.16-1 'more times today' END SAY CR IF data.20=0 THEN SAY 'Thank you, the sysop will give you higher access soon.'CR SAY 'Please feel free to leave additional info by using [C]omment.'CR SAY CR CALL SetData() 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) 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 /* Uncomment section below to have name announced at logon. */ /* IF SHOWLIST('H','SPEAK') THEN DO IF writeopen('SPEAK:')~=0 THEN DO CALL WRITELN(f,'Yo sissop.') CALL WRITELN(f,name 'has logd awn.') CALL CLOSE(f) END END ELSE IF EXISTS(saypath) THEN DO ADDRESS COMMAND saypath 'Yo sissop.' ADDRESS COMMAND saypath name 'logd awn.' END */ RETURN saveData: ARG messflag . IF data.5='' THEN RETURN 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,'N') THEN lastread.si=0 IF userexclude.si THEN data.22=data.22 '-1' ELSE data.22=data.22 lastread.si IF ~DATATYPE(totwrit.si,'N') THEN totwrit.si=0 data.23=data.23 totwrit.si END END IF writeopen(bbspath'USERS/'name)=0 THEN RETURN IF data.0<24 THEN data.0=24 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) level=data.20 DO i=1 TO level lastread.i=WORD(data.22,i) IF ~DATATYPE(lastread.i,'N') THEN lastread.i=0 totwrit.i=WORD(data.23,i) IF ~DATATYPE(totwrit.i,'N') 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' Set UPPER(LEFT(data.6,1)) END 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 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 /* IF RIGHT(BB_VERS,4)>1.59 THEN SAY '['pen3'R'def']- Kermit'CR */ SAY CR arg=getinput(1 0 STRIP(protocol) '> ') END 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,'N') 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 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 IF num=0 THEN DO i=1 TO sortinfo.0 SAY sortinfo.i.0||CR END ELSE DO i=1 TO sortinfo.0 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,'N') | num<1 | num>info.0 THEN RETURN readcount=STATEF(bbspath'Information/'info.num) readbytes=WORD(readcount,2) readcount=WORD(readcount,8) IF ~DATATYPE(readcount,'N') THEN readcount=0 SAY ' 'info.num 'is' readbytes 'bytes.'CR SAY 'Loading File...'CR ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1 CALL readlines(bbspath'Information/'info.num 1) CALL cleanline(0) SAY lineup' 'lynes.0 'lines.'CR SAY CR CALL seelines(0) 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) 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 filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir)) DO ni=lastfileup TO lastbrowz+1 BY -1 IF files.ni~='' THEN DO IF test='Y' THEN DO 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 */ 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 END END IF j//linesperpage~=0 THEN CALL waiting() 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 IF WORD(STATEF(bbspath'Information'),5)>lastondate THEN DO lynes.1=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def ADDRESS COMMAND 'C:LIST >ram:dirlist' bbspath'Information NOHEAD DATES SINCE' sincedate CALL readlines('ram:dirlist' 2) END IF WORD(STATEF(bbspath'Profiles'),5)>lastondate THEN DO startline=lynes.0+1 lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def ADDRESS COMMAND 'C:LIST >ram:dirlist' bbspath'Profiles NOHEAD DATES SINCE' sincedate CALL readlines('ram:dirlist' startline+1) 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 END temp=getinput(1 0 pen3'Select Message Conference: 'def) IF ~DATATYPE(temp,'N') | 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,'N') 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 IF dirs.dirnum~='' THEN DO CALL MAKEDIR(libpath||dirs.dirnum) CALL setdir(libpath||dirs.dirnum) END 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,'N') THEN onetime=1 ELSE arg='' DO listloop=1 IF DATATYPE(arg,'N') THEN DO dirnum=arg arg='' IF chdir2()>0 THEN RETURN CALL listsimple() IF waitchar='Q' THEN RETURN IF onetime THEN LEAVE listloop END ELSE IF arg='' THEN DO IF chdir()>0 THEN RETURN test='Y' CALL showalpha2() arg='' 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 IF arg='' THEN DO test=getinput(1 1 '['pen3'R'def']ead descriptions or ['pen3'A'def']rchive for later download. (aR) > ') IF test='A' THEN DO IF STORAGE()<(bbsprefs.15+100000) 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 CALL send2log('Arc: Make_BrowseList.baud') CALL Make_BrowseList.baud(name) IF countcheck(bbspath'Numbers/LastFile' 0)>lastfilenum THEN IF emailonline>=0 THEN emailonline=emailonline+1 RETURN END line='Browsing' test=getinput(1 1 'Browse one library only? (Ny) > ') IF test='Y' THEN DO IF chdir()>0 THEN RETURN curdironly=1 line=line 'the' pen3||plaindir||def 'library' END ELSE line=line 'all file libraries' line=line 'backwards from latest file.' SAY line||CR END 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,'N') & files.arg~='' THEN DO brfilenum=arg arg=WORD(files.arg,2) END ELSE DO DO i=1 TO lastfilenum+1 IF UPPER(WORD(files.i,2))~=UPPER(arg) THEN ITERATE i brfilenum=i LEAVE i END IF i>lastfilenum 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 DO i=brfilenum TO 0 BY -1 IF files.i='' THEN ITERATE i testdir=UPPER(WORD(files.i,1)) IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN DO IF i>lastbrowse THEN lastbrowse=i ITERATE i END IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN DO IF i>lastbrowse THEN lastbrowse=i ITERATE i END LEAVE i END IF i=0 THEN brfilenum=lastbrowse ELSE brfilenum=i 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 .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,'N') 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 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(libpath||filedir'/'arg),8) CALL DELETE(arg) CALL savelines(arg) mpath=bbspath'FileNotes/'plaindir CALL RENAME(mpath'/'argname,mpath'/'newarg) IF comment~='' THEN ADDRESS COMMAND 'C:FileNote' mpath'/'newarg comment mpath=libpath||plaindir CALL RENAME(mpath'/'argname,mpath'/'newarg) 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,'N') THEN DO dirnum=mvdir IF chdir2()=0 THEN CALL movefile(brfilenum dirs.dirnum) END ELSE DO mvdir=STRIP(mvdir) 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 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=argname 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='' CALL savefilelist() 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)) 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 CALL DELETE(bbspath'FileNotes/'fromdir'/'farg) 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 SAY 'Searching Message Conferences for'pen3 searcharg||def'...'CR SAY CR DO msgdir=1 TO level IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE msgdir CALL searchmsgdir() IF msgcom='Q' THEN LEAVE msgdir END END IF smenu='FILE' THEN DO SAY pen3'WARNING!'def 'Searching' files.0 '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ') IF test='Q' THEN RETURN IF test~='F' THEN DO SAY CR SAY pen3'Searching files for'def UPPER(searcharg)||CR CALL fileheader() DO i=1 TO alpha.0 IF WORD(alpha.i,4)>level 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 SAY alpha.i||CR IF colorflag=1 THEN SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR END END END ELSE DO SAY CR SAY pen3'Searching files for'def UPPER(searcharg)||CR SAY pen3' - To ABORT, press CTRL-E -'def||CR SAY CR cck=countcheck(bbspath'Numbers/LastFile' 0) nonstop=1 DO i=1 TO cck iii=cck+1-i IF files.iii='' THEN ITERATE i farg=WORD(files.iii,1)'/'WORD(files.iii,2) ii=files.iii.0 IF WORD(alpha.ii,4)>level THEN ITERATE i IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i 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 END searcharg='' nonstop=0 CALL waiting() RETURN searchmsgdir: msglist=SHOWDIR(msgpath||msgdir) IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR DO sri=1 TO WORDS(msglist) messnum=WORD(msglist,sri)%1 IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN DO savelast=lastread.msgdir CALL readmsg(0 messnum) lastread.msgdir=savelast IF msgcom='Q' THEN RETURN END END 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'nd on a new line to exit.'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) IF test='/E' | test='/S' THEN LEAVE bufloop CALL checkdcd() 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 & WORDS(lynes.wi)>1 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 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,INSERT('','',1,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,'N') 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 DO i=1 TO 4 SAY CENTER(copyright.i,75)||CR END prevcaller=GETCLIP('BBS_prevcaller') IF prevcaller~='' THEN DO SAY CR SAY 'The previous'pen3 bbsname def'user was:'CR SAY ' 'prevcaller||CR SAY ' logged off at:' GETCLIP('BBS_userlogoff')||CR SAY pen3'Last disconnect:'def GETCLIP('BBS_disconnect')||CR END SAY CR day1='01' IF readopen(bbspath'Numbers/FirstLogon') THEN DO line=READLN(f) CALL CLOSE(f) SAY 'The First Logon to'pen3 bbsname def'was' line'.'CR PARSE VAR line .' 'day1'-'. END IF day1<10 & LENGTH(day1)<2 THEN day1='0'day1 SAY ' Your sysop is' pen3||sysop||def||CR SAY CR usagelist=SHOWDIR(bbspath'Usage','F') tempnum=FIND(usagelist,'USER.LOG') IF tempnum>0 THEN usagelist=DELWORD(usagelist,tempnum,1) usagelist=sortnumbers(usagelist) SAY pen3' - Total BBS Usage -'def||CR DO i=1 TO WORDS(usagelist) dateclip=STRIP(WORD(usagelist,i)) IF i=1 THEN day1=dateclip||day1 usageclip=countcheck(bbspath'Usage/'dateclip 0) usageclp=usageclip%60 usageclip//60 mtime=30*23*60 /* we guess 1 hour a day for various maintenance */ IF dateclip=LEFT(DATE('S'),6) THEN mtime=RIGHT(DATE('S'),2)*23*60 dateclip=dateclip'01' line=RIGHT(DATE('M',dateclip,'S'),10) WORD(DATE(,dateclip,'S'),3)':' line=line RIGHT(WORD(usageclp,1),3) 'hours' RIGHT(WORD(usageclp,2),2) line=line 'minutes = ' RIGHT(((usageclip*100)/mtime)%1,2) 'percent usage.' SAY line||CR IF (i+12)//(linesperpage-3)=0 THEN IF waiting2() THEN LEAVE i END cmin=countcheck(bbspath'Numbers/Minutes' 0) chr=cmin%60 cmin=cmin//60 hrz=chr IF hrz<1 THEN hrz=1 IF day1>19900101 THEN DO hrz=1+DATE('I')-DATE('I',day1,'S') hrz=hrz*24 END SAY CR SAY ' Total Connect Time Since First Logon [all users]:'CR SAY RIGHT(chr,20) 'hours' RIGHT(cmin,2) 'minutes = ' RIGHT(((chr*100)/hrz)%1,2) 'percent usage.'CR SAY CR CALL waiting2() IF waitchar='Q' THEN RETURN CALL bbsspace(15) SAY RIGHT(comma(countcheck(bbspath'Numbers/Calls' 0)),15) 'completed calls.'CR SAY CR IF extdevs~='' THEN CALL showxdevs() SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.DownLoad' 0)),15) 'bytes in' RIGHT(comma(countcheck(bbspath'Numbers/Files.DownLoad' 0)),7) 'files downloaded.'CR SAY CR SAY RIGHT(comma(countcheck(bbspath'Numbers/Bytes.UpLoad' 0)),15) 'bytes in' RIGHT(comma(countcheck(bbspath'Numbers/LastFile' 0)),7) 'files uploaded.'CR IF emailonline<0 THEN CALL countmail() SAY RIGHT(comma(emailonline),15) 'online of' RIGHT(comma(countcheck(bbspath'Numbers/LastMail' 0)),7) 'private messages.'CR SAY RIGHT(comma(grand),15) 'online of' RIGHT(comma(grand2),7) 'public messages.'CR SAY RIGHT(comma(files.0),15) 'online of' RIGHT(comma(countcheck(bbspath'Numbers/LastFile' 0)),7) 'public files.'CR SAY RIGHT(comma(WORDS(userlist)),15) 'active of' RIGHT(comma(countcheck(bbspath'Numbers/Users' 0)),7) 'user applications.'CR SAY CR SAY 'Your access level is 'level' - minimum sysop level is' sysoplevel||CR SAY CR SAY ' You Have'CR totmail=WORD(data.17,2) IF ~DATATYPE(totmail,'N') THEN totmail=0 totmsg=0 DO ti=1 TO level temp=WORD(data.23,ti) IF DATATYPE(temp,'N') THEN totmsg=totmsg+WORD(data.23,ti) END SAY ' Written' RIGHT(comma(totmsg),14)' public &' RIGHT(comma(totmail),8)' private messages.'CR totfiles=WORD(data.14,1) IF ~DATATYPE(totfiles,'N') THEN totfiles=0 totbytes=WORD(data.14,3) IF ~DATATYPE(totbytes,'N') THEN totbytes=0 SAY ' Uploaded' RIGHT(comma(totbytes),14)' bytes in' RIGHT(comma(totfiles),8)' files.'CR totfiles=WORD(data.15,1) IF ~DATATYPE(totfiles,'N') THEN totfiles=0 totbytes=WORD(data.15,3) IF ~DATATYPE(totbytes,'N') THEN totbytes=0 SAY 'Downloaded' RIGHT(comma(totbytes),14)' bytes in' RIGHT(comma(totfiles),8)' files.'CR PARSE VAR data.19 dhour' hours 'dmin' minutes in 'calls . IF ~DATATYPE(dhour,'N') THEN dhour=0 IF ~DATATYPE(dmin,'N') THEN dmin=0 IF ~DATATYPE(calls,'N') THEN calls=0 SAY '..and been on' bbsname dhour 'hours' dmin+TIME('E')%60 'minutes in' calls+1 'calls.'CR SAY CR CALL waiting2() IF waitchar='Q' THEN RETURN CALL showmarked() 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 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 hc.=0 hc.24=countcheck(bbspath'Numbers/Hourly/Start' 0) IF hc.24=0 THEN hc.25=1 ELSE hc.25=1+DATE('I')-hc.24 hc.26=countcheck(bbspath'Numbers/Hourly/Hour' 0) hc.27=TIME('H') DO i=0 TO 23 temp=hc.25 IF temp>1 & i>hc.27 THEN temp=temp-1 hc.i=countcheck(bbspath'Numbers/Hourly/'i 0)%temp END IF hc.24=0 THEN hc.24=DATE('I') SAY CR SAY pen3' From: 'DATE(,hc.24,'I')' Average minutes per hour of use each day.'def||CR line=' Hour: ********10********20********30********40********50********60' SAY line||CR DO i=0 TO 23 IF i=0 THEN temp=12'am' ELSE IF i<12 THEN temp=i'am' ELSE IF i=12 THEN temp='12pm' ELSE temp=i-12'pm' SAY RIGHT(temp,5)': 'pen3||LEFT('*',hc.i,'*')||def||CR IF i=(linesperpage-4) THEN CALL waiting2() END SAY line||CR DROP hc. 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 IF level>sysoplevel THEN DO IF GETCLIP('BBS_screen')~=0 THEN SAY pen3' - BB screen is ON -'def||CR ELSE SAY pen3' - BB screen is OFF -'def||CR END callsleft: test=WORD(data.11,3) IF test<1 THEN line=pen0||bak1' Attention! 'def 'This is your last call for' DATE('W')',' DATE() 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 */ Beep (bm*20) Beep (bm*16) 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_badlogoff() IF newpassword='' THEN SIGNAL DONE ELSE SIGNAL OUT END END END CALL checkexternal() RETURN sound_badlogoff: SIGNAL OFF BREAK_C DO bp=1 TO 28 IF RIGHT(BB_VERS,4)>1.59 THEN Beep (100+bp*9) ELSE Beep (800+bp*60) END 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 INTERPRET xstring CALL SETCLIP('BBS_interpret') 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('M',xcom)>0 THEN CALL validate() IF POS('L',xcom)>0 THEN CALL uplevel() IF POS('T',xcom)>0 THEN CALL uptime() IF POS('R',xcom)>0 THEN CALL upratio() 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 'Counting GRAND total public messages online...'CR grand=0 DO i=1 TO 99 IF msg.i='' THEN ITERATE i msg.i.0=WORDS(SHOWDIR(msgpath||i,'F')) 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=19 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() IF level>sysoplevel THEN DO junk=getinput(1 1 'ReStart: (Ny) > ') IF junk~='Y' THEN SIGNAL LOGOUT END 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 ni=0 QUEUE CR RETURN 0 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 'If you didn''t press CTRL-C then... HEY! Wake up!'CR SAY 'Auto-disconnect in' TRUNC(maxidle%60+.5) 'minutes!'CR SAY 'If you DID press CTRL-C, try using CTRL-E next time instead.'CR Remote OFF Send '^G\w^G\w^G^G^G^G' Remote ON waitchar='' string='' nonstop=0 SIGNAL RESTART END CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name) SAY 'Timeout/Carrier loss -- Disconnecting.'CR Send '\d\ah' CALL sound_badlogoff() SIGNAL LOGOUT2 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: SIGNAL OFF BREAK_E 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() CALL setdir(libpath||dirs.1) OUT: SIGNAL OFF BREAK_E Remote OFF 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,'N') THEN tmin=0 IF ~DATATYPE(thour,'N') THEN thour=0 IF ~DATATYPE(dhour,'N') THEN dhour=0 IF ~DATATYPE(dmin,'N') THEN dmin=0 IF ~DATATYPE(calls,'N') 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) mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0) cals=countcheck(bbspath'Numbers/Calls' 0)+1 CALL countcheck(bbspath'Numbers/Minutes' mins) CALL countcheck(bbspath'Numbers/Calls' cals) CALL countcheck(bbspath'Usage/'ufile mmins) 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='' 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 SAY lastline||CR CALL send2last(lastline) END OUT2: CALL send2log(line) DONE: CALL send2log('') DONE2: CALL SETCLIP('BBS_minutes') CALL SETCLIP('BBS_demon') Capture IF RC~=0 THEN Capture OFF CALL SETCLIP('BBS_level') Send '\c\d\ah' Beep (bm*20) CALL DELAY(14) Remote OFF CALL DELAY(14) Beep (bm*30) baud maxbps IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN CALL DELAY(100) ELSE DO Send 'ATH1\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) END IF emailonline<0 THEN CALL countmail() bad_atz=ATZreset() /* reset modem */ IF bbsprefs.15=0 THEN /* quit or restart? */ DO 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 dcd IF RC~=0 THEN Send '\ah' wres='' Wait 'RING' wres=RESULT IF wres='RING' THEN DO Send 'ATA\r' Timeout 45 wres='' Wait 'CONNECT,NO CARRIER,RING' /* wait 45 seconds for connect */ wres=RESULT IF wres~='CONNECT' THEN SIGNAL DONE2 SAY ' 'CR CALL DELAY(28) SAY ' 'CR CALL DELAY(28) 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') CALL DELAY(114) 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 ATZreset: TimeOut 10 Send 'ATZ\r' Wait 'OK' IF RESULT='OK' THEN RETURN 0 CALL DELAY(114) Send 'ATZ\r' Wait 'OK' IF RESULT~='OK' THEN DO Send '\w\w+++\w\w\w\wATH\r' CALL yellsnd() line='*** ATZ failed to reset!' TIME('C') DATE() SAY line' Check your modem!!'CR CALL send2log(line) RETURN 1 END RETURN 0 getbaudrate: PROCEDURE TRACE OFF BaudRate brate=RC TRACE RETURN brate /* BBBBS.baud */