home *** CD-ROM | disk | FTP | other *** search
- /* $VER: ArcBrowse.rexx 6.2 © 1993 Richard Lee Stockton (31.7.93)
- archives user defined browselist into file in users email
- it receives its arguments from rexxDoors/Make_BrowseList.rexx
- copyright 1991-93 Richard Lee Stockton FREELY DISTRIBUTABLE
- */
-
- CALL TIME('R')
- SIGNAL ON ERROR
- SIGNAL ON SYNTAX
- OPTIONS FAILAT 999999
-
- PARSE ARG name lastbrowse alphaflag libflag liblist
- lastbrowse=STRIP(lastbrowse)
-
- CALL CLOSE(STDOUT)
- CALL OPEN(STDOUT,'RAM:ArcBrowse.STDOUT','W')
- SAY STRIP(SUBSTR(SOURCELINE(1),3))
- SAY
-
- IF ~DATATYPE(lastbrowse,'N') | name='' | alphaflag='' | libflag='' | liblist='' THEN
- CALL GETOUT(20)
-
- 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!'
- CALL GETOUT(21)
- END
- lynes.=''
- DO i=1 TO 33
- 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 GETOUT(22)
- END
- testchar=RIGHT(bbspath,1)
- IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
-
- DO i=1
- IF GETCLIP('BBS_BROWSE'i)='' THEN /* info clip for external STOP */
- DO
- CALL SETCLIP('BBS_BROWSE'i,name)
- CALL SETCLIP('BBS_STOP_BROWSE'i)
- clipnum=i
- LEAVE i
- END
- END
-
- CALL PRAGMA('P',-4) /* lower the priority of this task */
-
- extension=WORD(lynes.32,1)
- 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='lha -m m'
- END
-
- filepath=bbspath'EmailFiles/'name
- CALL MAKEDIR(filepath)
- IF GETCLIP('BBS_'name)~='' THEN browsename=filepath'/FileList'
- ELSE
- DO
- x=OPEN(f,bbspath'Numbers/LastMail','R')
- IF x~=0 THEN lastm=READLN(f)+1
- CALL CLOSE(f)
- ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
- browsename=filepath'/BBBBS_'lastm
- END
- filelistname=bbspath'Lists/Files'
- filelist.=''
- x=OPEN(f,filelistname,'R')
- IF x=0 THEN CALL GETOUT(23)
- DO i=1
- line=READLN(f)
- IF EOF(f) THEN LEAVE i
- indx=WORD(line,1)
- IF DATATYPE(indx,'N') THEN filelist.indx=line
- END
- filelist.0=indx
- CALL CLOSE(f)
- numba=filelist.0
-
- IF alphaflag='A' THEN
- DO
- filelistname=filelistname'.ALPHA'
- alphalist.=''
- x=OPEN(f,filelistname,'R')
- IF x=0 THEN CALL GETOUT(24)
- DO i=1
- line=READLN(f)
- IF EOF(f) THEN LEAVE i
- alphalist.i=line
- END
- alphalist.0=i-1
- CALL CLOSE(f)
- numba=alphalist.0
- END
-
- oldt=0
- count=0
- archives=1
- CALL open_browse()
-
- IF libflag='A' THEN CALL noteloop(1)
- ELSE IF libflag='L' THEN
- DO j=1 TO WORDS(liblist)
- test1=WORD(liblist,j)
- CALL noteloop(0)
- END
-
- IF WORD(STATEF(browsename),2)<80 THEN CALL GETOUT(26)
- IF GETCLIP('BBS_'name)~='' THEN CALL GETOUT(0)
- CALL write_msg()
- CALL GETOUT(0)
- EXIT
-
-
-
- add_note:
- ARG addname
- count=count+1
- IF count//5=0 THEN
- DO
- t=GETCLIP('BBS_STOP_BROWSE'clipnum)
- IF t~='' THEN CALL cleanup(t)
- END
- finfo=STATEF(browsename)
- IF WORD(finfo,2)>1400000 THEN
- DO
- CALL write_msg()
- archives=archives+1
- x=OPEN(a,browsename,'A')
- IF x=0 THEN CALL GETOUT(33)
- CALL WRITELN(a,CENTER('=== continued in part' archives'. ===',75))
- CALL CLOSE(a)
- CALL DELAY(50)
- IF GETCLIP('BBS_'name)~='' THEN
- DO
- IF EXISTS('FileList') THEN CALL RENAME('FileList','List1')
- browsename=filepath'/List'archives
- END
- ELSE
- DO
- x=OPEN(f,bbspath'Numbers/LastMail','R')
- IF x~=0 THEN lastm=READLN(f)+1
- ELSE lastm=lastm+1
- CALL CLOSE(f)
- ADDRESS COMMAND 'echo >'bbspath'Numbers/LastMail 'lastm
- browsename=filepath'/BBBBS_'lastm
- END
- CALL open_browse()
- END
- x=OPEN(a,browsename,'A')
- IF x=0 THEN CALL GETOUT(30)
- CALL WRITELN(a,'=====')
- x=OPEN(b,addname,'R')
- IF x=0 THEN CALL WRITELN(a,addname 'failed to open for reading!')
- ELSE
- DO
- data=READCH(b,65000)
- CALL CLOSE(b)
- CALL WRITECH(a,data)
- END
- CALL WRITELN(a,'')
- CALL CLOSE(a)
- RETURN
-
-
- write_msg:
- IF GETCLIP('BBS_'name)~='' THEN RETURN
- CALL PRAGMA('P',0) /* normal priority */
- ADDRESS COMMAND arccom browsename||extension browsename
- IF ~EXISTS(browsename||extension) THEN CALL GETOUT(27)
- CALL PRAGMA('P',-4)
- x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
- IF x=0 THEN CALL GETOUT(28)
- CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm||extension)
- CALL WRITELN(f,' From: BBBBS')
- CALL WRITELN(f,' To: 'name)
- temp='BrowseList'
- IF WORD(finfo,2)>1400000 THEN temp=temp', part' archives
- CALL WRITELN(f,' Subj:' temp)
- CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
- CALL WRITELN(f,LEFT('=',75,'='))
- temp='Here are the file descriptions you requested'
- IF WORD(finfo,2)>1400000 THEN temp=temp', part' archives
- CALL WRITELN(f,temp'.')
- t=(.5+TIME('E'))%1
- t=t-oldt
- oldt=t+oldt
- min=t%60
- hrs=min%60
- min=min//60
- sec=t//60
- temp='It took'
- IF hrs>1 THEN temp=temp hrs 'hours'
- ELSE IF hrs=1 THEN temp=temp '1 hour'
- IF min>1 THEN temp=temp min 'minutes'
- ELSE IF min=1 THEN temp=temp '1 minute'
- IF sec=1 THEN temp=temp '1 second'
- ELSE IF sec>0 THEN temp=temp sec 'seconds'
- temp=temp 'to compile these descriptions.'
- CALL WRITELN(f,temp)
- CALL CLOSE(f)
- IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
- DO
- oldmess=GETCLIP('BBS_MESSAGE')
- IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
- CALL SETCLIP('BBS_MESSAGE',oldmess||'Your archived filelist is waiting in Email.')
- END
- RETURN
-
-
- open_browse:
- x=OPEN(a,browsename,'W')
- IF x=0 THEN CALL GETOUT(25)
- IF alphaflag='A' THEN temp='alphabetical'
- ELSE temp='aged'
- title='=' bbsname temp 'file descriptions'
- IF libflag='L' THEN title=title 'by library'
- IF archives>1 THEN title=title', part' archives
- CALL WRITELN(a,title)
- CALL WRITELN(a,'= Custom archived for' name' 'DATE() TIME('C'))
- CALL WRITELN(a,'')
- CALL CLOSE(a)
- IF GETCLIP('BBS_'name)='' THEN
- DO
- x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
- IF x=0 THEN CALL GETOUT(28)
- CALL WRITELN(f,' Mail: 'lastm' FILE: BBBBS_'lastm)
- CALL WRITELN(f,' From: BBBBS')
- CALL WRITELN(f,' To: 'name)
- CALL WRITELN(f,' Subj: BrowseList')
- CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
- CALL WRITELN(f,LEFT('=',75,'='))
- CALL WRITELN(f,'Here are the file descriptions you requested.')
- CALL WRITELN(f,'The collection process was interrupted.')
- CALL CLOSE(f)
- END
- RETURN
-
-
- noteloop:
- ARG nflag .
- IF alphaflag='A' THEN
- DO i=1 TO numba
- k=i
- k=STRIP(WORD(alphalist.i,3))
- IF filelist.k='' | lastbrowse>=k THEN ITERATE i
- lname=WORD(filelist.k,2)
- fname=WORD(filelist.k,3)
- IF nflag THEN
- DO
- IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
- END
- ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
- CALL add_note(bbspath'FileNotes/'lname'/'fname)
- END
- ELSE
- DO i=numba TO 1 BY -1
- IF filelist.i='' | lastbrowse>=i THEN ITERATE i
- lname=WORD(filelist.i,2)
- fname=WORD(filelist.i,3)
- IF nflag THEN
- DO
- IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
- END
- ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
- CALL add_note(bbspath'FileNotes/'lname'/'fname)
- END
- RETURN
-
-
- cleanup:
- ARG t2 .
- SAY 'User aborted!'
- IF t2='DELETE' THEN
- DO
- IF GETCLIP('BBS_'name)~='' THEN
- DO
- CALL DELETE(bbspath'EmailFiles/'name'/FileList')
- ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/List#?'
- END
- ELSE ADDRESS COMMAND 'c:delete' LEFT(browsename,LENGTH(browsename)-4)'#?'
- END
- CALL GETOUT(0)
- RETURN
-
-
- ERROR:
- SYNTAX:
-
- GETOUT:
- ARG errorout
- CALL SETCLIP('BBS_BROWSE')
- CALL SETCLIP('BBS_BROWSE'clipnum)
- CALL SETCLIP('BBS_STOP_BROWSE'clipnum)
- IF errorout>0 THEN SAY 'ArcBrowse error' errorout'!'
- EXIT(errorout)
-
-
- /* ArcBrowse.rexx */
-