/* $VER: bbsLOCAL.rexx 8.3 (21.12.94) bbsLOCAL.rexx 8.3 © 1990-94 Richard Lee Stockton 21 Dec 94 1:55PM - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS - BBBBS.baud without the BaudBandit stuff Will multi-task with BBBBS.baud (within limits, see docs) THIS IS THE SYSOP'S VERSION OF BBBBS.baud FOR LOCAL USE ONLY! */ copyright.='' copyright.1=STRIP(SOURCELINE(2)) copyright.2=' Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009' copyright.3=' ARexx portions of this software copyright 1990-93 Richard Lee Stockton' copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -' /* If the QuickSortPort not found then try to run setup.rexx */ IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx() IF ~SHOW('P','QuickSortPort') THEN EXIT IF SHOW('P','BBBBS_LOCAL') THEN DO SAY 'bbsLOCAL.rexx is already running!' EXIT 0 END CALL OPENPORT('BBBBS_LOCAL') CALL SETCLIP('BBS_mainfiles') CALL SETCLIP('BBS_mainusers') PARSE VERSION . . cpu . cpu=RIGHT(cpu,2)/10 IF cpu<1 THEN cpu=1 /* BBS Directories (may be created with SETUP option) */ bbs.='' bbs.1='Information' /* text files from sysop for the user to read */ bbs.6='Scratch' bbs.7='BBS_HELP' bbs.8='rexxDoors' bbs.9='BBS_TEXT' /* text files for BBS use. WELCOME HELLO, NEW etc. */ bbs.10='FileNotes' bbs.11='BBS_LIBS' bbs.12='BBS_MSGS' bbs.13='Lists' bbs.14='Numbers' /* 1st & last messages, mail, files */ bbs.15='Usage' bbs.16='Logs' bbs.17='EMailFiles' bbs.18='EMail' bbs.19='Users' /* VARIABLES */ RESET: bbsprefs.=0 /* start with all prefs OFF */ namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-') alpha.='' lastread.=0 dirnum=1 linesperpage=20 sortuserflag=0 sortalphaflag=0 savefileflag=0 emailonline=-1 level=0 lastread.=0 totwrit.=0 lastbrowse=0 warnings=0 winnings=0 nonstop=0 libtext=1 newfilesdate='' newpassword='' replysubj='' msgdir=1 menuflag=1 logonflag=1 data.='' clr='' lineup='1B'x'M' lm='Loading Module...'lineup /* 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' text.24=' Marked Msgs' text.25='Marked Files' text.26='QUICKexclude' text.27=' CBV numbers' /* try to trap everything */ SIGNAL ON BREAK_C OPTIONS RESULTS OPTIONS FAILAT 999999 SIGNAL ON BREAK_E SIGNAL ON SYNTAX SIGNAL ON FAILURE NUMERIC DIGITS 14 ARG option . SAY CENTER(copyright.1,75) CALL config() IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon' SAY CENTER(copyright.2,75) SAY CENTER(copyright.3,75) SAY CENTER(copyright.4,75) SAY IF option='SETUP' THEN DO SAY 'Making sure all needed directories are here...' DO i=1 TO 20 IF bbs.i~='' THEN CALL MAKEDIR(bbspath||bbs.i) END END CALL colors(1) msg.='' IF readopen(bbspath'Lists/Conferences') THEN DO DO i=1 line=READLN(f) IF line='END' THEN BREAK IF EOF(f) THEN BREAK num=WORD(line,1) IF DATATYPE(num,'W') THEN msg.num=WORD(line,2) END CALL CLOSE(f) END IF option='SETUP' THEN DO DO i=1 TO 99 IF msg.i~='' THEN CALL MAKEDIR(msgpath||i) END END courtesy='' IF EXISTS(bbspath'Lists/Courtesy') THEN DO IF readopen(bbspath'Lists/Courtesy') THEN DO DO i=1 line=READLN(f) IF EOF(f) THEN BREAK courtesy=courtesy line END CALL CLOSE(f) END END dirs.='' IF readopen(bbspath'Lists/Libraries') THEN DO DO i=1 line=READLN(f) IF line='END' | EOF(f) THEN LEAVE i num=WORD(line,1) IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2)) END CALL CLOSE(f) END IF option='SETUP' THEN DO SAY 'Making sure all file library directories are here...' DO i=1 TO 99 IF dirs.i~='' THEN DO CALL MAKEDIR(libpath||dirs.i) CALL MAKEDIR(bbspath'FileNotes/'dirs.i) END END END users=0 CALL sortuserlist() SAY ' The larger the BBS gets, the longer the setup takes...' CALL loadfiles() CALL set_grand() CALL loadalpha(1) BIG_LOOP: /** Identify (title) message */ IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN DO SAY CALL showtext(bbspath'BBS_TEXT/HELLO' 0) END SAY SAY pen3'Courtesy List:'def SAY courtesy SAY /* Ask for name */ name='' DO count=1 TO 3 name=getinput(1 0 'Please enter name: ') name=SPACE(name,1,'_') IF name='NEW' THEN LEAVE count IF name~='' THEN DO IF EXISTS(bbspath'Users/'name) THEN LEAVE count IF EXISTS(bbspath'Morgue/'name'.lha') THEN DO SAY SAY name 'used to a member of this BBS.' SAY 'If that is you, you will have to resurrect yourself...' IF getinput(1 1 'Resurrect' name'? (Ny) > ')='Y' THEN DO dd=WORD(STATEF(bbspath'Morgue/'name'.lha'),5) dd=DATE(,dd,'I') SAY 'Resurrecting a dead user. Killed' dd '...' ADDRESS COMMAND 'CD' bbspath'0A'x||'lha x Morgue/'name'.lha' CALL DELETE(bbspath'Morgue/'name'.lha') CALL send2log('RESURRECTED:' name 'who was killed' dd) LEAVE count END END IF FIND(exclusion,name)>0 THEN DO SAY 'Sorry, that is a reserved name.' name='' ITERATE count END CALL loadcourtesy() IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN DO SAY SAY 'Welcome' name'!' SAY 'You will be automatically validated after you enter your user info.' SAY LEAVE count END END IF count<3 THEN DO IF STRIP(name)~='' THEN SAY name 'not found. Please try again.' SAY 'New Users enter NEW to apply for validation.' END END IF count>3 THEN SIGNAL DONE CALL checkUser() IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN DO SAY SAY 'Please help us out by entering the following information.' CALL getbirth() SAY ' Thank you!' END CALL checkclips() city=docity(data.3) CALL TIME('R') IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN DO arg=bbspath'BBS_TEXT/BIRTHDAY' IF EXISTS(arg) THEN DO SAY CALL showtext(arg 1) END SAY SAY '*** Happy Birthday,' pen3||data.1||def', and many more! ***' SAY END SAY CALL SETCLIP('BBS_LOCAL',name) IF EXISTS('rexx:bbs:LOGON.rexx') THEN CALL bbsLOGON.rexx(name level) CALL sortlibraries() CALL sortconferences() IF FIND(data.8,'QUICK')>0 THEN CALL do_quick(0) /* 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 then a simple, everyday 'WELCOME' datafile. */ IF DATE('I')>lastondate THEN DO SAY arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4) CALL showtext(arg 1) SAY arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3) CALL showtext(arg 1) SAY arg=bbspath'BBS_TEXT/WELCOME' CALL showtext(arg 1) /* Looks for files in the format LEVEL.low-high, ie "LEVEL.50-80" will only be seen by users with a level >= 50 and <= 80. */ levels.='' IF FileList(bbspath'BBS_TEXT/LEVEL.*',levels)>0 THEN DO DO ui=1 TO levels.0 p=LASTPOS('.',levels.ui) x=SUBSTR(levels.ui,p+1) PARSE VAR x lo'-'hi . IF ~DATATYPE(lo,'W') | ~DATATYPE(hi,'W') THEN ITERATE ui IF lo>level | hi0 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 tf=scratch'/TODAY' finfo=STATEF(tf) IF WORD(finfo,5)~=DATE('I') THEN ADDRESS COMMAND 'C:Today091 >'tf IF EXISTS(tf) THEN CALL showtext(tf 0) END SAY END IF SHOWDIR(bbspath'Email/'name)~='' THEN CALL readmail(0) ELSE SAY 'Your mailbox is empty.' IF ~terseflag THEN DO IF level>sysoplevel THEN DO lstmail=WORD(data.17,3) IF ~DATATYPE(lstmail,'W') THEN lstmail=0 IF countcheck('LastMail' 0)>lstmail THEN IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport() IF level<99 THEN DO SAY CALL showtext(bbspath'Email/'sysop'/NEW_FILES' 1) END SAY CALL showtext(bbspath'Lists/NEW_USERS' 1) CALL showtext(bbspath'Lists/CBV_USERS' 1) END CALL logonstats() CALL newinfo() END CALL showmarked(1) CALL setdir(libpath||dirs.1) logonflag=0 /***** MAIN *****/ IF menu~='ALL' THEN menu='MAIN' RESTART: SIGNAL ON BREAK_C SIGNAL ON BREAK_E waitchar='' string='' opt='' IF level<1 THEN menu='NEW' DO WHILE(opt~='G') go=0 DO WHILE(~go) IF waitchar='' | waitchar='?' THEN DO commands='cghiqsvwxyz!#,' IF level>0 THEN commands='abcdefghijlmnoprstuvwxyz!$#&.,+' ELSE IF SHOWDIR(bbspath'Email/'name)~='' THEN commands=commands'e' 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 menus() END ELSE SAY pen3'COMMANDS:'def commands END line='' line=line||bak2' 'TIME('C')' 'def IF menu='ALL' | menu='FILE' THEN line=line pen3'FILE_LIBRARY:'plaindir||def ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def ELSE line=line pen3'MAIN:'def line=line' 'bbsname IF waitchar='' THEN waitchar=getinput(0 0 line' > ') PARSE VAR waitchar string' 'arg nonstop=0 string=UPPER(STRIP(string)) IF clr~='' THEN SAY clr x=GETCLIP('BBS_LOCAL_MSG') IF x~='' THEN DO CALL SETCLIP('BBS_LOCAL_MSG') SAY SAY bak2' Message from BBBBS: 'def SAY x SAY CALL waiting() END IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT IF string='FL' & level>0 THEN CALL bbsFriends.rexx(name colorflag) CALL checkalias() IF LEFT(string,1)='D' THEN IF DATATYPE(SUBSTR(string,2),'W') THEN arg=SUBSTR(string,2) arg waitchar='' IF DATATYPE(string,'W') THEN DO IF string>level THEN DO arg=STRIP(string arg) string='D' END ELSE DO dirnum=string CALL chdir2() CALL since() END END IF string='QUICK' & level>0 THEN CALL do_quick(1) opt=LEFT(string,1) go=1 IF POS(opt,UPPER(commands))=0 THEN go=0 END t=bbspath'BBS_TEXT/COM.'opt IF UPPER(arg)='EDIT' THEN CALL edinfo(t,opt,'Menu Command') IF ~terseflag THEN CALL showtext(t 1) OPTIONS PROMPT 'Filename: ' SELECT WHEN opt='A' THEN CALL showalpha() WHEN opt='B' THEN CALL browse() WHEN opt='C' THEN CALL editor(name 3000 'MAIL' sysop . 0 0 'FEEDBACK') WHEN opt='D' THEN CALL dload() WHEN opt='E' THEN CALL readmail(level>0) WHEN opt='F' THEN CALL do_F() WHEN opt='H' THEN CALL help('MAIN') WHEN opt='I' THEN CALL information() WHEN opt='J' THEN CALL jump2rexx() WHEN opt='K' THEN CALL killuser() WHEN opt='L' THEN CALL list() WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG' WHEN opt='N' THEN CALL newfiles() WHEN opt='O' THEN CALL otheruser() WHEN opt='P' THEN CALL editor(name 3000 'MSG' . . 0 0) WHEN opt='R' THEN CALL readmessages() WHEN opt='S' THEN CALL bbsSEARCH() WHEN opt='U' THEN CALL uload(1) WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG' 1) 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 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 bbsProfiles.rexx(name level sysoplevel 20 1 6000 bbspath) WHEN opt=';' THEN CALL changename() WHEN opt='(' THEN CALL filereport() WHEN opt=')' THEN CALL mailreport() WHEN opt='=' THEN CALL levelreport() WHEN opt='+' THEN CALL ext_dload() WHEN opt='.' THEN menu='MAIN' WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END WHEN opt='?' & menuflag THEN CALL help('MAIN') OTHERWISE NOP END END SIGNAL LOGOUT EXIT /* FUNCTIONS */ do_F: IF menu='FILE' | menu='ALL' THEN DO IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN DO SAY SAY 'Sorry! Not enough memory left for background archiving.' SAY 'Please try again in 10 minutes or so.' SAY RETURN END DO i=0 TO libs.0 CALL SETCLIP('BBS_libs.'i,libs.i) END IF Make_BrowseList.baud(name colorflag files.0)=0 THEN IF emailonline>=0 THEN emailonline=emailonline+1 DO i=0 TO libs.0 CALL SETCLIP('BBS_libs.'i) END END ELSE IF menu~='ALL' THEN menu='FILE' RETURN cleanstring: PARSE ARG nflag':'cstr IF nflag=1 THEN DO cstr=COMPRESS(cstr,"'`") cstr=TRANSLATE(cstr,,namemask) cstr=SPACE(cstr,1,'_') RETURN cstr END bot=XRANGE(,'1F'x) IF nflag=2 THEN bot=COMPRESS(bot,'1B'x) /* ESC for ANSI */ ELSE cstr=strip_ansi(cstr) top=XRANGE('7F'x) cstr=COMPRESS(cstr,bot||top) IF nflag=0 THEN cstr=STRIP(cstr) RETURN cstr showtext: PARSE ARG starg warg . IF EXISTS(starg) THEN DO CALL readlines(starg 1) IF colorflag=0 THEN CALL strip_lynes() CALL seelines(1) IF warg THEN DO CALL waiting() nonstop=0 END END RETURN strip_lynes: DO i=1 TO lynes.0 lynes.i=strip_ansi(lynes.i) END RETURN strip_ansi: PARSE ARG aline n=POS('1B'x,aline) DO WHILE n>0 DO k=2 IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN leave k END aline=DELSTR(aline,n,k+1) n=POS('1B'x,aline) END RETURN aline doGrin: IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0 CALL setdir(bbspath'rexxDoors') temp=Grin_du_Jour.rexx() SAY RETURN temp do_quick: ARG flag . IF FIND(UPPER(data.8),'QUICK')=0 THEN DO SAY SAY 'The QUICK option is OFF in your current settings.' SAY SAY 'Setting the QUICK option to ON will allow you to tell the BBS to' SAY 'make a .lha archive of all new bbs activity since your last call.' SAY SAY 'This archive can then be read (and replied to, and files can be' SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply' SAY 'module for BBBBS, which is available here in the file libraries.' SAY IF getinput(1 1 'Turn the QUICK option ON? (Ny) > ')~='Y' THEN RETURN data.8=data.8 'QUICK' CALL saveData(0) END ELSE IF flag=1 THEN DO IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN DO temp=data.8 data.8='' DO i=1 TO WORDS(temp) IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i)) END ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?' RETURN END END IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN DO SAY SAY 'You may EXCLUDE any of these from your QUICK archives.' SAY pen3||LEFT('-',74,'-')||def temp=LEFT(' ',7) SAY temp'HELLO - Pre-logon message.' SAY temp'WELCOME - Post-logon message.' SAY temp'GOODBYE - Logoff message.' SAY temp'HOURLY - Average-Minutes-Per-Hour usage graph.' SAY temp'STATS.BBS - Most of the Z command from the main menu.' SAY temp'filename - ANY filename in the Information area.' SAY temp'MESSAGES - New conference messages.' SAY temp'FILELIST - New file descriptions.' SAY pen3||LEFT('-',74,'-')||def SAY 'Enter a space separated list of what you wish to exclude.' SAY pen3'Exclude:'def data.26 temp=getinput(1 0 pen3'Exclude: 'def) IF temp='' & data.26~='' THEN DO IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN data.26='' END ELSE data.26=temp temp='Your QUICK archives will exclude'pen3 IF data.26='' THEN temp=temp 'nothing!' ELSE temp=temp data.26 SAY temp||def CALL saveData(0) SAY END IF GETCLIP('BBS_'name)~='' THEN DO SAY SAY 'The QUICK routines are still working on your archive...' SAY 'Please try again later.' SAY RETURN END quickdir=bbspath'EmailFiles/'name CALL MAKEDIR(quickdir) CALL setdir(quickdir) qdarg=scratch'/dirlist' ADDRESS COMMAND 'C:list >'qdarg quickdir'/QUICK_#? DATES' efiles=UPPER(SHOWDIR(quickdir)) qflag=0 das=0 IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN DO das=1 DO i=1 TO WORDS(efiles) IF LEFT(WORD(efiles,i),6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN DO SAY SAY 'There is already a QUICK_xxxxx.LHA file in your mailbox...' SAY 'Activity request has been CANCELLED!' SAY das=0 LEAVE i END END END IF das=1 THEN DO CALL SETCLIP('BBS_city',city) CALL SETCLIP('BBS_'name'_26',data.26) IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0) IF FIND(UPPER(data.26),'MESSAGES')=0 THEN CALL SETCLIP('BBS_'name'_22',data.22) CALL MAKEDIR(bbspath'EmailFiles/'name) CALL showmarked(0) CALL SETCLIP('BBS_QUICKOUT_BAUD',bps) ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21 IF FIND(UPPER(data.26),'MESSAGES')=0 THEN DO clear_marked=1 DO i=1 TO level IF WORD(data.22,i)~=-1 THEN lastread.i=countcheck('LastMessage'i 0) END SAY END IF FIND(UPPER(data.26),'FILELIST')=0 THEN lastbrowse=countcheck('LastFile' 0) newfilesdate=DATE('S') TIME() IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN DO DO i=1 TO libs.0 CALL WRITELN(f,libs.i) END CALL CLOSE(f) END IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN DO DO i=1 TO msgs.0 CALL WRITELN(f,msgs.i) END CALL CLOSE(f) END SAY CALL saveData(1) qflag=1 END IF WORD(STATEF(qdarg),2)>80 THEN DO CALL showtext(qdarg 0) SAY END DO qi=1 TO WORDS(efiles) qarg=WORD(efiles,qi) IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN DO SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.' arg=qarg DO WHILE dload()=1 END t='' DO WHILE t~='N' & t~='Y' t=getinput(1 1 'Delete' qarg'? (ny) > ') END IF t='Y' THEN DO IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.' CALL DELETE(quickdir'/'qarg'.xdl') qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA') CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg) END END END arg='' IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN DO arg='QUICKIN.lha' ul=2 DO WHILE ul=2 ul=uload(0) END END IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN DO SAY SAY 'Please wait, processing QUICKIN archive...' CALL bbsQUICKIN.rexx(name level sysoplevel bbsprefs.6) CALL checkclips() CALL loaddata() SAY END IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN DO IF qflag THEN SAY 'Your archive will be waiting next time you call...' SAY SIGNAL LOGOUT2 END IF qflag THEN DO SAY SAY 'Note: You now have no ''new'' files or messages (they are being archived).' SAY CALL waiting() END RETURN killuser: ARG kname . IF level<=sysoplevel THEN RETURN CALL bbsKillUser.rexx(kname) RETURN menus: IF OPEN(f,bbspath'BBS_TEXT/MENU_'menu'.'colorflag,'R')~=0 THEN DO m=READCH(f,65000) CALL CLOSE(f) SAY m IF level>sysoplevel THEN DO SAY ' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report'def SAY ' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username'def END IF level=99 THEN SAY ' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report'def END ELSE IF menu='NEW' THEN DO SAY pen6' _________________'def SAY pen6' __/ 'pen3'New User Menu'pen6' \___'def SAY pen6' | |'def SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def SAY pen6' |'def' ['pen3'I'def']nformation 'pen6'|'def SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def SAY pen6' |'def' ['pen3'W'def']ho is here 'pen6'|'def SAY pen6' |'def' ['pen3'S'def']earch user list 'pen6'|'def SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def SAY pen6' |'def' ['pen3'X'def'] toggle menus 'pen6'|'def SAY pen6' |'def' ['pen3'#'def'] toggle color 'pen6'|'def SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def SAY pen6' |________________________|'def IF SHOWDIR(bbspath'Email/'name)~='' THEN DO SAY CR SAY 'You have unread EMail waiting!' SAY 'Enter E to read ['pen3'E'def']mail.' END END ELSE IF menu='MSG' THEN DO SAY pen6' ____________'def SAY pen6' ____/ 'pen3'Messages'pen6' \_____'def SAY pen6' | |'def SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def SAY pen6' |'def' ['pen3'P'def']ost messages 'pen6'|'def SAY pen6' |'def' ['pen3'R'def']ead messages 'pen6'|'def SAY pen6' |'def' ['pen3'S'def']earch messages 'pen6'|'def SAY pen6' |'def' ['pen3'E'def']mail (private) 'pen6'|'def SAY pen6' |'def' ['pen3'C'def']omment to SYSOP 'pen6'|'def SAY pen6' |'def' ['pen3'QUICK'def'] options 'pen6'|'def SAY pen6' |'def' ['pen3'FL'def'] Friends List 'pen6'|'def SAY pen6' |'def' ['pen3'!'def'] YELL for SYSOP 'pen6'|'def IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'^'def'] view BBS logs 'pen6'|'def SAY pen6' |'def' ['pen3')'def'] email report 'pen6'|'def SAY pen6' |'def' ['pen3'='def'] level report 'pen6'|'def SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def;END IF(level=99) THEN DO SAY pen6' |'def' ['pen3'~'def'] online editor 'pen6'|'def SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def;END SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def SAY pen6' |_______________________|'def END ELSE IF menu='FILE' THEN DO SAY pen6' _________'def SAY pen6' ______/ 'pen3'Files'pen6' \_______'def SAY pen6' | |'def SAY pen6' |'def' ['pen3'A'def']lphabetic list 'pen6'|'def SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def SAY pen6' |'def' ['pen3'B'def']rowse filenotes 'pen6'|'def SAY pen6' |'def' ['pen3'N'def']ew files list 'pen6'|'def SAY pen6' |'def' ['pen3'L'def']ist by Library 'pen6'|'def SAY pen6' |'def' ['pen3'F'def']ilelist archives 'pen6'|'def SAY pen6' |'def' ['pen3'S'def']earch files 'pen6'|'def SAY pen6' |'def' ['pen3'U'def']pload 'pen6'|'def SAY pen6' |'def' ['pen3'D'def']ownload 'pen6'|'def SAY pen6' |'def' ['pen3'+'def'] Extra Devices 'pen6'|'def IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'K'def']ill a user 'pen6'|'def SAY pen6' |'def' ['pen3'%'def'] edit filenote 'pen6'|'def SAY pen6' |'def' ['pen3'('def'] file report 'pen6'|'def SAY pen6' |'def' ['pen3';'def'] change username 'pen6'|'def;END IF(level=99) THEN SAY pen6' |'def' ['pen3'@'def'] dos shell 'pen6'|'def SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def SAY pen6' |'def' ['pen3'.'def'] main menu 'pen6'|'def SAY pen6' |________________________|'def END ELSE IF menu='MAIN' THEN DO SAY pen6' _____________'def SAY pen6' ____/ 'pen3'Main Menu'pen6' \_____'def SAY pen6' | |'def SAY pen6' |'def' ['pen3'H'def']elp 'pen6'|'def SAY pen6' |'def' ['pen3'I'def']nfomation 'pen6'|'def SAY pen6' |'def' ['pen3'J'def']ump to doorways 'pen6'|'def SAY pen6' |'def' ['pen3'Y'def']our user data 'pen6'|'def SAY pen6' |'def' ['pen3'W'def']ho is here list 'pen6'|'def SAY pen6' |'def' ['pen3'S'def']earch userlist 'pen6'|'def SAY pen6' |'def' ['pen3'O'def']ther users info 'pen6'|'def SAY pen6' |'def' ['pen3'V'def']iew user log 'pen6'|'def SAY pen6' |'def' ['pen3'X'def']pert (no menus) 'pen6'|'def SAY pen6' |'def' ['pen3'#'def'] toggle colors 'pen6'|'def SAY pen6' |'def' ['pen3'$'def'] toggle menu(s) 'pen6'|'def SAY pen6' |'def' ['pen3'&'def'] user profiles 'pen6'|'def SAY pen6' |'def' ['pen3'Z'def'] bbs statistics 'pen6'|'def SAY pen6' |'def' ['pen3','def'] hourly stats 'pen6'|'def SAY pen6' |'def' ['pen3'G'def']oodbye (hangup) 'pen6'|'def SAY pen6' |'def' ['pen3'F'def']iles menu 'pen6'|'def SAY pen6' |'def' ['pen3'M'def']essages menu 'pen6'|'def SAY pen6' |________________________|'def END ELSE IF menu='ALL' THEN DO SAY pen6' __________________________________________________________'def SAY pen6' __/ 'pen3'Main Menu File Menu Message Menu 'pen6' \__'def SAY pen6' | |'def SAY pen6' |'def' ['pen3'H'def']elp ['pen3'A'def']lphabetical list ['pen3'P'def']ost messages 'pen6'|'def SAY pen6' |'def' ['pen3'I'def']nformation ['pen3'B'def']rowse filenotes ['pen3'R'def']ead messages 'pen6'|'def SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics ['pen3'L'def']ist by Library ['pen3'E'def']mail (private) 'pen6'|'def SAY pen6' |'def' ['pen3'Y'def']our user data ['pen3'N'def']ew files ['pen3'C'def']omment to SYSOP 'pen6'|'def SAY pen6' |'def' ['pen3'O'def']ther users info ['pen3'F'def']ilelist archiver ['pen3'!'def'] YELL for SYSOP 'pen6'|'def SAY pen6' |'def' ['pen3'J'def']ump to doorways ['pen3'+'def'] Extra Devices ['pen3'X'def']pert (no menus) 'pen6'|'def SAY pen6' |'def' ['pen3'S'def']earch menu ['pen3'D'def']ownload ['pen3'$'def'] toggle menu(s) 'pen6'|'def SAY pen6' |'def' ['pen3'&'def'] user profiles ['pen3'U'def']pload ['pen3'#'def'] toggle colors 'pen6'|'def SAY pen6' |'def' ['pen3'V'def']iew user log ['pen3'T'def']ransfer protocol ['pen3','def'] hourly stats 'pen6'|'def SAY pen6' |'def' ['pen3'G'def']oodbye (logoff) ['pen3'QUICK'def'] options ['pen3'FL'def'] Friends List 'pen6'|'def IF(level>sysoplevel) THEN DO SAY pen6' |'def' ['pen3'K'def']ill a user ['pen3'%'def'] edit filenote ['pen3'='def'] level report 'pen6'|'def SAY pen6' |'def' ['pen3'^'def'] view BBS logs ['pen3'('def'] file report ['pen3';'def'] change username 'pen6'|'def;END IF(level=99) THEN SAY pen6' |'def' ['pen3'~'def'] online editor ['pen3'@'def'] dos shell ['pen3')'def'] email report 'pen6'|'def SAY pen6' |________________________________________________________________|'def END SAY RETURN help: ARG helppath . SAY SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.' IF helppath='MAIN' THEN SAY 'Commands available from the' pen3||menu||def 'menu:' 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 1) RETURN waiting: 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) RETURN waiting2: 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 pen3'To EXIT non-stop scrolling of text, press CTRL-E 'def SAY CALL DELAY(99) waitchar='' END CALL cleanline(1) IF waitchar='Q' THEN RETURN 1 RETURN 0 busywait: ARG bii bi bt IF bbsprefs.21=0 THEN RETURN IF bi<1 THEN DO CALL WRITECH(STDOUT,'080808'x) IF ni<1 & i>999998 & wi>999998 THEN SAY RETURN END IF bi=1 THEN CALL WRITECH(STDOUT,' ') IF bi//(bii%2)~=0 THEN RETURN b=bi//bii IF b=0 | b=bii%2 THEN DO tp=RIGHT((bi*100)%bt,2)'%' CALL WRITECH(STDOUT,'080808'x||tp) END RETURN cleanline: ARG lflag . IF nonstop=0 & clr~='' THEN DO SAY clr RETURN END cline=lineup||LEFT(' ',77) IF lflag=1 THEN cline=cline||lineup SAY cline RETURN getinput: PARSE ARG upflag' 'oneflag' 'pline OPTIONS PROMPT pline PARSE PULL inarg inarg=STRIP(inarg) IF upflag THEN inarg=UPPER(inarg) IF oneflag THEN inarg=LEFT(inarg,1) 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) setdir: PARSE ARG tempdir CALL PRAGMA('D',STRIP(tempdir)) directory=PRAGMA('D') 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) CALL SETCLIP('BBS_bbsname',bbsname) 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) 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) maxbps=WORD(lynes.15,1) IF ~DATATYPE(maxbps,'W') THEN maxbps=2400 CALL SETCLIP('BBS_baud',maxbps) DO i=16 TO 41 j=i-15 bbsprefs.j=STRIP(WORD(lynes.i,1)) END spellpath=WORD(lynes.9,1) IF bbsprefs.5 & ~EXISTS(spellpath) THEN DO SAY spellpath 'does not exist!' bbsprefs.5=0 END IF bbsprefs.10 THEN scratch=bbspath'Scratch' ELSE scratch='RAM:Scratch' CALL MAKEDIR(scratch) IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3 extension=WORD(lynes.32,1) arccom=lynes.33 compos=POS('/*',lynes.33) IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1) arccom=STRIP(lynes.33) IF LEFT(extension,1)~='.' THEN DO extension='.lzh' arccom='lharc -m m' END real=0 IF WORD(lynes.43,1)=1 THEN real=1 RETURN readlogs: t=getinput(1 1 'Read [D]aily, [N]umbers, or [Q]uick log? (dnq) > ') IF t='' THEN RETURN IF t='D' THEN DO 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 END ELSE IF t='N' THEN arg=bbspath'logs/QUICK.log' ELSE IF t='Q' THEN arg=bbspath'logs/Numbers.log' ELSE RETURN CALL showtext(arg 1) RETURN loadcourtesy: IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN DO IF readopen(bbspath'Lists/Courtesy') THEN DO SAY 'Checking Courtesy List...' DO i=1 line=READLN(f) IF EOF(f) THEN BREAK courtesy=courtesy UPPER(line) END CALL CLOSE(f) MSG '' MSG pen3'Courtesy List:'def MSG courtesy END END RETURN fileheader: SAY 'Filename Bytes File# Library KeyWords' SAY pen3||LEFT('=',77,'=')||def RETURN showalpha: libtext=0 IF DATATYPE(arg,'W') THEN DO dirnum=arg arg='' test='Y' IF chdir2()>0 THEN DO libtext=1 RETURN END END ELSE DO test=getinput(1 1 'Show one library only? (Ny) > ') IF test='Y' THEN DO IF chdir()>0 THEN DO libtext=1 RETURN END END END showalpha2: libtext=1 IF test='Y' THEN DO lfile=libpath||plaindir'/.'STRIP(LEFT(plaindir,15)) IF EXISTS(lfile) THEN DO CALL showtext(lfile 1) nonstop=0 RETURN END filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir)) END ELSE filecount=files.0 SAY ' 'filecount 'files.' CALL fileheader() count=0 DO wi=1 TO alpha.0 CALL busywait(60 wi alpha.0) IF test='Y' THEN DO IF count>=filecount THEN LEAVE wi IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN ITERATE wi END jj=WORD(alpha.wi,4) IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN ITERATE wi CALL busywait(4 0) SAY LEFT(alpha.wi,76) count=count+1 IF (count+2)//linesperpage=0 & wi0 THEN RETURN IF WORD(lynes.20,1)>level THEN RETURN CALL SETCLIP('BBS_oldname',cname) CALL ChangeUserName.rexx() ncname=GETCLIP('BBS_newname') IF name=cname THEN name=ncname CALL DELETE(bbspath'Lists/USERS') sortuserflag=1 CALL SETCLIP('BBS_oldname') CALL SETCLIP('BBS_newname') RETURN ncname levelreport: SAY lm CALL bbsNewUsers.rexx(name level 1 3000) RETURN filereport: SAY 'Searching for mismatches between files and filenotes...' DO i=1 TO sysoplevel+1 IF dirs.i='' THEN ITERATE SAY dirs.i' 'lineup 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 END END SAY '07'x CALL waiting() RETURN mailreport: SAY 'Checking ALL pending Email...' SAY pen3' - Use CTRL-E to Exit -'def SAY mailrep=SHOWDIR(bbspath'Email','D') mailfil=SHOWDIR(bbspath'EmailFiles','D') lastemail=WORD(data.17,3) IF ~DATATYPE(lastemail,'W') THEN lastemail=0 IF lastemail=countcheck('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) 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 1) SAY SAY IF waitchar='Q' THEN LEAVE mi END END END IF logonflag=0 & FIND(mailfil,muser)>0 THEN DO efilelist=SHOWDIR(bbspath'EmailFiles/'muser) IF WORDS(efilelist)>0 THEN DO mk=mk+1 mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist END END END data.17=WORD(data.17,1) WORD(data.17,2) countcheck('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.' DROP mailrep. mailfil. mailynes. mlist RETURN jump2rexx: arg=bbspath'BBS_TEXT/REXXDOORS' IF EXISTS(arg) THEN CALL showtext(arg 0) SAY lm CALL bbsDoors.rexx(3000 name password) RETURN sortlibraries: SAY 'Sorting Libraries...' 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 IF count>0 THEN 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 RETURN sortconferences: SAY 'Sorting Conferences...' 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 IF count>0 THEN 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 pen2'-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 RETURN readmessages: CALL SETCLIP('BBSMSG_ARG',colorflag arg) CALL bbsMsg.rexx(6000 name password) SAY lm CALL loaddata() CALL checkemail() RETURN showmarked: ARG ff . IF WORDS(data.24)<1 THEN RETURN fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:' IF ff THEN DO SAY SAY pen6||fline||def END tempkk=data.24 DO i=1 TO WORDS(tempkk) tempk=WORD(tempkk,i) PARSE VAR tempk kdir'/'kmsg line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference' IF EXISTS(msgpath||tempk) THEN DO IF ff THEN SAY line'.' ELSE fline=fline'0A'x||line'.' END ELSE DO line=line 'is missing.' IF ff THEN SAY line ELSE fline=fline'0A'x||line mkw=FIND(data.24,tempk) data.24=STRIP(DELWORD(data.24,mkw,1)) CALL savedata(0) END END IF ff THEN DO CALL waiting() SAY END ELSE DO IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN CALL WRITELN(f,fline) CALL CLOSE(f) END RETURN readmail: ARG fromenu . replysubj='' IF fromenu THEN SAY lm ELSE arg='' CALL SETCLIP('BBSMAIL_ARG',fromenu arg) CALL bbsMail.rexx(3000 name password) x=GETCLIP('LOCAL_email') CALL SETCLIP('LOCAL_email') If ~DATATYPE(x,'W') THEN RETURN IF emailonline>-1 THEN emailonline=emailonline+x CALL checkemail() RETURN checkemail: x=GETCLIP('LOCAL_email') CALL SETCLIP('LOCAL_email') If DATATYPE(x,'W') THEN IF emailonline>-1 THEN emailonline=emailonline+x RETURN countcheck: PARSE ARG fname' 'cknum' '. fname=bbspath'Numbers/'fname 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 DO CALL DELAY(99) IF ~readopen(fname) THEN RETURN cknum END retval=STRIP(READLN(f)) CALL CLOSE(f) IF ~DATATYPE(retval,'W') THEN retval=0 IF ~DATATYPE(cknum,'W') THEN cknum=0 IF retval=0 THEN emailonline=emailonline+1 END ELSE DO grand=grand+1 IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1 ELSE msg.msgdir.0=msg.msgdir.0+1 END CALL loaddata() RETURN edinfo: PARSE ARG t1,t2,t3 IF level ')='Y' THEN DO IF ~EXISTS(t) THEN DO IF writeopen(t1)~=0 THEN DO CALL WRITELN(f,TRIM(CENTER('***'pen3 t2 def||t3 '***',75))) CALL WRITELN(f,LEFT('',75,'=')) CALL CLOSE(f) CALL DELAY(28) END END CALL bbsEd.rexx(1 t1 name) arg='' RETURN 1 END RETURN 0 shell: SAY olddir=PRAGMA('D') DO WHILE(UPPER(opt)~='EXIT') SAY bak2||TIME('C')||def PRAGMA('D') OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def PARSE PULL opt' 'arg IF(UPPER(opt)='CD') THEN CALL setdir(arg) ELSE IF EXISTS(opt)~=0 THEN DO IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt) END ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN ADDRESS COMMAND opt '<* >*' arg END CALL PRAGMA('D',olddir) RETURN bbsspace: ARG tabspace . ADDRESS COMMAND 'C:info >'scratch'/locinfout' bbsdevice ok=OPEN(f,scratch'/locinfout','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 bbsk=WORD(line,4) IF ~DATATYPE(bbsk,'N') THEN DO line=bbsdevice 'is not an info compatible device!' SAY pen3||line||def 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.' RETURN comma: PROCEDURE ARG num . t='' x=POS('.',num) IF x>0 THEN t=SUBSTR(num,x) num=num%1 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||t is_here: ARG newname CALL WRITECH(STDOUT,'Checking filelist') DO wi=1 TO 99 IF wi//3=0 THEN CALL WRITECH(STDOUT,'.') IF dirs.wi='' THEN ITERATE wi IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi line=pen3'*** File' newname 'already exists here' IF wi<=level THEN line=line 'in the' dirs.wi 'library' line=line'.'def SAY line SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.' CALL waiting() RETURN 1 END CALL cleanline(1) RETURN 0 uload: ARG frommenu CALL bbsspace(12) SAY IF bbsk<1 THEN DO SAY pen3'Upload area is full!'def RETURN 1 END IF ~SHOW('P','BUILDALPHA') THEN CALL SETCLIP('BBS_UPLOAD') IF frommenu & GETCLIP('BBS_UPLOAD')~='' THEN DO SAY pen3'Uploading is temporarily suspended while the filelists are rebuilding.'def CALL waiting() RETURN 1 END IF arg='' THEN DO frompath=GETCLIP('BBS_frompath') IF frompath='' THEN frompath='RAM:' fdir='' DO loop=1 fromfile=GetFile(150,36,frompath,'',' Select File to Upload ') IF fromfile='' THEN RETURN 1 IF EXISTS(fromfile) THEN LEAVE loop SAY SAY fromfile 'does not exist!' END x=LASTPOS('/',fromfile) IF x=0 THEN x=POS(':',fromfile) IF x>0 THEN DO arg=SUBSTR(fromfile,x+1) fdir=LEFT(fromfile,x) IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1) CALL SETCLIP('BBS_frompath',fdir) END ELSE arg=fromfile END ELSE fromfile=PRAGMA('D')'/'arg arg=COMPRESS(arg,' :/,;|#?*()+[]"{}') /* be sure no illegals here */ x=LASTPOS('/',fromfile) IF x=0 THEN x=LASTPOS(':',fromfile) IF x>0 THEN DO IF DATATYPE(SUBSTR(fromfile,x+1),'W') THEN DO SAY 'Whole numbers are not allowed as filenames!' CALL waiting() RETURN 1 END END tempnum=LENGTH(arg)-16 DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 temp=' 'pen3||arg def'is'pen3 tempnum||def IF tempnum=1 THEN temp=temp 'character' ELSE temp=temp 'characters' temp=temp 'too long for a filename.' SAY temp arg=getinput(0 0 'Filename: ') arg=cleanstring('0:'arg) arg=COMPRESS(arg,' :/,;|#?*') tempnum=LENGTH(arg)-16 END IF arg='' THEN RETURN 1 IF frommenu THEN DO IF is_here(arg) THEN RETURN 1 IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops') ELSE DO SAY 'Please select an appropriate library for -' pen3||arg def'-' IF chdir()>0 THEN RETURN END END ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D')'/'arg IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN DO SAY SAY pen3'***'def arg pen3'failed archive check!'def SAY temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ') IF temp~='Y' THEN DO CALL DELETE(arg) SAY RETURN 2 END END IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0 DO ui=sysoplevel+2 TO 100 IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0 END IF frommenu THEN DO DO WHILE editnote(bbspath'FileNotes/'plaindir'/'arg) /* INSIST on a filenote */ END CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15))) END RETURN 0 findfiles: PARSE ARG ffile . IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile wi=0 IF DATATYPE(ffile,'W') THEN DO IF WORDS(files.ffile)<2 THEN RETURN 0 dirtemp=WORD(files.ffile,1) IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN DO CALL illegal_access() RETURN 0 END CALL setdir(libpath||dirtemp) END ELSE IF EXISTS(ffile) THEN DO IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN DO IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN DO line=READLN(f) CALL CLOSE(f) ffile=WORD(line,2) END END END ELSE IF EXISTS(bbspath'Information'ffile) THEN RETURN bbspath'Information/'ffile ELSE DO nextfilenum=countcheck('LastFile' 0)+1 CALL busywait(4 1) DO ni=nextfilenum TO 0 BY -1 IF ni<1 THEN DO CALL busywait(4 0) SAY '***' files.0 'filenames scanned,'pen3 ffile def'was not found!' RETURN 0 END IF ni>1 THEN CALL busywait(60 ni nextfilenum) argtemp=WORD(files.ni,2) IF UPPER(argtemp)=UPPER(ffile) THEN DO dirtemp=WORD(files.ni,1) jj=files.ni.0 IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN DO CALL busywait(4 0) CALL illegal_access() RETURN 0 END ffile=ni CALL setdir(libpath||dirtemp) LEAVE ni END END CALL busywait(4 0) END IF wi=999999 THEN RETURN 0 ftemp=ffile IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2) IF ~EXISTS(ftemp) THEN DO finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp) IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8) IF ~EXISTS(ftemp) THEN DO IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!' ELSE DO SAY SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.' SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.' SAY END RETURN 0 END END RETURN ffile illegal_access: SAY SAY '*** You are not authorized to access' ffile'!' SAY '*** Send Email to' sysop 'to receive a higher level.' SAY RETURN ext_dload: SAY arg=bbsExtDL.baud(name level 3000 linesperpage colorflag extdevs) IF arg~='' THEN SAY 'Sorry, LOCAL mode cannot download from the Extra Devices.' RETURN dload: arg=STRIP(arg data.25) data.25='' errorflag=0 curdir=PRAGMA('D') OPTIONS PROMPT 'File numbers (and/or names): ' IF arg='' THEN PARSE PULL arg /* no filename given */ IF arg='' THEN RETURN 0 IF findfiles(arg)=0 THEN RETURN 0 arg=TRANSLATE(arg,' ',':/,;|') IF WORDS(arg)>1 THEN arg=WORD(arg,1) IF DATATYPE(arg,'W') THEN DO CALL setdir(libpath||WORD(files.arg,1)) arg=WORD(files.arg,2) END IF arg~='' THEN /* check for filename */ DO dloadloop=1 frompath=GETCLIP('BBS_frompath') IF frompath='' THEN frompath=libpath'SysOps/' notename=bbspath'FileNotes/'plaindir'/'arg 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 topath=PRAGMA('D') num=LASTPOS('/',arg) IF num=0 THEN num=LASTPOS(':',arg) IF num>0 THEN DO topath=LEFT(arg,num) arg=SUBSTR(arg,num+1) END IF RIGHT(topath,1)~=':' & RIGHT(topath,1)~='/' THEN topath=topath'/' SAY ' Select Filename to Copy ' topath||arg 'To:' tofile=GetFile(150,36,frompath,arg,' Select Destination Name ') IF tofile='' THEN DO errorflag=1 LEAVE dloadloop END ADDRESS COMMAND 'C:Copy' topath||arg tofile CALL SETCLIP('BBS_frompath',WORD(lastslash(tofile),2)) IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN LEAVE dloadloop DO di=sysoplevel+2 TO 100 IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop END IF readlines(notename 1) THEN LEAVE dloadloop dls=WORD(lynes.2,7) IF ~DATATYPE(dls,'W') THEN dls=0 lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1 finfo=STATEF(notename) IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8)) ELSE finfo='' CALL DELETE(notename) CALL savelines(notename) CALL DELAY(28) IF finfo~='' THEN ADDRESS COMMAND 'C:FileNote' notename finfo LEAVE dloadloop END CALL setdir(curdir) IF errorflag THEN SAY pen3'*** Download Failed!'def RETURN errorflag lastslash: PARSE ARG sarg sdir='' slash=LASTPOS('/',sarg) IF slash>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) fromarg=arg fromdir=GETCLIP('BBS_frompath') IF WORDS(finfo)>7 THEN DO temp='Y' fromdir=WORD(finfo,8) fromdir=lastslash(fromdir) fromarg=WORD(fromdir,1) fromdir=WORD(fromdir,2) END ELSE DO IF level0 THEN DO filedir=LEFT(arg,slash-1) filedir=SUBSTR(filedir,5) arg=SUBSTR(arg,slash+1) END ELSE filedir=plaindir CALL MAKEDIR(bbspath'FileNotes/'filedir) IF ~EXISTS(bbspath'FileNotes/'filedir) THEN DO SAY pen3'*** Failed to open directory!' filedir||def RETURN 0 END notename=bbspath'FileNotes/'filedir'/'arg lynes.='' filenum=countcheck('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.rexx(firstedit notename name) CALL checkfilechanges() RETURN 0 END IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg) ELSE filedata=STATEF(comment) IF filedata='' THEN DO IF comment='' THEN line=filedir'/'arg ELSE line=comment SAY line 'does not exist!' RETURN 0 END bytes=WORD(filedata,2) filenum=filenum+1 lynes.0=4 lynes.1='File: 'LEFT(filenum,5)' KeyWords:' lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes Downloads: 0' lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')' Lib: 'filedir lynes.4=LEFT('',74,'=') lynes.1=lynes.1 edkeywords(arg filedir) diz='RAM:file_id.diz' IF EXISTS(diz) THEN CALL readlines(diz 5) CALL DELETE(diz) CALL seelines(1) edtype='' CALL writebuffer(scratch'/NoteLOCAL') IF savelines(notename) THEN RETURN 0 IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment CALL DELETE(libpath||filedir'/.'STRIP(LEFT(filedir,15))) 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..' CALL DELETE(notename) RETURN 1 END ELSE IF fncom='E' THEN DO IF bbsEd.rexx(firstedit notename name)>0 THEN RETURN 0 CALL readlines(notename 1) CALL checkfilechanges() fncom='R' END ELSE IF fncom~='R' THEN DO SAY 'Adjusting filelist...' IF filenum<1 THEN filenum=1 IF GETCLIP('BBS_level')~='' THEN CALL SETCLIP('BBS_localfiles',1) CALL countcheck('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=listOPEN(f,bbspath'Lists/Files','A') ELSE x=listOPEN(f,bbspath'Lists/Files','W') IF x=0 THEN DO SAY '*** Failed to open' bbspath'Lists/Files' savefileflag=1 RETURN 0 END CALL WRITELN(f,filenum files.filenum) CALL CLOSE(f) IF EXISTS(bbspath'Lists/Files.ALPHA') THEN x=listOPEN(f,bbspath'Lists/Files.ALPHA','A') ELSE x=listOPEN(f,bbspath'Lists/Files.ALPHA','W') IF x=0 THEN DO SAY '*** Failed to open' bbspath'Lists/Files.ALPHA' RETURN 0 END CALL WRITELN(f,alpha.newcount) CALL CLOSE(f) sortalphaflag=1 END END RETURN 0 checkfilechanges: x=GETCLIP('BBS_FileChange') CALL SETCLIP('BBS_FileChange') DO ii=1 TO WORDS(x) fnum=WORD(x,ii) keywords=GETCLIP('BBS_Keywords_'fnum) CALL SETCLIP('BBS_Keywords_'fnum) num=files.fnum.0 alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32)) sortalphaflag=1 END RETURN edkeywords: PARSE ARG kwarg templine='' DO WHILE LENGTH(templine)<3 SAY SAY pen3'Please enter a list of keywords (or a condensed description)'def SAY pen3'to be used in the alphabetic list and by the search routine.'def SAY ' Note that only the first 32 characters will be used.' SAY LEFT('',43)'|'LEFT('',31,'=')'|' templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def) templine=cleanstring('0:'templine) templine=STRIP(LEFT(templine,32)) SAY END RETURN templine loadfiles: SAY def IF ~listOPEN(f,bbspath'Lists/Files','R') THEN RETURN SAY 'Loading filelist...' files.='' files.0=0 DO i=1 line=READLN(f) IF EOF(f) THEN BREAK num=WORD(line,1) IF DATATYPE(num,'W') THEN DO IF num<100 THEN IF LEFT(WORD(line,3),1)~='.' THEN DO CALL CLOSE(f) SAY SAY 'Your filelists need to be renumbered, running bbsUPDATE.rexx...' CALL bbsUPDATE.rexx() SIGNAL RESET END files.num=WORD(line,2) WORD(line,3) END END files.0=i-1 CALL CLOSE(f) RETURN savefilelist: IF level=99 THEN IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN savefilelist2: SIGNAL OFF BREAK_E CALL savealphalist() filenum=countcheck('LastFile' 0) IF filenum<1 THEN DO IF files.0>0 THEN filenum=files.0 ELSE RETURN END xarg=bbspath'Lists/Files' IF ~listOPEN(f,xarg,'W') THEN RETURN SAY 'Saving filelist...' savefileflag=0 DO i=1 TO filenum IF files.i~='' THEN CALL WRITELN(f,i files.i) END CALL CLOSE(f) IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2) RETURN loadalpha: ARG alflag SAY def IF alflag THEN CALL checkliblists() IF liblist='' THEN alflag=0 IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','R') THEN RETURN SAY 'Loading the alphabetical filelist...' alpha.='' alpha.0=0 DO i=1 line=READLN(f) IF EOF(f) THEN LEAVE i fnum=WORD(line,3) IF DATATYPE(fnum,'W') THEN DO alpha.i=line files.fnum.0=i IF alflag THEN CALL updateliblists() END ELSE i=i-1 END CALL CLOSE(f) tf=bbspath'Lists/Files.ALPHA.add' IF EXISTS(tf) & ~SHOW('P','BBSFILE') THEN IF readopen(tf) THEN DO DO i=i line=READLN(f) IF EOF(f) THEN LEAVE i fnum=WORD(line,3) IF DATATYPE(fnum,'W') THEN DO alpha.i=line files.fnum.0=i END ELSE i=i-1 IF alflag THEN CALL updateliblists() END CALL CLOSE(f) CALL DELETE(tf) CALL SETCLIP('BBS_resave_local',1) END alpha.0=i-1 IF alflag THEN CALL closeliblists() DO i=1 TO 99 IF dirs.i='' THEN ITERATE i dname='.'STRIP(LEFT(dirs.i,15)) IF files.i='' THEN DO files.i=dirs.i dname files.0=files.0+1 END sz=WORD(STATEF(libpath||dirs.i'/'dname),2) IF ~DATATYPE(sz,'W') THEN sz=0 x=files.i.0 IF ~DATATYPE(x,'W') THEN DO x=alpha.0+1 files.i.0=x alpha.0=x CALL SETCLIP('BBS_resave_local',1) CALL DELETE(libpath||dirs.i'/'dname) END alpha.x=LEFT(dname,22-LENGTH(sz)) sz RIGHT(i,5) RIGHT(i,2) alpha.x=alpha.x LEFT(dirs.i,12) 'alphabetical files list CONTENTS' END IF GETCLIP('BBS_resave_local')=1 THEN DO CALL SETCLIP('BBS_resave_local') sortalphaflag=1 CALL savefilelist2() END SAY RETURN savealphalist: SIGNAL OFF BREAK_E IF GETCLIP('BBS_mainfiles')~='' THEN DO CALL SETCLIP('BBS_mainfiles') CALL loadfiles() CALL loadalpha(0) END CALL checkliblists() IF sortalphaflag=1 THEN DO SAY 'Alphabetizing' alpha.0 'files...' IF alpha.0>0 THEN 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 files.100~='' THEN DO sz=WORD(STATEF(libpath||WORD(files.100,1)'/'WORD(files.100,2)),2) IF DATATYPE(sz,'W') THEN DO anum=files.100.0 alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7) END END IF files.101~='' THEN DO sz=WORD(STATEF(libpath||WORD(files.101,1)'/'WORD(files.101,2)),2) IF DATATYPE(sz,'W') THEN DO anum=files.101.0 alpha.anum=OVERLAY(RIGHT(sz,7),alpha.anum,17,7) END END IF ~listOPEN(f,bbspath'Lists/Files.ALPHA','W') THEN RETURN SAY 'Saving alphabetical filelists...' 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 ITERATE i CALL WRITELN(f,alpha.i) IF liblist~='' THEN CALL updateliblists() END CALL CLOSE(f) CALL closeliblists() CALL bbsALPHA.rexx(files.0 SUBSTR(extension,2) arccom) DO i=0 TO 1 t=GETCLIP('BBS_10'i) IF t='' THEN ITERATE i CALL SETCLIP('BBS_10'i) num=100+i files.num=TRANSLATE(t,,'/') files.0=files.0+1 x=alpha.0+1 files.num.0=x alpha.0=x sz=WORD(STATEF(libpath||t),2) IF ~DATATYPE(sz,'W') THEN sz=0 dnum=finddirnum(WORD(files.num,1)) alpha.x=LEFT(WORD(files.num,2),22-LENGTH(sz)) sz ' 'num RIGHT(dnum,2) alpha.x=alpha.x LEFT(dirs.dnum,12) IF i THEN alpha.x=alpha.x 'alphabetical files list CONTENTS' ELSE alpha.x=alpha.x 'alphabetical by library CONTENTS' SAY 'Added file' num t 'to the filelists.' SAY 'Must now resort and resave.' CALL SETCLIP('BBS_resave_local',1) END RETURN listOPEN: PARSE ARG fh,listfile,flag DO i=0 TO 59 WHILE OPEN(fh,listfile,flag)=0 IF i//4=0 THEN SAY 'Waiting' (60-i)*5 'more seconds for' listfile 'to become available...' CALL DELAY(250) END IF i>59 THEN DO SAY '*** unable to access' listfile 'list.' RETURN 0 END RETURN 1 checkliblists: SAY 'Checking individual library filelists...' liblist='' lastlib=0 cnt.=0 DO i=1 TO 99 IF dirs.i='' THEN ITERATE i finfo=STATEF(libpath||dirs.i'/.'STRIP(LEFT(dirs.i,15))) IF finfo='' THEN liblist=liblist i ELSE DO sz=WORD(finfo,2) num=files.i.0 IF DATATYPE(num,'W') THEN alpha.num=OVERLAY(RIGHT(sz,7),alpha.num,17,7) END END liblist=STRIP(liblist) DO j=1 TO WORDS(liblist) tt=WORD(liblist,j) CALL MAKEDIR(libpath||dirs.tt) lf1=libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)) flg='W' IF EXISTS(libpath||dirs.tt'.txt') THEN DO ADDRESS COMMAND 'COPY' libpath||dirs.tt'.txt' lf1 flg='A' END IF listOPEN(f,lf1,flg)=0 THEN ITERATE j IF flg='A' THEN CALL WRITELN(f,'') CALL WRITELN(f,'Filename Bytes File# Library KeyWords') CALL WRITELN(f,LEFT('=',77,'=')) CALL CLOSE(f) END RETURN updateliblists: x=FIND(liblist,WORD(alpha.i,4)) IF x=0 THEN RETURN tt=WORD(liblist,x) IF tt~=lastlib THEN DO CALL CLOSE(a) lastlib=tt x=OPEN(a,libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15)),'A') IF x=0 THEN DO lastlib=0 RETURN END END CALL WRITELN(a,alpha.i) cnt.tt=cnt.tt+1 RETURN closeliblists: CALL CLOSE(a) DO i=1 TO WORDS(liblist) tt=WORD(liblist,i) dname='.'STRIP(LEFT(dirs.tt,15)) SAY ' 'dname x=OPEN(f,libpath||dirs.tt'/'dname,'A') IF x~=0 THEN DO CALL WRITELN(f,LEFT('-',77,'-')) temp='file' IF cnt.tt~=1 THEN temp=temp's' temp=cnt.tt temp'. Last updated' DATE() 'at' TIME('C') temp=temp RIGHT(bbsname,76-LENGTH(temp)) CALL WRITELN(f,temp) CALL CLOSE(f) END CALL MAKEDIR(bbspath'FileNotes/'dirs.tt) fnote=bbspath'FileNotes/'dirs.tt'/'dname lynes.='' lynes.0=5 x=OPEN(f,fnote,'R') IF x=0 THEN CALL SETCLIP('BBS_resave_local',1) ELSE DO DO k=1 line=READLN(f) IF EOF(f) THEN LEAVE k lynes.k=line END CALL CLOSE(f) lynes.0=k-1 END finfo=STATEF(libpath||dirs.tt'/.'STRIP(LEFT(dirs.tt,15))) bt=WORD(finfo,2) dl=WORD(lynes.2,7) IF ~DATATYPE(dl,'W') THEN dl=0 lynes.1='File: 'LEFT(tt,5)' KeyWords: alphabetical files list CONTENTS' lynes.2='Name: 'LEFT(dname,27)' Size:' bt 'bytes Downloads:' dl lynes.3='From: 'LEFT('BBBBS',27)' Date: 'DATE() TIME('C')' Lib: 'dirs.tt lynes.4=LEFT('',74,'=') IF lynes.5='' THEN lynes.5='Up to the minute alphabetical filelist of the' dirs.tt 'library.' IF writeopen(fnote) THEN DO DO k=1 TO lynes.0 CALL WRITELN(f,lynes.k) END CALL CLOSE(f) SAY LEFT(' ',LENGTH(dname)+2)'1B'x'Mupdated.' END END RETURN viewuser: SAY SAY bak2' 'name' 'def 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 END CALL waiting() RETURN edituser: IF level>0 THEN IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN DO SAY SAY pen3' - Message Conference Access -'def SAY '[O]ff turns all message conferences OFF.' SAY '[R]eset lets you Reset to ''x'' number of messages back.' SAY 'Set the last message read by you in ALL message conferences' temp=getinput(1 1 ' ['pen3'F'def']irst ['pen3'L'def']ast ['pen3'O'def']ff ['pen3'R'def']eset ['pen3'Q'def']uit (florQ) > ') IF POS(temp,'FLOR')=0 THEN RETURN back=0 IF temp='R' THEN back=getnumber('Set each conference pointer back how many messages?') SAY 'Resetting...'lineup data.22='' DO i=1 TO level IF temp='F' THEN num=0 ELSE IF temp='O' THEN num=-1 ELSE DO num=countcheck('LastMessage'i 0)-back IF num<1 THEN num=0 END data.22=data.22 num END CALL setdata() CALL sortconferences() CALL savedata(1) RETURN END new=0 change=0 edata.='' edname=name DO i=0 TO data.0 edata.i=data.i END num=1 DO WHILE num~='' | edname~=name IF num='' | LEFT(num,1)='Q' THEN DO IF change THEN DO CALL setdata() CALL saveData(1) change=0 END IF new THEN DO data.='' DO i=0 TO edata.0 data.i=edata.i END name=edname new=0 END CALL setdata() END maxnum=10 IF edata.20>sysoplevel THEN maxnum=20 IF edata.20=99 THEN maxnum=27 SAY bak2' 'name' 'def 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 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 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 CALL showtext(nufile 0) savename=name name=getinput(1 0 'New User Name: 'def) name=SPACE(name,1,'_') name=COMPRESS(name,':/*#?^') IF loaddata()=0 THEN name=savename IF data.20>=edata.20 THEN DO SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.' name=savename CALL loaddata() END END ELSE IF DATATYPE(num,'W') & num>0 THEN DO IF num>maxnum THEN DO SAY SAY pen3'You are not authorized to change that information!'def SAY END ELSE DO dummy=1 TO 1 IF num=8 THEN DO SAY SAY 'Use spaces to seperate options.' SAY 'If the option word is in line 8, it is ON.' SAY 'Valid Options:' SAY ' CLEAR clears screen between pages.' SAY ' COLOR turns ANSI color codes ON.' SAY ' MENU combines all main commands into 1 menu.' SAY ' MENUS splits main commands into 3 menus.' SAY ' PHONE makes your phone number public.' SAY ' QUICK activates offline options. See bbsQUICK.DOC' SAY ' STREET makes your street address public.' SAY ' TERSE skips some of the logon procedures.' SAY END line=RIGHT(num,2)||pen3 text.num||def': ' SAY line||data.num temp=getinput(0 0 line) IF temp='' THEN DO IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy END IF num=5 | num=8 THEN temp=UPPER(temp) IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN temp=data.20 IF edata.20>sysoplevel & name~=edname THEN line2=name' ' ELSE line2='' IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy line=text.num':' data.num pen6'CHANGED TO'def temp data.num=temp SAY line SAY change=1 END END END IF change THEN DO CALL setdata() CALL saveData(1) END RETURN setmsgs: IF ~DATATYPE(bbsprefs.25,'W') THEN RETURN data.22='' data.23='' SAY line='Setting message counters to last' IF bbsprefs.25>1 THEN line=line bbsprefs.25 'messages' ELSE line=line 'message' line=line 'in each conference...' SAY line DO i=1 TO level num=countcheck('LastMessage'i 0)-bbsprefs.25 IF num<0 | msg.i.0 ') mask=COMPRESS(XRANGE(),'0123456789') tnum=COMPRESS(tnum,mask) IF ~DATATYPE(tnum,'W') THEN tnum=0 tnum=tnum%1 IF tnum>0 & tnum<10 THEN tnum='0'tnum RETURN tnum getbirth: data.12=WORD(data.12,1)' 'WORD(data.12,2)' Birthday:' SAY pen3'Birthday Information:'def month=getnumber('Please enter the MONTH you were born: (1-12)') day=getnumber('Please enter the DAY you were born: (1-31)') year=getnumber('Please enter the YEAR you were born: ') IF year<100 THEN year=year+1900 born=year||month||day IF born<18750101 | born>(DATE('S')-50000) THEN 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: nonstop=0 CALL showuserlist() SAY waitchar='Q' CALL showtext(bbspath'BBS_TEXT/NEW_USER_NAME' 1) pline='Your name on'pen3 bbsname def'will be > ' name=getinput(1 0 pline) name=cleanstring(1':'name) IF name='' THEN DO SAY 'No name, no entry. Bye!' SIGNAL DONE END IF EXISTS(bbspath'Users/'name) | FIND(exclusion,name)>0 THEN DO SAY 'Sorry! That name is taken. Please try again.' RETURN 1 END IF getinput(1 1 'Your name on'pen3 bbsname def'will be >' name', is that correct? (nY) > ')='N' THEN RETURN 1 RETURN 0 /** see if name is in data */ checkUser: tries=0 IF name='NEW' THEN DO name='' DO WHILE getname() END END IF ~EXISTS(bbspath'Users/'name) THEN DO IF EXISTS(bbspath'BBS_TEXT/NEW') THEN DO nonstop=0 CALL showtext(bbspath'BBS_TEXT/NEW' 1) END SAY 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.' 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.' IF readlines(defile 1) THEN SIGNAL DONE data.='' data.0=27 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') DO i=60 TO 2 BY -1 SAY RIGHT('- 'i' -',14) END data.7=getinput(1 0 'What number is now at the top of your screen? > ') IF data.7<17 | data.7>75 THEN data.7=20 SAY 'Please enter the password you would like to use here.' data.5=getinput(1 0 'Enter Password: ') DO WHILE getinput(1 1 'Your password on' bbsname 'will be :' data.5 ', is that correct? (nY) > ')='N' data.5=getinput(1 0 'Enter Password: ') END 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 (real) Name: ') IF data.1='' THEN SAY 'You MUST leave your real name!' 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 'Voice Phone (including areacode): ') IF data.4='' THEN SAY sysop 'MUST be able to reach you by phone to validate you!' END CALL getbirth() IF bbsprefs.8 THEN DO newufile=bbspath'Lists/NEW_USERS' IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A') ELSE DO ok=OPEN(f,newufile,'W') IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***') END IF ok~=0 THEN DO temp=RIGHT(TIME('C'),7) COMPRESS(DATE()) temp=temp LEFT(name,24)'=' data.1' 'data.4 CALL WRITELN(f,temp) END CALL CLOSE(f) END data.9=getinput(0 0 'Computer: ') data.10=getinput(0 0 'Interests: ') test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def) IF test='Y' THEN data.8=data.8 'STREET' test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def) IF test='Y' THEN data.8=data.8 'PHONE' IF bbsprefs.7>0 THEN DO data.20=bbsprefs.7 CALL do_eleven(60 bbsprefs.16 bbsprefs.16-1) END SAY CALL setdata() IF data.20=0 THEN SAY 'Thank you, the sysop will give you higher access soon.' ELSE CALL setmsgs() SAY SAY 'Please feel free to leave additional info by using [C]omment.' SAY CALL saveData(1) SAY 'Adding' name 'to the user list...' newpassword=data.5 sortuserflag=1 temp=countcheck('Users' 0)+1 CALL countcheck('Users' temp) CALL DELETE(bbspath'Lists/USERS') END ELSE DO IF loaddata()=0 THEN SIGNAL DONE city=docity(data.3) PARSE VAR data.11 amins . . . ttimes . . . atimes . lastondate=DATE('I',WORD(data.13,1),'S') lastontime=WORD(data.13,2) IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=ttimes IF level=99 THEN amins=120 data.13=DATE('S')' 'TIME() CALL do_eleven(amins ttimes atimes-1) passprompt='Enter Password: ' DO tries=1 TO 3 OPTIONS PROMPT passprompt PULL newpassword SAY '' IF(password=newpassword) THEN LEAVE tries; /* correct password */ IF tries=3 THEN DO SAY SAY 'Access terminated.' line='*** Bad password ***' newpassword '***' SAY line SIGNAL OUT2 END SAY lineup' ' passprompt='Incorrect. Password: ' /* ask again */ END END CALL DELAY(14) SAY RETURN do_eleven: ARG am tc at . data.11=am 'minutes per call,' tc 'calls per day,' data.11=data.11 at 'more calls today' RETURN saveData: ARG messflag . IF data.5='' THEN RETURN SAY 'Updating... 'lineup IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate ELSE IF lastbrowse>0 THEN DO IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1) ELSE data.16=DATE('S') TIME() data.16=lastbrowse data.16 END IF messflag THEN DO userexclude.=0 DO si=1 TO WORDS(data.22) IF WORD(data.22,si)=-1 THEN userexclude.si=1 END data.22='' data.23='' DO si=1 TO level IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0 IF userexclude.si THEN data.22=data.22 '-1' ELSE data.22=data.22 lastread.si IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0 data.23=data.23 totwrit.si END END IF writeopen(bbspath'USERS/'name)=0 THEN RETURN IF data.0<27 THEN data.0=27 DO i=1 TO data.0 CALL WRITELN(f,data.i) END CALL CLOSE(f) SAY 'User' name 'has been updated.' RETURN loaddata: IF name='' THEN RETURN 0 IF ~readopen(bbspath'USERS/'name) THEN RETURN 0 data.='' DO i=1 line=READLN(f) IF EOF(f) THEN BREAK data.i=line END data.0=i-1 CALL CLOSE(f) winnings=WORD(data.18,1) IF ~DATATYPE(winnings,'N') THEN winnings=0 setdata: IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00' lastbrowse=WORD(data.16,1) IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0 level=data.20 DO i=1 TO level lastread.i=WORD(data.22,i) IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0 totwrit.i=WORD(data.23,i) IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0 END password=data.5 IF ~DATATYPE(data.7,'W') THEN data.7=20 IF data.7<5 THEN data.7=5 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) IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x ELSE clr='' 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' IF DATATYPE(WORD(data.11,3),'W') THEN DO PARSE VAR data.11 amins . atimes . CALL do_eleven(amins bbsprefs.16 atimes) END data.21=UPPER(data.21) CALL MAKEDIR(bbspath'Friends') alias.='' alias.0=0 realname.='' CALL CLOSE(f) IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1 DO i=1 line=READLN(f) IF EOF(f) THEN LEAVE i alias.i=WORD(line,1) realname.i=WORD(line,2) END alias.0=i-1 CALL CLOSE(f) RETURN 1 switchmenuflag: IF menuflag=1 THEN DO menuflag=0 noff='OFF' END ELSE DO menuflag=1 noff='ON' END SAY 'Menus turned' pen3||noff||def'.' SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.' 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'.' SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.' RETURN /* ANSI pen color codes */ colors: ARG onoff IF onoff THEN DO 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=''; END RETURN sortinfofiles: infolist=SHOWDIR(bbspath'Information') IF infolist='' THEN DO SAY SAY pen3'No files are currently in the Information drawer.'def SAY RETURN 1 END IF ~DATATYPE(sortinfo.0,'W') THEN DO info.='' sortinfo.='' info.0=WORDS(infolist) DO i=1 TO info.0 info.i=WORD(infolist,i) END SAY 'Sorting..' IF info.0>0 THEN 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 END RETURN 0 information: IF sortinfofiles() THEN RETURN SAY pen3'These text files are available for reading online...'def 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) END SAY pen3||LEFT('-',75,'-')||def DO i=1 TO sortinfo.0 IF num=0 THEN SAY sortinfo.i.0 ELSE SAY sortinfo.i END SAY pen3||LEFT('-',75,'-')||def IF num=0 THEN DO CALL waiting() num=1 ITERATE infoloop END num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def) IF num=0 THEN ITERATE infoloop IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN readcount=STATEF(bbspath'Information/'info.num) readbytes=WORD(readcount,2) SAY ' 'info.num 'is' readbytes 'bytes.' SAY 'Loading File...' CALL Increment.rexx(bbspath'Information/'info.num) CALL readlines(bbspath'Information/'info.num 1) CALL cleanline(0) SAY ' 'lynes.0 'lines.' CALL seelines(0) IF waitchar~='Q' THEN CALL waiting() nonstop=0 END RETURN newfiles: SAY 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)'...' lastbrowz=WORD(data.16,1) lastfile=countcheck('LastFile' 0) newfiles2: IF lastbrowz>=lastfile THEN DO lastbrowz=0 SAY pen3'No new files. Listing backwards by date from last file uploaded...'def END ELSE newfilesflag=1 j=0 IF test='Y' THEN DO filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))-1 CALL busywait(4 1) END DO ni=lastfile TO lastbrowz+1 BY -1 IF files.ni~='' THEN DO IF test='Y' THEN DO IF ni>1 THEN CALL busywait(60 ni lastfile-lastbrowz) IF j>=filecount THEN LEAVE ni IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN ITERATE ni END jj=files.ni.0 IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN ITERATE ni /* unauthorized */ IF test='Y' THEN CALL busywait(4 0) j=j+1 IF j=1 THEN CALL fileheader() SAY LEFT(alpha.jj,76) IF (j+2)//(linesperpage-1)=0 THEN IF waiting2() THEN LEAVE ni IF test='Y' THEN CALL busywait(4 1) END END IF test='Y' THEN CALL busywait(4 0) IF j//linesperpage~=0 THEN CALL waiting() IF j=0 & newfilesflag=1 THEN DO lastbrowz=999999 newfilesflag=0 CALL newfiles2() END IF test~='Y' THEN DO CALL newinfo() IF lynes.0>0 THEN CALL waiting() END nonstop=0 RETURN newinfo: lynes.='' lynes.0=0 dm=DATE(,WORD(data.16,2),'S') PARSE VAR dm da' 'mo' 'yr . yr=RIGHT(yr,2) sincedate=da'-'mo'-'yr startline=1 arg=bbspath'Information' IF WORD(STATEF(arg),5)>lastondate THEN DO ADDRESS COMMAND 'C:LIST >'scratch'/locdirlist' arg 'NOHEAD DATES SINCE' sincedate IF WORD(STATEF(scratch'/locdirlist'),2)>3 THEN DO lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def CALL readlines(scratch'/locdirlist' startline+1) END END arg=bbspath'Profiles' IF level>0 & WORD(STATEF(arg),5)>lastondate THEN DO ADDRESS COMMAND 'C:LIST >'scratch'/locdirlist' arg 'NOHEAD DATES SINCE' sincedate IF WORD(STATEF(scratch'/locdirlist'),2)>3 THEN DO startline=lynes.0+2 lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def CALL readlines(scratch'/locdirlist' startline+1) END END arg=bbspath'rexxDoors/Data/Polls' IF level>0 & WORD(STATEF(arg),5)>lastondate THEN DO startline=lynes.0+2 lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def lynes.0=startline END IF logonflag=1 THEN nonstop=1 IF lynes.0>0 THEN CALL seelines(1) nonstop=0 RETURN chdir: string='' SAY pen3||LEFT('-',75,'-')||def DO i=1 TO libs.0 SAY libs.i END SAY pen3||LEFT('-',75,'-')||def dirnum=getinput(1 0 pen3'Select Library Number: 'def) IF clr~='' THEN SAY clr IF ~DATATYPE(dirnum,'W') THEN DO waitchar=dirnum RETURN 2 END chdir2: IF dirnum<1 | dirnum>99 THEN DO waitchar=dirnum RETURN 1 END IF dirs.dirnum='' THEN DO SAY pen3'That library number is currently un-assigned.'def 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 RETURN 1 END td=libpath||dirs.dirnum CALL MAKEDIR(td) CALL setdir(td) IF libtext=0 THEN IF EXISTS(td'/.'STRIP(LEFT(dirs.dirnum,15))) THEN RETURN 0 t=libpath||plaindir'.txt' IF terseflag | ~EXISTS(t) THEN RETURN 0 nonstop=1 SAY CALL showtext(t 0) SAY RETURN 0 since: dm=DATE(,WORD(data.16,2),'S') SAY SAY 'New files or files moved since' dm CALL listsince() CALL showtext(scratch'/locdirlist' 1) 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 >'scratch'/locdirlist' directory 'DATES SINCE' sincedate RETURN list: onetime=0 IF DATATYPE(arg,'W') THEN onetime=1 ELSE arg='' DO listloop=1 IF DATATYPE(arg,'W') THEN DO dirnum=arg arg='' IF chdir2()>0 THEN RETURN CALL listsimple() IF waitchar='Q' | onetime THEN LEAVE listloop END ELSE IF arg='' THEN DO libtext=0 IF chdir()>0 THEN DO libtext=1 RETURN END test='Y' CALL showalpha2() arg='' IF waitchar='Q' THEN waitchar='' IF waitchar~='' THEN RETURN ITERATE listloop END ELSE RETURN END RETURN listsimple: ADDRESS COMMAND 'C:list >'scratch'/locdirlist' directory 'DATES' IF readlines(scratch'/locdirlist' 1) THEN RETURN IF lynes.0>3 THEN DO SAY pen3'Sorting...'def||lineup linesave=lynes.1 /* these 4 lines put in to leave dir title at top */ lynes.1='0' IF lynes.0>1 THEN 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 lastfile=countcheck('LastFile' 0) IF lastfile<1 THEN RETURN onearg=0 IF arg='' THEN DO lin='Browsing' test=getinput(1 1 'Browse one library only? (Ny) > ') IF test='Y' THEN DO IF chdir()>0 THEN RETURN curdironly=1 lin=lin 'the' pen3||plaindir||def 'library' t=libpath||plaindir'.txt' IF edinfo(t,plaindir,'File Library') THEN RETURN END ELSE lin=lin 'all file libraries' lin=lin 'backwards from latest file.' SAY lin SAY END ELSE onearg=1 i=0 IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN DO lastfileloop=1 IF lastfile<1 THEN RETURN arg=WORD(files.lastfile,2) brfilenum=lastfile IF WORD(files.lastfile,2)~='' THEN LEAVE lastfileloop lastfile=lastfile-1 END ELSE IF DATATYPE(arg,'W') THEN DO brfilenum=arg arg=WORD(files.arg,2) IF arg='' THEN DO SAY 'File number' brfilenum 'does not exist in the current libraries!' RETURN END END ELSE DO IF onearg THEN CALL busywait(4 1) DO ni=lastfile TO 1 BY -1 IF onearg THEN CALL busywait(60 ni lastfile) IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni brfilenum=ni CALL busywait(4 0) LEAVE ni END IF ni<1 THEN DO SAY 'Unable to find a file description for' pen3||arg||def'.' RETURN END END IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1)) savearg=arg IF brfilenum>lastfile THEN brfilenum=lastfile newfilesdate=DATE('S') TIME() DO browseloop=1 IF curdironly THEN CALL busywait(4 1) DO ni=brfilenum TO 0 BY -1 IF ni=0 THEN LEAVE browseloop IF files.ni='' THEN ITERATE ni IF onearg THEN DO CALL busywait(60 ni lastfile) IF UPPER(arg)~=UPPER(WORD(files.ni,2)) THEN ITERATE ni IF (ni//30)>0 THEN CALL busywait(4 1) LEAVE ni END testdir=UPPER(WORD(files.ni,1)) IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN DO IF ni>lastbrowse THEN lastbrowse=ni IF ni>0 THEN CALL busywait(60 ni lastfile) ITERATE ni END IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN DO IF ni>lastbrowse THEN lastbrowse=ni ITERATE ni END LEAVE ni END IF curdironly | onearg THEN CALL busywait(4 0) onearg=0 IF ni=0 THEN brfilenum=lastbrowse ELSE brfilenum=ni argname=WORD(files.brfilenum,2) IF argname='' THEN RETURN CALL setdir(libpath||WORD(files.brfilenum,1)) arg=bbspath'FileNotes/'plaindir'/'argname CALL readlines(arg 1) IF nonstop=1 THEN brostop=1 ELSE brostop=0 CALL seelines(1) IF brfilenum>lastbrowse THEN lastbrowse=brfilenum IF brostop THEN DO SAY nonstop=1 brfilenum=brfilenum-1 END ELSE DO line='' endtest=UPPER(RIGHT(argname,4)) IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN line='['pen3'C'def']ontents ['pen3'D'def']ownload' ELSE line='['pen3'D'def']ownload' IF level>sysoplevel | name=WORD(lynes.3,2) THEN line=line '['pen3'E'def']dit' IF level>sysoplevel | name=WORD(lynes.3,2) THEN line=line '['pen3'K'def']ill' IF level>sysoplevel THEN line=line '['pen3'L'def']ib' line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop' IF endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15))) THEN line=line '['pen3'R'def']ead' line=line '['pen3'Q'def']uit ['pen3'?'def'] > ' brcom=getinput(1 0 line) IF DATATYPE(brcom,'W') THEN DO brfilenum=brcom+1 IF brfilenum>lastfile THEN brfilenum=lastfile+1 IF brfilenum<1 THEN brfilenum=1 SAY 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.' SAY END ELSE DO data.25=STRIP(DELWORD(data.25,wordnum,1)) SAY argname 'removed from download list.' END END IF brcom='H' | brcom='?' THEN DO SAY pen3' - HELP with the Browse Files commands -'def SAY ' RETURN reads the next file description in line.' SAY ' 34 will display the description of file number 34, if it exists.' SAY ' C displays the contents of an archived (arc dms lzh lha zip zoo) file.' SAY ' D displays the download menu.' IF level>sysoplevel | name=WORD(lynes.3,2) THEN DO SAY ' E puts this file description into the online Editor.' SAY ' K deletes a file you uploaded. you cannot Kill others!' END IF level>sysoplevel THEN SAY ' L move file and description to new Library and/or rename.' SAY ' M mark/unmark the current file for the next download' SAY ' N displays all descriptions without pausing. CTRL-E to Exit!' SAY ' R displays file as text. - ONLY FILES THAT END IN .TXT -' SAY ' Q returns to the main menu(s). (Quit)' SAY CALL waiting() IF waitchar='Q' THEN LEAVE browseloop END ELSE IF brcom='L' & level>sysoplevel THEN DO curdir=PRAGMA('D') IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN DO newarg=getinput(0 0 'Rename' argname 'to ') IF newarg~='' THEN DO IF is_here(newarg) THEN ITERATE browseloop IF wi=999999 THEN ITERATE browseloop IF EXISTS(libpath||filedir'/'newarg) THEN DO SAY SAY '***' newarg 'already exists!' SAY ITERATE browseloop END junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ') IF junk='Y' THEN DO lynes.2=OVERLAY(newarg,lynes.2,7,25) comment=WORD(STATEF(arg),8) CALL DELETE(arg) arg=bbspath'FileNotes/'plaindir'/'newarg CALL savelines(arg) IF comment='' THEN DO mpath=libpath||plaindir IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN SAY 'Rename failed on main file!' END ELSE DO t=LASTPOS('/',comment) IF t=0 THEN t=LASTPOS(':',comment) mpath=LEFT(comment,t-1) IF RENAME(comment,mpath'/'newarg)=1 THEN ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg ELSE SAY 'Rename failed on external file!' END files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg anum=files.brfilenum.0 alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2) argname=newarg sortalphaflag=1 savefileflag=1 CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15))) END END END mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ') IF mvdir~='' THEN DO IF DATATYPE(mvdir,'W') THEN DO dirnum=mvdir IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN DO IF chdir2()=0 THEN DO CALL readlines(arg 1) CALL movefile(brfilenum dirs.dirnum) END END END ELSE DO mvdir=STRIP(mvdir) IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN DO DO mj=1 TO level+1 IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj END IF mj<=level THEN CALL movefile(brfilenum mvdir) END END END IF savefileflag>0 THEN CALL savefilelist() CALL setdir(curdir) END ELSE IF brcom='N' THEN DO brfilenum=brfilenum-1 nonstop=1 SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def SAY CALL DELAY(99) 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 showtext('RAM:CONTENTS' 0) IF waitchar~='Q' THEN CALL waiting() nonstop=0 END ELSE SAY pen3'Not an archived file.'def END ELSE IF brcom='D' THEN DO arg2=arg arg=brfilenum CALL dload() arg=arg2 END ELSE IF brcom='E' THEN DO IF level>sysoplevel | name=WORD(lynes.3,2) THEN DO firstedit=5 IF level>sysoplevel THEN firstedit=1 CALL bbsEd.rexx(firstedit arg name) CALL checkfilechanges() 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=lastfile THEN DO CALL DELETE(bbspath'Numbers/LastFile') CALL DELAY(28) lastfile=lastfile-1 CALL countcheck('LastFile' lastfile) END files.tempnum='' tempnum2=files.tempnum.0 alpha.tempnum2='0 0' tempnum '100' savefileflag=1 CALL savefilelist() finfo=STATEF(arg) IF WORDS(finfo)>7 THEN argname=WORD(finfo,8) CALL DELETE(argname) CALL DELETE(arg) SAY argname pen3'has been deleted.'def CALL DELETE(libpath||plaindir'/.'STRIP(LEFT(plaindir,15))) END END END ELSE IF brcom='R' & (endtest='.TXT' | UPPER(argname)='.'UPPER(STRIP(LEFT(plaindir,15)))) THEN DO vcount=WORD(lynes.2,7)+1 lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount edtype='' CALL savelines(arg) CALL showtext(argname 1) 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)) md=libpath||movdir mf=md'/'farg fd=libpath||fromdir ff=fd'/'farg CALL DELETE(md'/.'STRIP(LEFT(movdir,15))) CALL DELETE(fd'/.'STRIP(LEFT(fromdir,15))) fn=bbspath'FileNotes/'fromdir'/'farg commen=WORD(STATEF(fn),8) IF commen~='' THEN DO ff=commen n=LASTPOS('/',ff) IF n>1 THEN DO xf=SUBSTR(ff,n+1) tfd=LEFT(ff,n-1) n=LASTPOS('/',tfd) IF n=0 THEN n=LASTPOS(':',tfd) IF n>0 THEN DO tmd=LEFT(tfd,n)||movdir SAY 'Rename external file'pen3 ff||def IF getinput(1 1 ' to'pen3 tmd'/'farg||def'? (Ny) > ')='Y' THEN DO fd=tfd md=tmd mf=md'/'farg commen=md'/'xf END ELSE IF getinput(1 1 ' or move to'pen3 mf||def'? (Ny) > ')='Y' THEN DO fd=tfd commen='' END END END END CALL MAKEDIR(md) IF RENAME(ff,mf)=0 THEN DO ADDRESS COMMAND 'C:COPY' ff mf IF EXISTS(mf) THEN IF DELETE(ff)~=1 THEN SAY pen3'Unable to delete'def ff||pen3'.'def END files.fnum=movdir farg lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1) lynes.3=STRIP(lynes.3) movdir CALL MAKEDIR(bbspath'FileNotes/'movdir) mn=bbspath'FileNotes/'movdir'/'farg CALL savelines(mn) ndx=files.fnum.0 dnum=finddirnum(movdir) alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15) IF EXISTS(mn) THEN DO CALL DELETE(fn) IF commen~='' THEN ADDRESS COMMAND 'C:FileNote' mn commen END savefileflag=1 line='Moved:' fromdir'/'farg 'to' movdir SAY line RETURN textsearch: ARG sfile' 'sarg IF sarg='' THEN RETURN 0 x=OPEN(f,sfile,'R') IF x=0 THEN RETURN 0 stemp=UPPER(READCH(f,65000)) CALL CLOSE(f) retflag=0 IF POS(sarg,stemp)>0 THEN retflag=1 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,'*') IF smenu='NEW' | smenu='MAIN' THEN DO SAY 'Searching Userlist...' CALL FileList(bbspath'Users/*'searcharg'*',sl) SAY 'Found' sl.0 'matches ' DO i=1 TO sl.0 SAY sl.i IF ~nonstop THEN IF i//linesperpage=0 THEN IF waiting2() THEN LEAVE i END DROP sl. END IF smenu='MSG' THEN DO CALL SETCLIP('BBSMSG_SEARCH',searcharg) SAY lm CALL bbsMsg.rexx(3000 name password) END IF smenu='FILE' THEN DO lne=pen3'Searching' curdironly=0 IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN DO IF chdir()>0 THEN RETURN curdironly=1 lne=lne 'the'def plaindir pen3'library' SAY END ELSE DO lne=lne 'all file libraries' SAY SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!' END test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ') IF test='Q' THEN RETURN SAY SAY lne 'for'def UPPER(searcharg) SAY pen3' - To ABORT, press CTRL-E -'def SAY IF test~='F' THEN DO CALL fileheader() IF curdironly=1 THEN DO af=libpath||dirs.dirnum'/.'STRIP(LEFT(dirs.dirnum,15)) IF EXISTS(af) THEN DO CALL readlines(af 1) DO i=1 TO lynes.0 CALL busywait(8 i lynes.0) tempnum=POS(UPPER(searcharg),UPPER(lynes.i)) IF tempnum>0 THEN DO CALL busywait(4 0) SAY lynes.i SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def CALL busywait(4 1) END END END END IF curdironly=0 | ~EXISTS(af) THEN DO i=1 TO alpha.0 CALL busywait(60 i alpha.0) ii=WORD(alpha.i,4) IF ii>level THEN ITERATE i IF curdironly=1 & ii~=dirnum THEN ITERATE i ii=WORD(alpha.i,3) IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i tempnum=POS(UPPER(searcharg),UPPER(alpha.i)) IF tempnum>0 THEN DO CALL busywait(4 0) SAY alpha.i SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def CALL busywait(4 1) END END END ELSE DO cck=countcheck('LastFile' 0) nonstop=1 DO i=1 TO cck iii=cck+1-i IF files.iii='' THEN ITERATE i ii=files.iii.0 ii=WORD(alpha.ii,4) IF ii>level THEN ITERATE i IF curdironly=1 & ii~=dirnum THEN ITERATE i IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i farg=WORD(files.iii,1)'/'WORD(files.iii,2) SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7) IF textsearch(bbspath'FileNotes/'farg searcharg) THEN DO savei=i CALL readlines(bbspath'FileNotes/'farg 1) nonstop=1 CALL seelines(2) i=savei SAY SAY END END END CALL busywait(4 0) END searcharg='' nonstop=0 SAY IF i<999999 THEN SAY 'All available items have been searched.' SAY CALL waiting() 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 . CALL DELETE(bufname) startnum=lynes.0+1 OPTIONS PROMPT '' SAY pen3'LOCAL logon! Input cannot exceed 250 characters per line!'def SAY 'Type 'pen3'/E'def 'or' pen3'/S'def' on a new line to exit and' pen3'DO YOUR OWN WORDWRAP!'def DO bufloop=startnum PARSE PULL line IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN LEAVE bufloop lynes.bufloop=line END lynes.0=bufloop-1 CALL wrapbuf(startnum) CALL DELETE(bufname) /* these 4 lines make wordwrap more consistent */ CALL savelines(bufname) CALL readlines(bufname 1) CALL wrapbuf(startnum) RETURN wrapbuf: ARG startnum . CALL cleanline(1) IF startnum>=lynes.0 & LENGTH(lynes.startnum)<80 THEN RETURN SAY pen3'Wordwrapping...'def lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x) lynes.startnum=COMPRESS(lynes.startnum,'0C'x) /* no FF */ DO wi=startnum WHILE wi<=lynes.0 wj=wi+1 lynes.wj=COMPRESS(lynes.wj,'08'x||'0C'x||'7F'x) tabpos=POS('09'x,lynes.wi) DO WHILE tabpos>0 lynes.wi=DELSTR(lynes.wi,tabpos,1) lynes.wi=INSERT(' ',lynes.wi,tabpos-1) tabpos=POS('09'x,lynes.wi) END IF LENGTH(lynes.wi)>75 THEN DO testchar='' IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1) IF testchar=' ' | testchar='.' | testchar=':' THEN DO DO wjj=lynes.0 TO wi+1 BY -1 wk=wjj+1 lynes.wk=lynes.wjj END lynes.wj='' lynes.0=lynes.0+1 END DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74 IF WORDS(lynes.wi)=1 THEN lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75) lynes.wj=WORD(lynes.wi,wl) lynes.wj lynes.wi=STRIP(DELWORD(lynes.wi,wl,1)) END END END RETURN seelines: ARG fancy . DO i=1 TO lynes.0 IF fancy=0 THEN SAY lynes.i||def 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 ELSE SAY lynes.i IF fancy=2 & colorflag=1 THEN DO IF searcharg~='' THEN DO testpos=POS(UPPER(searcharg),UPPER(lynes.i)) IF testpos>0 THEN SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def END IF i=1 THEN IF WORD(lynes.1,3)='Reply' THEN DO testpos=WORDINDEX(lynes.1,3) SAY LEFT(' ',testpos-1)||pen3||lineup||SUBSTR(lynes.1,testpos)||def END END END IF i//linesperpage=0 & ilevel | FIND(data.21,i)>0 THEN RETURN lastread.countdir=WORD(data.22,countdir) IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0 lastmess=countcheck('LastMessage'countdir 0) IF lastread.countdir<0 THEN RETURN firstmess=countcheck('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 IF unred>0 | ~logonflag THEN DO cline=RIGHT(unred,5) 'new of' RIGHT(lastmess,5) 'messages,' cline=cline RIGHT(totmsgs,5) 'still online in' cline=cline RIGHT(countdir,2)',' msg.countdir SAY pen6||cline||def END END RETURN counts: SAY SAY 'Working...' SAY temp='' DO i=1 TO 4 temp=temp||CENTER(copyright.i,75)||'0A'x END CALL SETCLIP('BBS_copyright',temp) IF emailonline<0 THEN CALL countmail() CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 users) SAY CALL waiting2() IF waitchar='Q' THEN RETURN CALL showmarked(1) CALL logonstats() nonstop=0 CALL waiting() RETURN countmail: SAY ' Counting online email...'lineup emailonline=0 t=SHOWDIR(bbspath'Users') DO ti=1 TO WORDS(t) emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(t,ti))) END SAY lineup' 'emailonline' letters online.' 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 SAY lm CALL ShowHourly.rexx(name linesperpage colorflag nonstop) RETURN logonstats: IF level=0 THEN RETURN SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime tempnum=countcheck('LastFile' 0)-lastbrowse IF tempnum>files.0 THEN tempnum=files.0 line=RIGHT(countcheck('LastFile' 0),5) 'uploaded,' line=line RIGHT(files.0,5) 'files online.' IF tempnum>0 THEN SAY RIGHT(tempnum,5) 'new of' line ELSE SAY ' No new of' 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,5) 'messages,' RIGHT(grand,5) 'still online.' IF totmsg>0 THEN SAY RIGHT(totmsg,5) 'new of' line ELSE SAY ' No new of' line 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 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 RETURN 0 set_grand: SAY 'Setting up public message conferences...' grand=0 DO i=1 TO 99 IF msg.i='' THEN ITERATE i msg.i.0=WORDS(SHOWDIR(msgpath||i,'F')) msg.i.1=STATEF(msgpath||i) grand=grand+msg.i.0 END RETURN SYNTAX: FAILURE: lin.1=''ERRORTEXT(RC)'' lin.2=SIGL-1 SOURCELINE(SIGL-1) lin.3=SIGL ''SOURCELINE(SIGL)'' lin.4=SIGL+1 SOURCELINE(SIGL+1) DO er=1 TO 4 SAY lin.er END IF newpassword='' THEN SIGNAL DONE2 /* no user logged on, quit quietly */ CALL CLOSE(f) IF level>sysoplevel THEN DO junk=getinput(1 1 'ReStart: (Ny) > ') IF junk~='Y' THEN SIGNAL LOGOUT END string='' 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 waitchar='' string='' nonstop=0 rnonstop=0 brostop=0 i=999999 wi=999999 ni=-1 SAY RETURN 0 BREAK_C: CALL CLOSE(f) LOGOUT: LOGOUT2: secs=TIME('E') mins=secs%60 secs=TRUNC(secs//60) IF secs<10 THEN secs='0'secs SAY SAY 'Public messages now online: 'RIGHT(comma(grand),9) SAY 'Public files now online: 'RIGHT(comma(files.0),9) SAY SAY 'Time used this call:' mins':'secs SAY arg=bbspath'BBS_TEXT/GOODBYE' IF EXISTS(arg) THEN DO CALL DELAY(14) nonstop=1 CALL showtext(arg 0) nonstop=0 END SAY IF bbsprefs.2 THEN CALL doGrin() SAY IF EXISTS('rexx:bbsLOGOFF.rexx') THEN CALL bbsLOGOFF.rexx(name level 0) OUT: data.18=winnings OUT2: DONE: DONE2: CALL SETCLIP('BBS_LOCAL') CALL SETCLIP('BBS_LOCAL_MSG') IF newfilesflag=1 THEN DO newfilesdate=DATE('S') TIME() lastbrowse=countcheck('LastFile' 0) END IF clear_marked=1 THEN data.24='' CALL saveData(0) IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN DO IF sortalphaflag>0 | savefileflag>0 THEN CALL SETCLIP('BBS_QUICK_WAIT',1) ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6 END IF sortuserflag=1 THEN DO CALL sortuserlist() IF SHOW('P','BBBBS') THEN DO CALL SETCLIP('BBS_mainusers') CALL SETCLIP('BBS_localusers',1) END sortuserflag=0 END IF sortalphaflag>0 | savefileflag>0 | GETCLIP('BBS_resave_local')~='' THEN DO x=GETCLIP('BBS_resave_local') IF savefileflag>0 THEN CALL savefilelist2() ELSE IF x='' THEN CALL savealphalist() x=GETCLIP('BBS_resave_local') CALL SETCLIP('BBS_resave_local') IF x=1 THEN DO sortalphaflag=1 savefileflag=1 SIGNAL DONE2 END IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2) CALL SETCLIP('BBS_QUICK_WAIT') END IF getinput(1 1 'Reset for next local user? (nY) > ')='N' THEN EXIT clear_marked=0 data.='' SIGNAL BIG_LOOP checkclips: IF GETCLIP('BBS_mainusers')~='' THEN DO CALL sortuserlist() CALL SETCLIP('BBS_mainusers') END IF GETCLIP('BBS_mainfiles')~='' THEN DO CALL SETCLIP('BBS_mainfiles') CALL loadfiles() CALL loadalpha(1) END RETURN checkalias: addressee='' IF alias.0=0 THEN RETURN 0 DO i=1 TO alias.0 IF UPPER(alias.i)=UPPER(string) THEN DO addressee=realname.i LEAVE i END END IF addressee='' THEN RETURN 0 string='' SAY pen3'Email to 'def||addressee CALL editor('MAIL' addressee) RETURN 0 /* bbsLOCAL.rexx */