Fresh Fish 5/FreshFish_July-August1994.bin/bbs/comm/bbbbs-7.2.lha/BBBBS/BBBBS72.lha/rexx/bbsDoors.rexx

OS/2 REXX Batch file | 1993-12-10 | 5KB | 209 lines

/* $VER: bbsDoors.rexx 6.6 (10.12.93)
Originally called Jump.rexx by Matt English 9-30-92
Alterations by Richard Lee Stockton 5 Aug, 17 Sep, and 10 Dec 93

This is a utility for BBBBS sysops to use rexxDoors offline.
FREELY DISTRIBUTABLE as long as no-one makes any money on it,
this notice remains, and the credits at the main menu remain.
*/

OPTIONS FAILAT 999999

/* Open the support library if it is not already open. */
if ~show('L',"rexxsupport.library") THEN
    CALL addlib('rexxsupport.library',0,-30,0)

if ~showlist('p','QuickSortPort') then do
   ADDRESS COMMAND "run quicksort >NIL:"
   do i=1 to 10
      if ~showlist('p','QuickSortPort') then CALL delay 20
      else leave i
   END
   if showlist('p','QuickSortPort') then CALL addlib('QuickSortPort',-30)
END

name=''
figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
    EXIT(20)
  END
lynes.=''
DO i=1 TO 6
  lynes.i=READLN(f)
END
CALL CLOSE(f)

compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop  =WORD(lynes.2,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'
    CALL SETCLIP('BBS_STAT')
    EXIT(20)
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
CALL PRAGMA('D',bbspath'rexxDoors')

def='';  /* default */
pen0='';  pen1='';  pen2='';  pen3=''
pen4='';  pen5='';  pen6='';  pen7=''
bak0='';  bak1='';  bak2='';  bak3=''
bak4='';  bak5='';  bak6='';  bak7=''

SAY
SAY'                       bbsDoors.rexx'
SAY'               Original by Matt English 9-30-92'
SAY'            Alterations by RLS through 12-10-93'
SAY
SAY
options prompt' Are you 'sysop' ? Y or n > '
pull answer
if answer='Y' | answer='' then name=sysop
else DO
  SAY
  options prompt' Please enter your name > '
  pull name
  name=strip(name)
  name=translate(name,'_',' ')
  if name='' then CALL bye
  file=bbspath'Users/'name
  IF EXISTS(file) THEN match=1
  ELSE match=0
END

OK:
SAY
if match=0 then
  DO
    SAY' I can''t find' name 'on the users list!'
    SAY' You should log on to the BBS before you try this!'
    CALL delay(100)
    CALL bye
  END

userfile=bbspath'Users/'name
CALL open(data,userfile,'r')
DO i=1 TO 18
  line=readln(data)
  IF i=5 THEN password=WORD(line,1)
END
CALL close(data)
winnings=WORD(line,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

passprompt=' 'pen3'Please 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
      CALL bye
    END
  passprompt='Incorrect.  Password: ' /* ask again */
END
SAY
SAY' OK, 'name' here we go....'
SAY

CALL sortdoors()
temp=1
readcount=-1
DO doorloop=1
  IF temp=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          doors.0=''
          CALL sortdoors()
        END
      SAY
      SAY CENTER('- Number of accesses per file -',75)
    END
  SAY pen3||LEFT('-',75,'-')||def
  DO jd=1 TO jdoors.0
    IF temp=0 THEN SAY jdoors.jd.0
    ELSE SAY jdoors.jd
  END
  IF temp=0 THEN
    DO
      SAY
      OPTIONS PROMPT '                                 'pen3'Press RETURN 'def
      PULL junk
      temp=1
      SAY
      ITERATE doorloop
    END
  options prompt' 'pen3'Select Application Number (0=Stats) or hit 'pen2'Return to Quit' pen3'> 'def
  pull temp
  IF temp=0 THEN ITERATE doorloop
  IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN RETURN
  arg=doors.temp
  IF GETCLIP('BBS_door')=arg THEN
    DO
      SAY 'That door is in use!  Try again in a few minutes...'
      ITERATE doorloop
    END
  CALL SETCLIP('BBS_localdoor',arg)
  readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
  comm='CALL' doors.temp'('name winnings 0 1 6000')'
  INTERPRET comm
  CALL SETCLIP('BBS_localdoor')
END

bye:
CALL SETCLIP('BBS_localdoor')
SAY
SAY' Now leaving bbsDoors....'
SAY
EXIT


sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      DO j=0 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          DO
            jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
            dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
            jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
          END
      END
    END
  END
RETURN 0


/* bbsDoors.rexx */