home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / comm / bbs / bbbbs / bbbbs72.lha / rexx / bbsFile.rexx < prev    next >
OS/2 REXX Batch file  |  1994-04-16  |  27KB  |  1,128 lines
  1. /* $VER: bbsFile.rexx 7.2 (16.4.94) Copyright © 1994 Richard Lee Stockton
  2.  * BBBBS local file uploader
  3.  * FREELY DISTRIBUTABLE
  4. */
  5.  
  6. kill_original=0  /* To "move" files, set this to 1 */
  7.  
  8. IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
  9. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  10.  
  11. CALL OPENPORT('BBSFILE')
  12.  
  13. title.=''
  14. title.1='BBBBS File Uploader'
  15. title.2='Version 7.1'
  16. title.3='7-Mar-94'
  17.  
  18. def=''
  19. pen2=''
  20. pen3=''
  21. lineup='1B'x'M'
  22. newlist.=''
  23. newlist.0=0
  24. linesperpage=20
  25. namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
  26.  
  27. topath='RAM:'
  28. figarg='s:CONFIG.BBS'
  29. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  30. x=OPEN(f,figarg,'R')
  31. IF x=0 THEN
  32.   DO
  33.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  34.     EXIT
  35.   END
  36. lynes.=''
  37. DO i=1 TO 40
  38.   lynes.i=READLN(f)
  39. END
  40. CALL CLOSE(f)
  41.  
  42. compos=POS('/*',lynes.1)
  43. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  44. bbsname=STRIP(lynes.1)
  45. sysop=WORD(lynes.2,1)
  46. compos=POS('/*',lynes.3)
  47. IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
  48. bbsdevice=word(lynes.4,1)
  49. sysoplevel=WORD(lynes.5,1)
  50. bbspath=WORD(lynes.6,1)
  51. IF ~EXISTS(bbspath) THEN
  52.   DO
  53.     SAY bbspath 'does not exist!'
  54.     EXIT
  55.   END
  56. testchar=RIGHT(bbspath,1)
  57. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  58. libpath=WORD(lynes.8,1)
  59. IF ~EXISTS(libpath) THEN
  60.   DO
  61.     SAY libpath 'does not exist!'
  62.     EXIT
  63.   END
  64. testchar=RIGHT(libpath,1)
  65. IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
  66. IF WORD(lynes.25,1)=1 THEN scratch=bbspath'Scratch'
  67. ELSE scratch='RAM:Scratch'
  68. CALL MAKEDIR(scratch)
  69. extension=WORD(lynes.32,1)
  70. compos=POS('/*',lynes.33)
  71. IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
  72. arccom=STRIP(lynes.33)
  73. IF LEFT(extension,1)~='.' THEN
  74.   DO
  75.     extension='.lzh'
  76.     arccom='lharc -m m'
  77.   END
  78.  
  79. OPTIONS PROMPT ' Are you 'sysop'? (Yn) > '
  80. PULL answer
  81. IF answer='N' THEN
  82.   DO
  83.     SAY
  84.     OPTIONS PROMPT ' Please enter your name > '
  85.     PULL name
  86.     name=cleanstring('1:'name)
  87.     IF name='' THEN EXIT 
  88.     IF ~EXISTS(bbspath'Users/'name) THEN
  89.       DO
  90.         SAY name 'does not exist!'
  91.         EXIT
  92.       END
  93.   END
  94. ELSE name=sysop
  95. userfile=bbspath'Users/'name
  96. CALL OPEN(f,userfile,'R')
  97. data.=''
  98. DO i=1
  99.   line=READLN(f)
  100.   IF EOF(f) THEN LEAVE i
  101.   data.i=line
  102. END
  103. CALL CLOSE(f)
  104. data.0=i-1
  105. password=data.5
  106. level=data.20
  107.  
  108. passprompt=pen3' Please Enter Password: '
  109. DO tries=1 TO 3
  110.   OPTIONS PROMPT passprompt
  111.   PULL newpassword
  112.   SAY def
  113.   IF(password=newpassword) THEN LEAVE tries; /* correct password */
  114.   IF tries=3 THEN
  115.     DO
  116.       SAY 
  117.       SAY 'Access terminated.'
  118.       SAY '*** Bad password ***' newpassword '***'
  119.       EXIT
  120.     END
  121.   passprompt='Incorrect.  Password: ' /* ask again */
  122. END
  123. SAY
  124. SAY' OK, 'name' here we go....'
  125. SAY
  126. dirs.=''
  127. IF readopen(bbspath'Lists/Libraries') THEN
  128.   DO
  129.     SAY 'Loading library list...'
  130.     DO i=1
  131.       line=READLN(f)
  132.       IF line='END' | EOF(f) THEN LEAVE i
  133.       num=WORD(line,1)
  134.       IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
  135.     END
  136.     CALL CLOSE(f)
  137.     CALL sortlibraries()
  138.   END
  139. SAY
  140.  
  141. DO FOREVER
  142.   SAY
  143.   DO i=1 TO 3
  144.     SAY CENTER(title.i,24)
  145.   END
  146.   SAY
  147.   IF uload()>1 THEN CALL seeya
  148. END
  149.  
  150.  
  151.  
  152. /* SUBROUTINES */
  153.  
  154. sortlibraries:
  155. SAY 'Sorting Libraries...'
  156. count=0
  157. sdirs.=''
  158. DO i=1 TO level
  159.   IF dirs.i='' THEN ITERATE i
  160.   count=count+1
  161.   sdirs.count=dirs.i i
  162. END
  163. sdirs.0=count
  164. IF count>0 THEN CALL QSort(1,count,sdirs)
  165. count=0
  166. libs.=''
  167. DO i=1 TO sdirs.0
  168.   tempnum=WORD(sdirs.i,2)
  169.   tempdir=WORD(sdirs.i,1)
  170.   IF FIND(data.21,UPPER(tempdir))=0 THEN
  171.     DO
  172.       string=' '
  173.       IF tempnum<10 THEN string=string' '
  174.       string=string || tempnum'. 'LEFT(tempdir,14)
  175.       count=count+1
  176.       libs.count=string
  177.     END
  178. END
  179. libs.0=count%4
  180. IF (count//4)>0 THEN libs.0=libs.0+1
  181. DO i=1 TO libs.0
  182.   DO j=1 TO 3
  183.     k=i+j*libs.0
  184.     IF k<=count THEN libs.i=libs.i||libs.k
  185.   END
  186. END
  187. DROP sdirs.
  188. RETURN
  189.  
  190.  
  191. bbsspace:
  192. ARG tabspace .
  193. ADDRESS COMMAND 'C:info >ram:filinfout' bbsdevice
  194. ok=OPEN(f,'ram:filinfout','R')
  195. IF ok=0 THEN RETURN 20
  196. line=READLN(f)
  197. line=READLN(f)
  198. line=READLN(f)
  199. line=READLN(f)
  200. CALL CLOSE(f)
  201. IF tabspace<14 THEN SAY 
  202. bbsk=WORD(line,4)
  203. IF ~DATATYPE(bbsk,'N') THEN
  204.   DO
  205.     line=bbsdevice 'is not an info compatible device!'
  206.     SAY pen3||line||def
  207.     bbsk=0
  208.     RETURN
  209.   END
  210. bbsk=bbsk*512
  211. IF bbsk<1 THEN bbsk=0
  212. SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'
  213. RETURN
  214.  
  215.  
  216. comma:
  217. ARG num .
  218. dgt=LENGTH(num)
  219. numtext=''
  220. IF dgt>3 THEN numtext=','RIGHT(num,3)
  221. IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
  222. IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
  223. IF dgt>12 THEN
  224.   DO
  225.     numtext=','LEFT(RIGHT(num,12),3)||numtext
  226.     numtext=LEFT(num,dgt-12)||numtext
  227.   END
  228. ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
  229. ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
  230. ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
  231. ELSE numtext=num
  232. RETURN numtext
  233.  
  234.  
  235. is_here:
  236. ARG newname 
  237. SAY 'Checking filelist...'
  238. DO wi=1 TO 99
  239.   IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
  240.   IF dirs.wi='' THEN ITERATE wi
  241.   IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
  242.   line=pen3'*** File' newname 'already exists here'
  243.   IF wi<=level THEN line=line 'in the' dirs.wi 'library'
  244.   line=line'.'def
  245.   SAY line
  246.   SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'
  247.   CALL waiting()
  248.   RETURN 1
  249. END
  250. RETURN 0
  251.  
  252.  
  253. uload:
  254. CALL bbsspace(12)
  255. SAY
  256. IF bbsk<1 THEN
  257.   DO
  258.     SAY pen3'Upload area is full!'def
  259.     RETURN 2
  260.   END
  261. frompath=GETCLIP('BBS_frompath')
  262. IF frompath='' THEN frompath='RAM:'
  263. fdir=''
  264. DO loop=1
  265.   fromfile=GetFile(200,,frompath,'',' Select File to Upload ')
  266.   IF fromfile='' THEN RETURN 3
  267.   finfo=STATEF(fromfile)
  268.   IF WORD(finfo,1)='DIR' THEN RETURN 3
  269.   IF WORD(finfo,1)='FILE' THEN LEAVE loop
  270.   SAY
  271.   SAY fromfile 'does not exist!'
  272.   CALL DELAY(100)
  273. END
  274. x=LASTPOS('/',fromfile)
  275. IF x=0 THEN x=POS(':',fromfile)
  276. IF x>0 THEN
  277.   DO
  278.     arg=SUBSTR(fromfile,x+1)
  279.     fdir=LEFT(fromfile,x)
  280.     IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
  281.     CALL SETCLIP('BBS_frompath',fdir)
  282.   END
  283. ELSE arg=fromfile
  284. arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')  /* be sure no illegals here */
  285. x=LASTPOS('/',fromfile)
  286. IF x=0 THEN x=LASTPOS(':',fromfile)
  287. IF x>0 THEN
  288.   DO
  289.     IF DATATYPE(SUBSTR(fromfile,x+1),'W') THEN
  290.       DO
  291.         SAY 'Whole numbers are not allowed as filenames!'
  292.         CALL waiting()
  293.         RETURN 1
  294.       END
  295.   END
  296. size=WORD(STATEF(fromfile),2)
  297. IF ~DATATYPE(size,'W') THEN size='654321'
  298. tempnum=LENGTH(arg)+LENGTH(size)-22
  299. DO WHILE tempnum>0
  300.   temp='          'pen3||arg def'is'pen3 tempnum||def
  301.   IF tempnum=1 THEN temp=temp 'character'
  302.   ELSE temp=temp 'characters'
  303.   temp=temp 'too long for a filename.'
  304.   SAY temp  
  305.   arg=getinput(0 0 'Filename: ')
  306.   arg=cleanstring('0:'arg)
  307.   arg=COMPRESS(arg,' :/,;|#?*')
  308.   tempnum=LENGTH(arg)+LENGTH(size)-22
  309. END
  310. IF arg='' THEN RETURN 1
  311. IF is_here(arg) THEN RETURN 1
  312. IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
  313. ELSE
  314.   DO
  315.     SAY
  316.     SAY 'Please select an appropriate library for -' pen3||arg def'-'
  317.     IF chdir()>0 THEN RETURN 1
  318.   END
  319. ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D')'/'arg
  320. IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  321.   DO
  322.     SAY
  323.     SAY pen3'***'def arg pen3'failed archive check!'def
  324.     SAY
  325.     temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
  326.     IF temp~='Y' THEN
  327.       DO
  328.         CALL DELETE(arg)
  329.         SAY
  330.         RETURN 1
  331.       END
  332.   END
  333. IF kill_original THEN
  334.   DO
  335.     CALL DELETE(fromfile)
  336.     SAY 'Killed' fromfile'...'
  337.   END
  338. DO ui=sysoplevel+2 TO 100
  339.   IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0
  340. END
  341. DO WHILE editnote(bbspath'FileNotes/'plaindir'/'arg) /* INSIST on a filenote */
  342. END
  343. RETURN 0
  344.  
  345.  
  346. editnote:
  347. IF arg='' THEN
  348.   DO
  349.     PARSE PULL arg .
  350.     IF arg='' THEN RETURN 0
  351.   END
  352. comment=''
  353. IF ~EXISTS(arg) THEN
  354.   DO
  355.     finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
  356.     fromarg=arg
  357.     fromdir=GETCLIP('BBS_frompath')
  358.     IF WORDS(finfo)>7 THEN
  359.       DO
  360.         temp='Y'
  361.         fromdir=WORD(finfo,8)
  362.         fromdir=lastslash(fromdir)
  363.         fromarg=WORD(fromdir,1)
  364.         fromdir=WORD(fromdir,2)
  365.       END
  366.     ELSE
  367.       DO
  368.         IF level<sysoplevel THEN RETURN 0
  369.         temp=getinput(1 1 'Is this file on an another device? (Nqy)')
  370.       END
  371.     IF fromdir='' THEN fromdir='RAM:'
  372.     IF temp='Y' THEN
  373.       DO WHILE comment=''
  374.         comment=GetFile(150,36,fromdir,fromarg,' Select Linked File ')
  375.         IF comment='' THEN RETURN 0
  376.         IF ~EXISTS(comment) THEN comment=''
  377.         ELSE CALL SETCLIP('BBS_frompath',WORD(lastslash(comment),2))
  378.       END
  379.     ELSE IF temp~='N' THEN RETURN 0
  380.   END
  381. filedir=plaindir
  382. slash=LASTPOS('/',arg)
  383. IF slash=0 THEN slash=LASTPOS(':',arg)
  384. IF slash>0 THEN
  385.   DO
  386.     filedir=LEFT(arg,slash-1)
  387.     filedir=SUBSTR(filedir,5)
  388.     arg=SUBSTR(arg,slash+1)
  389.   END
  390. ELSE filedir=plaindir
  391. CALL MAKEDIR(bbspath'FileNotes/'filedir)
  392. IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  393.   DO
  394.     SAY pen3'*** Failed to open directory!' filedir||def
  395.     RETURN 0
  396.   END
  397. notename=bbspath'FileNotes/'filedir'/'arg
  398. lynes.=''
  399. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  400. IF level>sysoplevel THEN firstedit=1
  401. ELSE firstedit=5
  402. IF EXISTS(notename) THEN
  403.   DO
  404.     IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  405.     CALL bbsED(firstedit notename)
  406.     RETURN 0
  407.   END
  408. IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
  409. ELSE filedata=STATEF(comment)
  410. IF filedata='' THEN
  411.   DO
  412.     IF comment='' THEN line=filedir'/'arg
  413.     ELSE line=comment
  414.     SAY line 'does not exist!'
  415.     RETURN 0
  416.   END
  417. bytes=WORD(filedata,2)
  418. filenum=filenum+1
  419. lynes.0=4
  420. lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
  421. lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
  422. lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
  423. lynes.4=LEFT('',74,'=')
  424. lynes.1=lynes.1 edkeywords(arg filedir)
  425. CALL seelines(1)
  426. edtype=''
  427. CALL writebuffer(scratch'/NoteFile')
  428. IF savelines(notename) THEN RETURN 0
  429. IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
  430. fncom='R'
  431. DO WHILE fncom='R'
  432.   CALL seelines(1)
  433.   nonstop=0
  434.   line='['pen3'E'def']dit'
  435.   IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  436.   line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  437.   IF level>sysoplevel THEN line=line '(ekrS) 'def
  438.   ELSE line=line '(erS) 'def
  439.   fncom=getinput(1 1 line)
  440.   IF fncom='K' & level>sysoplevel THEN
  441.     DO
  442.       SAY 'Killing FileNote..'
  443.       CALL DELETE(notename)
  444.       RETURN 1
  445.     END
  446.   ELSE IF fncom='E' THEN
  447.     DO
  448.       IF bbsED(firstedit notename)>0 THEN RETURN 0
  449.       fncom='R'
  450.     END
  451.   ELSE IF fncom~='R' THEN
  452.     DO
  453.       SAY 'Adjusting filelist...'
  454.       IF filenum<1 THEN filenum=1
  455.       IF GETCLIP('BBS_level')~='' THEN CALL SETCLIP('BBS_localfiles',1)
  456.       CALL countcheck(bbspath'Numbers/LastFile' filenum)
  457.       IF EXISTS(bbspath'Lists/Files') THEN
  458.         x=OPEN(f,bbspath'Lists/Files','A')
  459.       ELSE x=OPEN(f,bbspath'Lists/Files','W')
  460.       IF x=0 THEN
  461.         DO
  462.           SAY '*** Failed to open' bbspath'Lists/Files'
  463.           RETURN 0
  464.         END
  465.       CALL WRITELN(f,filenum plaindir arg)
  466.       CALL CLOSE(f)
  467.       libnum=finddirnum(plaindir)
  468.       PARSE VAR lynes.1 . 'KeyWords:' keywords
  469.       alpha=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
  470.       alpha=alpha WORD(lynes.2,4) RIGHT(filenum,5)
  471.       alpha=alpha RIGHT(libnum,2) LEFT(plaindir,12)
  472.       alpha=alpha STRIP(LEFT(STRIP(keywords),32))
  473.       IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',1)
  474.       IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
  475.       newlist.0=newlist.0+1
  476.       nl=newlist.0
  477.       newlist.nl=alpha
  478.       SAY alpha
  479.       tf=bbspath'Lists/Files.ALPHA.add'
  480.       IF EXISTS(tf) THEN ft='A'
  481.       ELSE ft='W'
  482.       x=OPEN(a,tf,ft)
  483.       IF x=0 THEN SAY 'Unable to open File.ALPHA.add for writing!'
  484.       ELSE
  485.         DO
  486.           CALL WRITELN(a,alpha)
  487.           CALL CLOSE(a)
  488.         END
  489.     END
  490. END
  491. RETURN 0
  492.  
  493.  
  494. edkeywords:
  495. PARSE ARG kwarg
  496. templine=''
  497. DO WHILE LENGTH(templine)<3
  498.   SAY
  499.   SAY pen3'Please enter a list of keywords (or a condensed description)'def
  500.   SAY pen3'to be used in the alphabetic list and by the search routine.'def
  501.   SAY '    Note that only the first 32 characters will be used.'
  502.   SAY LEFT('',43)'|'LEFT('',31,'=')'|'
  503.   templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  504.   templine=cleanstring('0:'templine)
  505.   templine=STRIP(LEFT(templine,32))
  506.   SAY
  507. END
  508. RETURN templine
  509.  
  510.  
  511. loadfiles:
  512. SAY def
  513. SAY 'Loading filelist...'
  514. files.=''
  515. files.0=0
  516. IF readopen(bbspath'Lists/Files') THEN
  517.   DO
  518.     DO i=1
  519.       line=READLN(f)
  520.       IF EOF(f) THEN LEAVE i
  521.       num=WORD(line,1)
  522.       IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
  523.     END
  524.     files.0=i-1
  525.     CALL CLOSE(f)
  526.   END
  527. RETURN
  528.  
  529.  
  530. savefilelist:
  531. SAY 'Saving filelist...'
  532. xarg=bbspath'Lists/Files'
  533. CALL DELETE(xarg)
  534. filenum=countcheck(bbspath'Numbers/LastFile' 0)
  535. IF filenum<1 | writeopen(xarg)=0 THEN RETURN
  536. DO i=1 TO filenum
  537.   IF files.i='' THEN ITERATE
  538.   CALL WRITELN(f,i files.i)
  539. END
  540. CALL CLOSE(f)
  541. RETURN
  542.  
  543.  
  544. bbsED:
  545. PARSE ARG firstedit editarg .
  546. notchanged=1
  547. IF readlines(editarg 1) THEN RETURN 1
  548. finfo=STATEF(editarg)
  549. IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
  550. ELSE finfo=''
  551. SAY 
  552. SAY '                   'pen3'Entering the EDITOR module..'def
  553. SAY 
  554. count=1
  555. DO edloop=1
  556.   IF edcom='S' & SHOW('P','SPELL') THEN  /* spell check */
  557.     DO
  558.       SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def
  559.       CALL DELETE(scratch'/SpellLOCAL')
  560.       CALL savelines(scratch'/SpellLOCAL')
  561.       curdir=PRAGMA('D')
  562.       CALL setdir(spellpath)
  563.       CALL SpellChk.rexx(scratch'/SpellLOCAL')
  564.       CALL setdir(curdir)
  565.     END
  566.   ELSE
  567.     DO
  568.       IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
  569.       IF edcom~='L' THEN count=count-linesperpage
  570.       IF count>=lynes.0 | count<1 THEN count=1
  571.       startcount=count
  572.       DO i=startcount TO lynes.0+1
  573.         IF ((i+1-startcount)//linesperpage)=0 THEN
  574.           DO
  575.             pline='                 ['pen3'E'def']dit'
  576.             pline=pline '  ['pen3'RETURN'def']=Continue '
  577.             edcom=getinput(1 1 pline)
  578.             IF edcom~='' THEN LEAVE i
  579.           END
  580.         SAY pen3||RIGHT(i,2)||def lynes.i
  581.         count=count+1
  582.       END
  583.     END
  584.   SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'
  585.   pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  586.   IF SHOW('P','SPELL') THEN pline=pline '['pen3'S'def']pellcheck'
  587.   pline=pline '['pen3'U'def']pload-Text > '
  588.   edcom=getinput(1 0 pline)
  589.   IF edcom='Q' | edcom='X' THEN edcom=''
  590.   IF edcom='?' THEN
  591.     DO
  592.       SAY
  593.       SAY '                   Editor Help'
  594.       SAY '----------------------------------------------------------'
  595.       SAY '    an empty RETURN tells the editor you are done editing.'
  596.       SAY ' 7  edits line number 7, if it exists.'
  597.       SAY ' a  Append text to this file.'
  598.       SAY ' c  Cut selected line(s) of text to buffer.'
  599.       SAY ' i  Insert blank line.'
  600.       SAY ' k  Kill (delete) this file.'
  601.       SAY ' l  List this file from selected line.'
  602.       SAY ' p  Paste buffer contents to selected line number.'
  603.       SAY ' r  Replace a phrase or line of text.'
  604.       SAY ' s  Spellcheck this file.'
  605.       SAY ' u  Upload a textfile to append to this file.'
  606.       SAY '----------------------------------------------------------'
  607.       SAY
  608.       OPTIONS PROMPT ''
  609.       PULL
  610.     END
  611.   IF edcom='K' THEN
  612.     DO
  613.       junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
  614.       IF junk='Y' THEN
  615.         DO
  616.           IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'
  617.           IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
  618.             DO
  619.               IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
  620.                 SAY WORD(lynes.2,4) 'DELETED.'
  621.             END
  622.           RETURN 2
  623.         END
  624.     END
  625.   IF edcom='' THEN
  626.     DO
  627.       SAY '                   'pen3'Leaving the EDITOR module.'def
  628.       IF notchanged THEN RETURN 0
  629.       IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
  630.         RETURN 1
  631.       CALL DELETE(editarg)
  632.       IF savelines(editarg) THEN RETURN 1
  633.       CALL DELAY(28)
  634.       IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
  635.       SAY pen3'                        Changes saved.'def
  636.       RETURN 0
  637.     END
  638.   ELSE IF edcom='C' THEN  /* Cut */
  639.     DO
  640.       firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
  641.       IF firstnum='' THEN ITERATE edloop
  642.       dash=POS('-',firstnum)
  643.       IF dash>0 THEN
  644.         DO
  645.           lastnum=STRIP(SUBSTR(firstnum,dash+1))
  646.           firstnum=STRIP(LEFT(firstnum,dash-1))
  647.         END
  648.       ELSE lastnum=firstnum
  649.       IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
  650.         DO
  651.           junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
  652.           ITERATE edloop
  653.         END
  654.       IF lastnum>lynes.0 THEN lastnum=lynes.0
  655.       IF firstnum<firstedit THEN
  656.         DO
  657.           SAY '*** You are not authorized to delete that line!'
  658.           SAY
  659.           ITERATE edloop
  660.         END
  661.       IF firstnum>lastnum THEN
  662.         DO
  663.           SAY '*** Input error!  First number larger than last number'
  664.           ITERATE edloop
  665.         END
  666.       notchanged=0
  667.       numdiff=lastnum+1-firstnum
  668.       pasted.=''
  669.       pasted.0=numdiff
  670.       k=0
  671.       DO i=firstnum TO lynes.0
  672.         j=i+numdiff
  673.         k=k+1
  674.         IF k<=numdiff THEN pasted.k=lynes.i
  675.         lynes.i=lynes.j
  676.         lynes.j=''
  677.       END
  678.       lynes.0=lynes.0-numdiff
  679.       count=1
  680.     END
  681.   ELSE IF edcom='A' THEN  /* append */
  682.     DO
  683.       CALL writebuffer(scratch'/EditorLOCAL')
  684.       notchanged=0
  685.     END
  686.   ELSE IF edcom='U' THEN  /* fileappend (upload) */
  687.     DO
  688.       frompath=GETCLIP('BBS_frompath')
  689.       IF frompath='' THEN frompath=libpath'SysOps'
  690.       farg=GetFile(150,36,frompath,'',' Select TextFile to Append ')
  691.       IF farg~='' & EXISTS(farg) THEN
  692.         DO
  693.           CALL readlines(farg lynes.0+1)
  694.           notchanged=0
  695.           CALL SETCLIP('BBS_frompath',WORD(lastslash(farg),2))
  696.         END
  697.     END
  698.   ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
  699.     DO
  700.       IF DATATYPE(edcom,'W') THEN
  701.         DO
  702.           ednum=edcom
  703.           edcom='R'
  704.         END
  705.       ELSE
  706.         DO
  707.           line=pen3'   '
  708.           IF edcom='L' | edcom='P' THEN line=line'Starting '
  709.           line=line'Line Number? > 'def
  710.           ednum=getinput(1 0 line)
  711.         END
  712.       IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
  713.       IF ednum>(lynes.0+1) THEN ITERATE edloop
  714.       IF edcom='L' THEN
  715.         DO
  716.           count=ednum
  717.           ITERATE edloop
  718.         END
  719.       IF ednum<firstedit THEN
  720.         DO
  721.           SAY '*** You are not authorized to alter that line!'
  722.           SAY
  723.           ITERATE edloop
  724.         END
  725.       IF edcom='R' THEN   /* replace */
  726.         DO
  727.           SAY '   Now reads:'
  728.           SAY pen3||RIGHT(ednum,2)||def lynes.ednum
  729.           OPTIONS PROMPT pen3'........Search text? >'def
  730.           PARSE PULL stext
  731.           IF LENGTH(stext)=0 THEN
  732.             DO
  733.               IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
  734.                 ITERATE edloop
  735.               lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
  736.               notchanged=0
  737.               ITERATE edloop
  738.             END
  739.           found=POS(UPPER(stext),UPPER(lynes.ednum))
  740.           IF found=0 THEN
  741.             DO
  742.               SAY
  743.               SAY stext' was not found!'
  744.               SAY
  745.               ITERATE edloop
  746.             END
  747.           OPTIONS PROMPT pen3'...Replacement text? >'def
  748.           PARSE PULL rtext
  749.           lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
  750.           lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
  751.           SAY 'Done.'
  752.           SAY 
  753.           notchanged=0
  754.         END
  755.       ELSE IF edcom='I' THEN  /* insert */
  756.         DO
  757.           DO i=lynes.0 TO ednum BY -1
  758.             j=i+1
  759.             lynes.j=lynes.i
  760.           END
  761.           lynes.ednum=''
  762.           notchanged=0
  763.           lynes.0=lynes.0+1
  764.           lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
  765.         END
  766.       ELSE IF edcom='P' THEN   /* paste */
  767.         DO
  768.           DO i=lynes.0 TO ednum BY -1
  769.             j=i+pasted.0
  770.             lynes.j=lynes.i
  771.           END
  772.           DO k=1 TO pasted.0
  773.             kk=ednum+k-1
  774.             lynes.kk=pasted.k
  775.           END
  776.           notchanged=0
  777.           lynes.0=lynes.0+pasted.0
  778.         END
  779.     END
  780. END
  781. RETURN 0
  782.  
  783.  
  784. lastslash: PROCEDURE
  785. PARSE ARG sarg 
  786. sdir=''
  787. slash=LASTPOS('/',sarg)
  788. IF slash>2 THEN sdir=LEFT(sarg,slash-1)
  789. ELSE
  790.   DO
  791.     slash=LASTPOS(':',sarg)
  792.     IF slash>0 THEN sdir=LEFT(sarg,slash)
  793.   END
  794. IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
  795. RETURN sarg sdir
  796.  
  797.  
  798. countcheck:
  799. PARSE ARG fname' 'cknum' '.
  800. IF ~EXISTS(fname) THEN
  801.   DO
  802.     IF cknum=0 THEN RETURN 0
  803.     IF ~writeopen(fname) THEN RETURN 0
  804.     CALL WRITELN(f,cknum)
  805.     CALL CLOSE(f)
  806.     RETURN cknum
  807.   END
  808. IF ~readopen(fname) THEN RETURN cknum
  809. retval=STRIP(READLN(f))
  810. CALL CLOSE(f)
  811. IF ~DATATYPE(retval,'W') THEN retval=0
  812. IF ~DATATYPE(cknum,'W') THEN cknum=0
  813. IF retval<cknum THEN
  814.   DO
  815.     IF writeopen(fname) THEN
  816.       DO
  817.         CALL WRITELN(f,cknum)
  818.         CALL CLOSE(f)
  819.         RETURN cknum
  820.       END
  821.   END
  822. RETURN retval
  823.  
  824.  
  825. readopen:
  826. PARSE ARG fname
  827. ok=OPEN(f,fname,'R')
  828. IF ok~=0 THEN RETURN 1
  829. line=fname 'failed to open for reading!'
  830. SAY line
  831. RETURN 0
  832.  
  833.  
  834. writeopen:
  835. PARSE ARG fname
  836. CALL CLOSE(f)
  837. ok=OPEN(f,fname,'W')
  838. IF ok~=0 THEN RETURN 1
  839. line=fname 'failed to open for writing!'
  840. SAY line
  841. RETURN 0
  842.  
  843.  
  844. writebuffer:
  845. PARSE ARG bufname .
  846. CALL DELETE(bufname)
  847. startnum=lynes.0+1
  848. OPTIONS PROMPT ''
  849. SAY pen3'LOCAL logon! Input cannot exceed 250 characters per line!'def
  850. SAY 'Type 'pen3'/E'def 'or' pen3'/S'def' on a new line to exit and' pen3'DO YOUR OWN WORDWRAP!'def
  851. DO bufloop=startnum
  852.   PARSE PULL line
  853.   IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
  854.     LEAVE bufloop
  855.   lynes.bufloop=line
  856. END
  857. lynes.0=bufloop-1
  858. CALL wrapbuf(startnum)
  859. CALL DELETE(bufname)
  860. CALL savelines(bufname)
  861. CALL readlines(bufname 1)
  862. CALL wrapbuf(startnum)
  863. RETURN
  864.  
  865.  
  866. wrapbuf:
  867. ARG startnum .
  868. SAY pen3'Wordwrapping...'def
  869. lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
  870. lynes.startnum=COMPRESS(lynes.startnum,'0C'x)  /* no FF */
  871. DO wi=startnum WHILE wi<=lynes.0
  872.   wj=wi+1
  873.   lynes.wj=COMPRESS(lynes.wj,'08'x||'0C'x||'7F'x)
  874.   tabpos=POS('09'x,lynes.wi)
  875.   DO WHILE tabpos>0
  876.     lynes.wi=DELSTR(lynes.wi,tabpos,1)
  877.     lynes.wi=INSERT('  ',lynes.wi,tabpos-1)
  878.     tabpos=POS('09'x,lynes.wi)
  879.   END
  880.   IF LENGTH(lynes.wi)>75 THEN
  881.     DO
  882.       testchar=''
  883.       IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
  884.       IF testchar=' ' | testchar='.' | testchar=':' THEN
  885.         DO
  886.           DO wjj=lynes.0 TO wi+1 BY -1
  887.             wk=wjj+1
  888.             lynes.wk=lynes.wjj
  889.           END
  890.           lynes.wj=''
  891.           lynes.0=lynes.0+1
  892.         END
  893.       DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
  894.         IF WORDS(lynes.wi)=1 THEN
  895.           lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
  896.         lynes.wj=WORD(lynes.wi,wl) lynes.wj
  897.         lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
  898.       END
  899.     END
  900. END
  901. RETURN
  902.  
  903.  
  904. seelines:
  905. DO i=1 TO lynes.0
  906.   SAY lynes.i||def
  907.   IF i//linesperpage=0 THEN
  908.     IF waiting2() THEN LEAVE i
  909. END
  910. nonstop=0
  911. RETURN
  912.  
  913.  
  914. readlines:
  915. CALL CLOSE(f)
  916. PARSE ARG tempname readstart .
  917. IF ~readopen(tempname) THEN RETURN 1
  918. IF readstart<2 THEN lynes.=''
  919. DO ri=readstart
  920.   line=READLN(f)
  921.   IF EOF(f) THEN BREAK
  922.   lynes.ri=line
  923. END
  924. lynes.0=ri-1
  925. CALL CLOSE(f)
  926. DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),1)='/'
  927. END
  928. lynes.0=ri
  929. RETURN 0
  930.  
  931.  
  932. savelines:
  933. PARSE ARG tempname .
  934. ok=OPEN(f,tempname,'W')
  935. IF ok=0 THEN
  936.   DO
  937.     SAY '***' tempname 'failed to open for saving!'
  938.     RETURN 1
  939.   END
  940. DO wi=1 TO lynes.0
  941.   CALL WRITELN(f,lynes.wi)
  942. END
  943. CALL CLOSE(f)
  944. RETURN 0
  945.  
  946.  
  947. cleanstring:
  948. PARSE ARG nflag':'cstr
  949. IF nflag=1 THEN
  950.   DO
  951.     cstr=COMPRESS(cstr,"'`")
  952.     cstr=TRANSLATE(cstr,,namemask)
  953.     cstr=SPACE(cstr,1,'_')
  954.     RETURN cstr
  955.   END
  956. bot=XRANGE(,'1F'x)
  957. top=XRANGE('7F'x)
  958. cstr=COMPRESS(cstr,bot||top)
  959. IF nflag=0 THEN cstr=STRIP(cstr)
  960. RETURN cstr
  961.  
  962.  
  963. getinput:
  964. PARSE ARG upflag' 'oneflag' 'pline
  965. OPTIONS PROMPT pline
  966. PARSE PULL inarg
  967. inarg=STRIP(inarg)
  968. IF upflag THEN inarg=UPPER(inarg)
  969. IF oneflag THEN inarg=LEFT(inarg,1)
  970. RETURN inarg
  971.  
  972.  
  973. setdir:
  974. PARSE ARG tempdir
  975. CALL PRAGMA('D',STRIP(tempdir))
  976. directory=PRAGMA('D')
  977. slash=LASTPOS('/',directory)
  978. IF slash=0 THEN slash=LASTPOS(':',directory)
  979. plaindir=directory
  980. IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
  981. RETURN
  982.  
  983.  
  984. waiting2:
  985. IF nonstop=1 THEN RETURN 0
  986. waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
  987. IF waitchar='N' THEN
  988.   DO
  989.     nonstop=1
  990.     SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def
  991.     SAY
  992.     CALL DELAY(100)
  993.     waitchar=''
  994.   END
  995. IF waitchar='Q' THEN RETURN 1
  996. RETURN 0
  997.  
  998.  
  999. showtext:
  1000. PARSE ARG arg .
  1001. IF EXISTS(arg) THEN
  1002.   DO
  1003.     CALL readlines(arg 1)
  1004.     CALL seelines(1)
  1005.     nonstop=0
  1006.     CALL waiting()
  1007.   END
  1008. RETURN
  1009.  
  1010.  
  1011. waiting:
  1012. IF waitchar='Q' THEN
  1013.   DO
  1014.     waitchar=''
  1015.     RETURN
  1016.   END
  1017. waitchar=''
  1018. IF nonstop=1 THEN RETURN
  1019. OPTIONS PROMPT pen3'                       RETURN=Continue  'def
  1020. PULL waitchar
  1021. RETURN
  1022.  
  1023.  
  1024. finddirnum:
  1025. ARG fdirname .
  1026. DO fdir=1 TO 99
  1027.   IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
  1028. END
  1029. RETURN 100
  1030.  
  1031.  
  1032. chdir:
  1033. string=''
  1034. SAY pen3||LEFT('-',75,'-')||def
  1035. DO i=1 TO libs.0
  1036.   SAY libs.i
  1037. END
  1038. dirnum=getinput(1 0 pen3'Select Library Number: 'def)
  1039. IF ~DATATYPE(dirnum,'W') THEN
  1040.   DO
  1041.     waitchar=dirnum
  1042.     RETURN 2
  1043.   END
  1044. IF dirnum<1 | dirnum>99 THEN
  1045.   DO
  1046.     waitchar=dirnum
  1047.     RETURN 1
  1048.   END
  1049. IF dirs.dirnum='' THEN
  1050.   DO
  1051.     SAY pen3'That library number is currently un-assigned.'def
  1052.     RETURN 1
  1053.   END
  1054. IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  1055.   DO
  1056.     SAY pen3'You do not have authorization for that library!'def
  1057.     RETURN 1
  1058.   END
  1059. CALL MAKEDIR(libpath||dirs.dirnum)
  1060. CALL setdir(libpath||dirs.dirnum)
  1061. t=libpath||plaindir'.txt'
  1062. IF ~EXISTS(t) THEN RETURN 0
  1063. nonstop=1
  1064. SAY
  1065. CALL readlines(t 1)
  1066. CALL seelines(1)
  1067. SAY
  1068. nonstop=0
  1069. RETURN 0
  1070.  
  1071.  
  1072. seeya:
  1073. IF newlist.0>0 THEN
  1074.   DO
  1075.     IF newlist.0>1 THEN CALL QSort(1,newlist.0,newlist)
  1076.     SAY 'Loading Files.ALPHA...'
  1077.     x=OPEN(f,bbspath'Lists/Files.ALPHA','R')
  1078.     IF x=0 THEN
  1079.       DO
  1080.         SAY 'Unable to open File.ALPHA for reading!'
  1081.         EXIT 666
  1082.       END
  1083.     a.=''
  1084.     DO i=1
  1085.       line=READLN(f)
  1086.       IF EOF(f) THEN LEAVE i
  1087.       a.i=line
  1088.     END
  1089.     CALL CLOSE(f)
  1090.     a.0=i-1
  1091.     CALL DELAY(128)
  1092.     x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
  1093.     IF x=0 THEN
  1094.       DO
  1095.         SAY 'Unable to open File.ALPHA for writing!'
  1096.         EXIT 666
  1097.       END
  1098.     nl=1
  1099.     SAY 'Writing new Files.ALPHA list...'
  1100.     DO i=1 TO a.0
  1101.       IF nl<=newlist.0 THEN
  1102.         DO
  1103.           IF UPPER(newlist.nl)<UPPER(a.i) THEN
  1104.             DO
  1105.               SAY newlist.nl
  1106.               CALL WRITELN(f,newlist.nl)
  1107.               nl=nl+1
  1108.             END
  1109.         END
  1110.       CALL WRITELN(f,a.i)
  1111.     END
  1112.     CALL CLOSE(f)
  1113.     tf=bbspath'Lists/Files.ALPHA.add'
  1114.     IF EXISTS(tf) THEN CALL DELETE(tf)
  1115.     CALL bbsALPHA.rexx(SUBSTR(extension,2) arccom)
  1116.     IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
  1117.     ELSE CALL SETCLIP('BBS_localfiles')
  1118.     IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  1119.     ELSE CALL SETCLIP('BBS_mainfiles')
  1120.   END
  1121. SAY
  1122. SAY 'See ya.'
  1123. SAY
  1124. EXIT
  1125.  
  1126.  
  1127. /* bbsFile.rexx */
  1128.