home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / CO / CO029B.ZIP / CA28-3.ZIP / BBMAINT3.CMD < prev    next >
OS/2 REXX Batch file  |  1991-05-23  |  23KB  |  865 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS file maintenance script (BULLETIN file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT3.CMD, produces the main window for
  8. ;    Bulletin functions of BBMAINT, and implements its functions.  It
  9. ;    is not directly callable itself.
  10. ; -----------------------------------------------------------------------
  11. ;
  12. ;    This script is intended ONLY to be used for FCALL
  13. ;
  14.     IF NOT FCALLED
  15.        WOPEN 10,10,13,70 (cont) NOBUEsc
  16.        ATSAY 10,12 (cont) " BBS Bulletin "
  17.        ATSAY 11,12 (cont) " The script: "*"_SCRIPT"
  18.        ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT"
  19.        ATSAY 13,26 (cont) " Press any key to continue "
  20.        ;
  21.        ;    Wait a keypress
  22.        ;
  23.        KEYGET S0        ; Wait for any key
  24.        WCLOSE        ; Close open window
  25.        EXIT         ; Terminate right here
  26.        ENDIF
  27.     GOSUB Bullfile        ; Invoke function
  28.     FRETURN         ; Return to caller
  29. ; -----------------------------------------------------------------------
  30. ; ----- NoBull:  Inform that there's no BBS-Bull file to modify
  31. ;
  32. NoBull:
  33.     WOPEN 10,10,13,70 (cont) NOBUEsc
  34.     ATSAY 10,12 (cont) " BBS BullDir "
  35.     ATSAY 11,12 (cont) " The file: "*S25&"\BBS-Bull"
  36.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  37.     ATSAY 13,26 (cont) " Press any key to continue "
  38.     ;
  39.     ;    Wait a keypress
  40.     ;
  41.     KEYGET S0        ; Wait for any key
  42.     WCLOSE
  43. NOBUEsc:
  44.     RETURN
  45. ; -----------------------------------------------------------------------
  46. ; ----- Subroutine: BullFile -> Update Bulletin directory
  47. ;
  48. BullFile:
  49.     GOSUB NewBull        ; Create if not there
  50.     IF NOT ISFILE S25&"\BBS-Bull"
  51.        GOSUB NoBull     ; Inform there's no file
  52.        RETURN        ; .. so we can't continue
  53.        ENDIF
  54.  
  55.     WOPEN 0,0 23,79 (defa) Bull_Esc
  56.     ATSAY 0,2 (defa)   " BBS Bulletins "
  57.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  58. BUFI100:
  59.     CLEAR            ; Clear window
  60.     LOCATE 2,2
  61.  
  62.     MESS " 1) Add a bulletin to the list"
  63.     MESS " 2) Delete a bulletin from the list"
  64.     MESS " 3) Modify a bulletin's listing"
  65.     MESS " 4) Print the bulletin list"
  66.     MESS " 5) View the bulletin list"
  67.     MESS "_______________________________________"
  68.     MESS " "
  69.     MESS "Select item (carriage return = previous): "
  70. ;
  71. ;    Wait for entry, and interpret
  72. ;
  73.     GET S0 1        ; Wait for it
  74.     SWITCH S0        ; Act according to keyget
  75.       CASE "1"
  76.            GOSUB AddBull
  77.            ENDCASE
  78.       CASE "2"
  79.            GOSUB DelBull
  80.            ENDCASE
  81.       CASE "3"
  82.            GOSUB ModBull
  83.            ENDCASE
  84.       CASE "4"
  85.            GOSUB PrnBull
  86.            ENDCASE
  87.       CASE "5"
  88.            GOSUB ViewBull
  89.            ENDCASE
  90.       CASE "_NULL"          ; c/r alone is exit
  91.            WCLOSE        ; Close window...
  92.            RETURN        ; and return to caller
  93.            ENDCASE
  94.       DEFAULT        ; None of the above
  95.            SOUND 100,100    ; Bronx cheer
  96.            ENDCASE
  97.       ENDSWITCH
  98.     GOTO BUFI100        ; Repaint screen and ask again
  99. ;
  100. ;    End of bulletin procedure
  101. ;
  102. Bull_Esc:
  103.     S0 = ""                 ; Fake a null entry
  104.     RETURN            ; Leave bulletin routine
  105. ; -----------------------------------------------------------------------
  106. ; ----- AddBUll:  Add a file to the bulletin directory
  107. ;
  108. AddBull:
  109.     SET FLAG(0) OFF     ; Flag for ESCAPE
  110.     WOPEN 10,10,17,75 (cont) ADBUEsc
  111.     ATSAY 10,12 (cont) " BBS Bulletin Add "
  112.     ATSAY 11,12 (cont) "Enter the bulletin number: "
  113.     ATSAY 17,26 (cont) " Press ESC to cancel "
  114.     ;
  115.     ;    Wait a keypress
  116.     ;
  117.     LOCATE 11,42
  118.     GET S0 5        ; get number
  119.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  120.     LJ S0            ; Left justify
  121.     UPPER S0        ; Upper casefy
  122.     IF NULL S0 GOTO ADBUEnd ; get out on empty entry
  123.     GOSUB LkpBull        ; Lookup name in file
  124.     IF FOUND        ; If its there we can't add it
  125.        WCLOSE        ; Close open window
  126.        GOTO ModBU_Add    ; Skip if found
  127.        ENDIF
  128.     S10 = S0        ; Save File name
  129.     GOTO ADBU100        ; And branch around parallel code
  130. ;
  131. ;    Entry from ModBull... Nothing to modify
  132. ;
  133. AddBU_Mod:
  134.     WOPEN 10,10,17,75 (cont) ADBUEsc
  135.     ATSAY 10,12 (cont) " BBS Bulletin Add "
  136.     ATSAY 11,12 (cont) "Enter the bulletin number: "
  137.     ATSAY 11,42 (cont) S0
  138.     ATSAY 17,26 (cont) " Press ESC to cancel "
  139.     S10 = S0        ; Copy it for remainder
  140. ;
  141. ;    Place file date and time in record
  142. ;
  143. ADBU100:
  144.     DATE S1         ; Want mm/dd/yy form
  145.     S10(5:12) = S1        ; Save date added
  146.     ATSAY 12,12 (cont) "Enter the file name:"
  147.     LOCATE 12,42
  148.     GET S0 12        ; get file name
  149.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  150.     LJ S0            ; Left justify
  151.     IF NULL S0
  152.        SOUND 100,100    ; Indicate displeasure
  153.        GOTO ADBU100     ; Try again
  154.        ENDIF
  155.     FFIRST S25&"\"*S0       ; Test for file's existence
  156.     S10(14:25) = S0     ; Save File name
  157.     IF SUCCESS GOTO ADBU200 ; Skip if exists
  158. ;
  159. ;    File does not exist...
  160. ;
  161. ADBU110:
  162.     ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): "
  163.     LOCATE 13,42
  164.     GET S0 1        ; get resp
  165.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  166.     IF NULL S0 or NOT FIND "YN" S0(0)
  167.        SOUND 100,100    ; Indicate displeasure
  168.        GOTO ADBU110     ; Try again
  169.        ENDIF
  170.     IF FIND "N" S0(0)
  171.        WCLOSE        ; Close window
  172.        GOTO AddBull     ; And try again
  173.        ENDIF
  174. ;
  175. ;    Ask for a comment field
  176. ;
  177. ADBU200:
  178.     ATSAY 14,12 (cont) "Description: "
  179.     LOCATE 14,26
  180.     GET S0 40        ; get resp
  181.     LJ S0            ; Left justify
  182.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  183.     IF NULL S0
  184.        SOUND 100,100    ; Indicate displeasure
  185.        GOTO ADBU200     ; Try again
  186.        ENDIF
  187.     S10(26:79) = S0     ; Save comment text
  188. ;
  189. ;    Ask for privileged flag
  190. ;
  191. ADBU250:
  192.     ATSAY 15,12 (cont) "Priveleged access (y/n):  "
  193.     LOCATE 15,42
  194.     GET S0 1        ; get resp
  195.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  196.     IF NULL S0 or NOT FIND "YN" S0(0)
  197.        SOUND 100,100    ; Indicate displeasure
  198.        GOTO ADBU250     ; Try again
  199.        ENDIF
  200.     IF FIND "Y" S0(0) S10(13:13) = "P" ; Save priveleged access
  201. ;
  202. ;    Ask for one more look
  203. ;
  204. ADBU300:
  205.     ATSAY 16,12 (cont) "OK to add this record?:   "
  206.     LOCATE 16,42
  207.     GET S0 1        ; get resp
  208.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  209.     IF NULL S0 or NOT FIND "YN" S0(0)
  210.        SOUND 100,100    ; Indicate displeasure
  211.        GOTO ADBU300     ; Try again
  212.        ENDIF
  213.     IF FIND "N" S0(0)
  214.        WCLOSE        ; Close window
  215.        GOTO AddBull     ; And try again
  216.        ENDIF
  217. ;
  218. ;    Write the record
  219. ;
  220.     GOSUB AddBRec        ; Write to Bulletins file
  221. ;
  222. ;    End of add procedure
  223. ;
  224. ADBUEnd:
  225.     WCLOSE
  226. ADBUEsc:
  227.     SET FLAG(0) ON
  228.     RETURN
  229. ; -----------------------------------------------------------------------
  230. ; ----- AddBRec:  Add a record to the Bulletin file...
  231. ;    .. S10 passes the record to be written
  232. ;
  233. AddBRec:
  234.     FOPENO S25&"\BBS-bull" TEXT APPEND
  235.     IF NOT SUCCESS        ; Open failed
  236.        S0 = "Error opening: "*S25&"\BBS-Bull"
  237.        GOSUB Error        ; Report
  238.        RETURN        ; And we're done
  239.        ENDIF
  240.     PRESERVE S10        ; Preserve ^'s and !'s
  241.     WRITE S10        ; Write the record
  242.     WRITE "!^Z"             ; And finish it
  243.     FCLOSEO
  244.     RETURN
  245. ; -----------------------------------------------------------------------
  246. ; ----- LkpFile:  Lookup a file in the BBS-Bull file
  247. ;    .. S0 passes the fname to be tested
  248. ;    .. S10 returns the record read
  249. ;
  250. LkpBull:
  251.     FOPENI S25&"\BBS-Bull" TEXT
  252.     IF NOT SUCCESS        ; Open failed
  253.        S0 = "Error opening: "*S25&"\BBS-Bull"
  254.        GOSUB Error        ; Report
  255.        SET FOUND OFF    ; Not found
  256.        RETURN        ; And we're done
  257.        ENDIF
  258. ;
  259. ;    Read loop
  260. ;
  261. LOBU100:
  262.     READ S10 80 N0        ; Read a record
  263.     IF EOF GOTO LOBU200    ; Skip on EOF
  264.     IF STRCMP S10(0:0) "*" GOTO LOBU110
  265.     IF STRCMP S10(0:4) S0(0:4) GOTO LOBU300
  266. ;
  267. ;    Record longer than 80 chars
  268. ;
  269. LOBU110:
  270.     IF N0 LT 80 GOTO LOBU100; If exactly 80 rtnd, c/r wasn't read
  271.     READ S10 80 N0        ; Read remainder of rec
  272.     GOTO LOBU110        ; Read until less than 80
  273. ;
  274. ;    We have end-of-file - not found
  275. ;
  276. LOBU200:
  277.     SET FOUND OFF        ; Indicate not found
  278.     GOTO LOBUEnd
  279. ;
  280. ;    We have a hit - return found
  281. ;
  282. LOBU300:
  283.     SET FOUND ON        ; Indicate found
  284. ;
  285. ;    And exit
  286. ;
  287. LOBUEnd:
  288.     FCLOSEI
  289.     RETURN
  290. ; -----------------------------------------------------------------------
  291. ; ----- DelBull:  Delete a file from Bulletin file
  292. ;
  293. DelBull:
  294.     SET FLAG(0) OFF     ; Flag for ESCAPE
  295.     WOPEN 10,10,15,70 (cont) DEBUEsc
  296.     ATSAY 10,12 (cont) " BBS Bulletin Delete "
  297.     ATSAY 11,12 (cont) "Enter bulletin number to del: "
  298.     ATSAY 15,26 (cont) " Press ESC to cancel "
  299.     ;
  300.     ;    Wait a keypress
  301.     ;
  302.     LOCATE 11,42
  303.     GET S0 5        ; get resp
  304.     IF FLAG(0) GOTO DEBUEnd ; Exit if ESC hit
  305.     LJ S0            ; Left justify
  306.     UPPER S0        ; Upper casefy
  307.     IF NULL S0 GOTO DEBUEnd ; get out on empty entry
  308. ;
  309. ;    Open the Bulletin file and a temp copy file
  310. ;
  311.     GOSUB DelBRec        ; Try to delete a record
  312.     IF FLAG(1) GOTO DEBUEnd ; Skip if record deleted
  313.     ATSAY 12,12 (cont) "Bulletin not in listing...     "
  314.     ATSAY 13,12 (cont) "Press any key to continue..."
  315.     KEYGET S0
  316. ;
  317. ;    End of add procedure
  318. ;
  319. DEBUEnd:
  320.     WCLOSE
  321. DEBUEsc:
  322.     SET FLAG(0) ON
  323.     RETURN
  324. ; -----------------------------------------------------------------------
  325. ; ----- DelBRec:  Delete a record from the Bulletin file...
  326. ;    .. S0 passes the bulletin number key
  327. ;    .. S1 destroyed in the process
  328. ;    .. FLAG(1) if rtn'd set, indicates record was FOUND
  329. ;
  330. DelBRec:
  331. ;
  332. ;    Open the Bulletin file and a temp copy file
  333. ;
  334.     SET FLAG(1)  OFF    ; Initialize for found flag
  335.     FOPENI S25&"\BBS-Bull" TEXT
  336.     IF NOT SUCCESS        ; Open failed
  337.        S0 = "Error opening: "*S25&"\BBS-Bull"
  338.        GOSUB Error        ; Report
  339.        GOTO DEBREnd     ; And we're done
  340.        ENDIF
  341.  
  342.     FOPENO S25&"\TempBull" TEXT
  343.     IF NOT SUCCESS        ; Open failed
  344.        S0 = "Error opening: "*S25&"\TempBull"
  345.        GOSUB Error        ; Report
  346.        GOTO DEBREnd     ; And we're done
  347.        ENDIF
  348.     N10 = 0         ; COunt recs written
  349. ;
  350. ;    Read records (40 chars at a time to allow PRESERVE)
  351. ;
  352. DEBR100:
  353.     READ S1 40 N0        ; Read 1st 40 chars
  354.     IF EOF GOTO DEBR300    ; Skip on EOF
  355.     IF STRCMP S1(0:4) S0(0:4) GOTO DEBR200
  356.     INC N10         ; COunt rec written
  357. ;
  358. ;    Copy the record read to the output file
  359. ;
  360. DEBR110:
  361.     PRESERVE S1        ; Save !'s and ^'s
  362.     WRITE S1        ; Write text
  363.  
  364.     IF N0 LT 40        ; If we wrote end of record
  365.        WRITE "!"            ; Finish w/cr/lf
  366.        GOTO DEBR100     ; And continue copying
  367.        ENDIF
  368.     READ S1 40 N0        ; Read remainder of rec
  369.     IF NOT EOF GOTO DEBR110 ; Skip if not eof
  370.     WRITE "!"               ; Finish record
  371.     GOTO DEBR300        ; End of file
  372. ;
  373. ;    We have a hit
  374. ;
  375. DEBR200:
  376.     SET FLAG(1) ON        ; Flag we deleted item
  377.     IF N0 LT 40 GOTO DEBR100
  378.     READ S1 40 N0        ; Read remainder of rec
  379.     IF NOT EOF GOTO DEBR200 ; Skip if not found
  380. ;
  381. ;    We hit EOF - may or may not have found the target rec
  382. ;
  383. DEBR300:
  384.     IF NOT FLAG(1) GOTO DEBR400 ; skip if not found
  385.     WRITE "^Z"              ; Finish ASCII file
  386.     FCLOSEO         ; Close output
  387.     FCLOSEI         ; Close input
  388.     DELETE S25&"\BBS-Bull"  ; Delete original
  389.     RENAME S25&"\TempBull" S25&"\BBS-Bull"
  390.     IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file
  391.     GOTO DEBREnd
  392. ;
  393. ;    We hit EOF - we did not find the record
  394. ;
  395. DEBR400:
  396.     FCLOSEO         ; Close output
  397.     FCLOSEI         ; Close input
  398.     DELETE S25&"\TempBull"  ; Delete copy file
  399. ;
  400. ;    End of procedure...
  401. ;
  402. DEBREnd:
  403.     RETURN
  404. ; -----------------------------------------------------------------------
  405. ; ----- ModBull:  Modify a record in the bulletin file
  406. ;
  407. ModBull:
  408.     SET FLAG(0) OFF     ; Flag for ESCAPE
  409.     WOPEN 10,10,18,75 (cont) MOBUEsc
  410.     ATSAY 10,12 (cont) " BBS Bulletin Modify "
  411.     ATSAY 11,12 (cont) "Enter number to change: "
  412.     ATSAY 18,26 (cont) " Press ESC to cancel "
  413.     ;
  414.     ;    Wait a keypress
  415.     ;
  416.     LOCATE 11,42
  417.     GET S0 5        ; get resp
  418.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  419.     LJ S0            ; Left justify
  420.     UPPER S0        ; Upper case
  421.     IF NULL S0 GOTO MOBUEnd ; get out on empty entry
  422.     GOSUB LkpBull        ; Lookup in Bulletin file
  423.     IF NOT FOUND        ; If its there we can't add it
  424.        WCLOSE        ; Close open window
  425.        GOTO AddBU_Mod    ; Skip if NOT found
  426.        ENDIF
  427.     GOTO MOBU100        ; And branch around parallel code
  428. ;
  429. ;    Entry from AddBull... We have a rec in S10 - needs adding
  430. ;
  431. ModBU_Add:
  432.     WOPEN 10,10,18,75 (cont) MOBUEsc
  433.     ATSAY 10,12 (cont) " BBS Bulletin Modify "
  434.     ATSAY 11,12 (cont) "Enter number to be changed: "
  435.     ATSAY 11,42 (cont) S0
  436.     ATSAY 18,26 (cont) " Press ESC to cancel "
  437. ;
  438. ;    Display the original values (rtnd in S10 by LkpBull)
  439. ;
  440. MOBU100:
  441.     ATSAY 10,54 (cont) " Old vals "
  442.     ATSAY 11,55 (cont) S10(0:4)    ; Num
  443.     ATSAY 12,55 (cont) S10(14:25)    ; Fname
  444.     ATSAY 15,26 (cont) S10(26:65)    ; Description
  445.     IF NOT NULL S10(13:13)
  446.        ATSAY 16,55 (cont) "y"
  447.     ELSE
  448.        ATSAY 16,55 (cont) "n"
  449.        ENDIF
  450. ;
  451. ;    Ask for a file name (containing the bulletin)
  452. ;
  453. MOBU110:
  454.     DATE S1         ; Want mm/dd/yy form
  455.     S10(5:12) = S1        ; Save date mod'd
  456.     ATSAY 12,12 (cont) "Enter the file name:"
  457.     LOCATE 12,42
  458.     GET S0 12        ; get file name
  459.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  460.     LJ S0            ; Left justify
  461.     IF NULL S0 GOTO MOBU200 ; Skip if null entry
  462.     FFIRST S25&"\"*S0       ; Test for file's existence
  463.     S10(14:25) = S0     ; Save File name
  464.     IF SUCCESS GOTO MOBU200 ; Skip if exists
  465. ;
  466. ;    File does not exist...
  467. ;
  468. MOBU120:
  469.     ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): "
  470.     LOCATE 13,42
  471.     GET S0 1        ; get resp
  472.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  473.     IF NULL S0 or NOT FIND "YN" S0(0)
  474.        SOUND 100,100    ; Indicate displeasure
  475.        GOTO MOBU120     ; Try again
  476.        ENDIF
  477.     IF FIND "N" S0(0)
  478.        WCLOSE        ; Close window
  479.        GOTO ModBull     ; And try again
  480.        ENDIF
  481. ;
  482. ;    Ask for a comment field
  483. ;
  484. MOBU200:
  485.     ATSAY 14,12 (cont) "Description: "
  486.     LOCATE 14,26
  487.     GET S0 40        ; get resp
  488.     LJ S0            ; Left justify
  489.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  490.     IF NULL S0        ; If null entry...
  491.        ATSAY 14,26 (cont) S10(26:65)
  492.        GOTO MOBU250     ; Skip store
  493.        ENDIF
  494.     S10(26:79) = S0     ; Save comment text
  495. ;
  496. ;    Ask for privileged flag
  497. ;
  498. MOBU250:
  499.     ATSAY 16,12 (cont) "Priveleged access (y/n):  "
  500.     LOCATE 16,42
  501.     GET S0 1        ; get resp
  502.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  503.     IF NULL S0 ATSCR 16,55 1 S0 ; Read back previous value
  504.     IF NOT FIND "YN" S0(0)  ; If not y/n
  505.        SOUND 100,100    ; Indicate displeasure
  506.        GOTO MOBU250     ; Try again
  507.        ENDIF
  508.     S10(13:13) = " "        ; Default no priv
  509.     IF FIND "Y" S0(0)       ; If privilege 'y'
  510.        S10(13:13) = "P"     ; Set priveleged access
  511.        ENDIF
  512. ;
  513. ;    Ask for one more look
  514. ;
  515. MOBU300:
  516.     ATSAY 17,12 (cont) "OK to add this record?:   "
  517.     LOCATE 17,42
  518.     GET S0 1        ; get resp
  519.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  520.     IF NULL S0 or NOT FIND "YN" S0(0)
  521.        SOUND 100,100    ; Indicate displeasure
  522.        GOTO MOBU300     ; Try again
  523.        ENDIF
  524.     IF FIND "N" S0(0)
  525.        WCLOSE        ; Close window
  526.        GOTO ModBull     ; And try again
  527.        ENDIF
  528. ;
  529. ;    Delete the previous value... and add the new
  530. ;    .. Could do a Delete/add but don't want file re-ordered
  531. ;
  532.     GOSUB ModBRec        ; Modify the record in S10
  533.     IF NOT FLAG(1)        ; If not deleted
  534.        S0 = "Error modifying bulletin: "*S0
  535.        GOSUB Error        ; Report
  536.        GOTO MOBUEnd     ; And we're done
  537.        ENDIF
  538. ;
  539. ;    End of add procedure
  540. ;
  541. MOBUEnd:
  542.     WCLOSE
  543. MOBUEsc:
  544.     SET FLAG(0) ON
  545.     RETURN
  546. ; -----------------------------------------------------------------------
  547. ; ----- ModBRec:  Modify a record from the Files file...
  548. ;    .. S10 passes the new record (same file name key)
  549. ;    .. S1 destroyed in the process
  550. ;
  551. ModBRec:
  552. ;
  553. ;    Open the Files file and a temp copy file
  554. ;
  555.     SET FLAG(1)  OFF    ; Initialize for found flag
  556.     FOPENI S25&"\BBS-Bull" TEXT
  557.     IF NOT SUCCESS        ; Open failed
  558.        S0 = "Error opening: "*S25&"\BBS-Bull"
  559.        GOSUB Error        ; Report
  560.        GOTO MOBREnd     ; And we're done
  561.        ENDIF
  562.  
  563.     FOPENO S25&"\TempFile" TEXT
  564.     IF NOT SUCCESS        ; Open failed
  565.        S0 = "Error opening: "*S25&"\TempFile"
  566.        GOSUB Error        ; Report
  567.        GOTO MOBREnd     ; And we're done
  568.        ENDIF
  569.     N10 = 0         ; Count recs written
  570. ;
  571. ;    Read records (40 chars at a time to allow PRESERVE)
  572. ;
  573. MOBR100:
  574.     READ S1 40 N0        ; Read 1st 40 chars
  575.     IF EOF GOTO MOBR300    ; Skip on EOF
  576.     IF STRCMP S1(0:4) S10(0:4) GOTO MOBR200
  577.     INC N10
  578. ;
  579. ;    Copy the record read to the output file
  580. ;
  581. MOBR110:
  582.     PRESERVE S1        ; Save !'s and ^'s
  583.     WRITE S1        ; Write text
  584.  
  585.     IF N0 LT 40        ; If we wrote end of record
  586.        WRITE "!"            ; Finish w/cr/lf
  587.        GOTO MOBR100     ; And continue copying
  588.        ENDIF
  589.     READ S1 40 N0        ; Read remainder of rec
  590.     IF NOT EOF GOTO MOBR110 ; Skip if not eof
  591.     WRITE "!"               ; Finish record
  592.     GOTO MOBR300        ; End of file
  593. ;
  594. ;    We have a match on the key.
  595. ;
  596. MOBR200:
  597.     SET FLAG(1) ON        ; Flag we deleted item
  598.     S1 = S10(0:39)        ; Take 1st part of rec to write
  599.     PRESERVE S1        ; Save !s and ^s
  600.     WRITE S1        ; Write text
  601.  
  602.     LENGTH S10 N1        ; Get new rec length
  603.     IF N1 LT 40 GOTO MOBR210
  604.  
  605.     S1 = S10(40:79)     ; Take 2nd part of rec to write
  606.     PRESERVE S1        ; Save !s and ^s
  607.     WRITE S1        ; Write text
  608. ;
  609. ;    Finish the new record
  610. ;
  611. MOBR210:
  612.     WRITE "!"               ; Finish record
  613. ;
  614. ;    Finish reading the original record
  615. ;
  616. MOBR220:
  617.     IF N0 LT 40 GOTO MOBR100
  618.     READ S1 40 N0        ; Read remainder of rec
  619.     IF NOT EOF GOTO MOBR220 ; Skip if not found
  620. ;
  621. ;    We hit EOF - may or may not have found the target rec
  622. ;
  623. MOBR300:
  624.     IF NOT FLAG(1) GOTO MOBR200 ; skip if not found
  625.     WRITE "^Z"              ; Finish ASCII file
  626.     FCLOSEO         ; Close output
  627.     FCLOSEI         ; Close input
  628.     DELETE S25&"\BBS-Bull"  ; Delete original
  629.     RENAME S25&"\TempFile" S25&"\BBS-Bull"
  630.     IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file
  631. ;
  632. ;    End of procedure...
  633. ;
  634. MOBREnd:
  635.     RETURN
  636. ; -----------------------------------------------------------------------
  637. ; ----- PrnBull:  Print a list of bulletins
  638. ;
  639. PrnBull:
  640.     FOPENI S25&"\BBS-Bull" TEXT
  641.     IF NOT SUCCESS        ; Open failed
  642.        S0 = "Error opening: "*S25&"\BBS-Bull"
  643.        GOSUB Error        ; Report
  644.        RETURN        ; And we're done
  645.        ENDIF
  646. ;
  647. ;    Initialize a counter
  648. ;
  649.     N10 = 0         ; # Lines printed
  650.     N11 = 1         ; Page number
  651. ;
  652. ;    Read loop
  653. ;
  654. PRBU100:
  655.     READ S10 80 N0        ; Read a record
  656.     IF EOF GOTO PRBU200    ; Skip on EOF
  657.     IF STRCMP S10(0:0) "<" GOTO PRBU120 ; skip comments
  658.     IF ZERO N0 GOTO PRBU100 ; skip blank lines
  659. ;
  660. ;    Print a heading...
  661. ;
  662.     IF N10 GT 0 and N10 LE 50 GOTO PRBU110
  663.     PRINT "COM-AND Scripted BBS Bulletin list as of "*"_DATE"*", "*"_TIME"*"      Page "*N11*"^M^J"
  664.     PRINT "From: "*"_IFILE"*"^M^J"
  665.     PRINT "--------------------------------------------------------------------------^M^J"
  666.     PRINT "Numbr File         Priv Description^M^J"
  667.     PRINT "----- ------------ ---- --------------------------------------------------^M^J"
  668.     N10 = 0
  669.     INC N11
  670. ;
  671. ;    Build a record and print it
  672. ;
  673. PRBU110:
  674.     S0 = S10(0:4)        ; Number Field
  675.     S0(6:17) = S10(14:25)    ; Fname  Field
  676.     IF NOT NULL S10(13:13) S0(20:22) = "yes"
  677.     S0(24:79)  = S10(26:79) ; Description
  678.     PRESERVE S0
  679.     PRINT S0
  680.     PRINT "^M^J"            ; Finish line
  681.     INC N10         ; COunt lines printed
  682. ;
  683. ;    Handle record longer than 80 chars
  684. ;
  685. PRBU120:
  686.     IF N0 LT 80 GOTO PRBU100; If exactly 80 rtnd, c/r wasn't read
  687.     READ S10 80 N0        ; Read remainder of rec
  688.     GOTO PRBU120        ; Read until less than 80
  689. ;
  690. ;    We have end-of-file
  691. ;
  692. PRBU200:
  693.     PRINT "^L"              ; Do a final top-of-form
  694. ;
  695. ;    And exit
  696. ;
  697. PRBUEnd:
  698.     FCLOSEI
  699.     RETURN
  700. ; -----------------------------------------------------------------------
  701. ; ----- ViewBull: View a list of bulletins
  702. ;
  703. ViewBull:
  704.     FOPENI S25&"\BBS-Bull" TEXT
  705.     IF NOT SUCCESS        ; Open failed
  706.        S0 = "Error opening: "*S25&"\BBS-Bull"
  707.        GOSUB Error        ; Report
  708.        RETURN        ; And we're done
  709.        ENDIF
  710. ;
  711. ;    Initialize a counter
  712. ;
  713.     N10 = 0         ; # Lines printed
  714.     N11 = 0         ; Page number
  715.     SET FLAG(0) OFF     ; Initialize esc flag
  716.     S11 = "_ONESC"
  717.     ON ESCAPE GOSUB VIBUESC
  718. ;
  719. ;    Print a heading...
  720. ;
  721. VIBU100:
  722.     IF N10 GT 0 GOTO VIBU110
  723.     CLEAR            ; Clear the window
  724.     ATSAY 1,2 (defa) "Numbr File         Priv Description"
  725.     ATSAY 2,2 (defa) "----- ------------ ---- --------------------------------------------------"
  726.     N10 = 3         ; Set starting line no
  727.     INC N11         ; Set next page
  728. ;
  729. ;    Save the file position for the start of this page
  730. ;
  731.     FSAVEI
  732.     IF NOT SUCCESS
  733.        FSAVEI SHIFT     ; Save last 20 pos'ns
  734.        FSAVEI
  735.        ENDIF
  736. ;
  737. ;    Read loop
  738. ;
  739. VIBU110:
  740.     READ S10 80 N0        ; Read a record
  741.     IF EOF GOTO VIBU200    ; Skip on EOF
  742.     IF STRCMP S10(0:0) "<" GOTO VIBU120 ; skip comments
  743.     IF ZERO N0 GOTO VIBU110 ; skip blank lines
  744. ;
  745. ;    Build a record and print it
  746. ;
  747.     S0 = S10(0:4)        ; Number Field
  748.     S0(6:17) = S10(14:25)    ; Fname  Field
  749.     IF NOT NULL S10(13:13) S0(20:22) = "yes"
  750.     S0(24:74)  = S10(26:79) ; Description
  751.     PRESERVE S0
  752.     ATSAY N10,2 (defa) S0
  753.     INC N10         ; COunt lines printed
  754. ;
  755. ;    Handle record longer than 80 chars
  756. ;
  757. VIBU120:
  758.     IF N0 LT 80 GOTO VIBU200; If exactly 80 rtnd, c/r wasn't read
  759.     READ S10 80 N0        ; Read remainder of rec
  760.     GOTO VIBU120        ; Read until less than 80
  761. ;
  762. ;    Look for end of screen/end of file
  763. ;
  764. VIBU200:
  765.     IF (NOT EOF) and N10 LT 21 GOTO VIBU100
  766.     IF EOF
  767.        ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)"
  768.     ELSE
  769.        ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)"
  770.        ENDIF
  771. ;
  772. ;    Read a key and interpret
  773. ;
  774. VIBU210:
  775.     IF FLAG(0) RETURN    ; End of routine when flag set
  776.     KEYGET S1
  777.     IF FLAG(0) RETURN    ; End of routine when flag set
  778.     SWITCH S1
  779.       CASE "4900"           ; Pgup
  780.         GOTO PgUp
  781.         ENDCASE
  782.       CASE "5100"           ; PgDn
  783.         GOTO PgDn
  784.         ENDCASE
  785.       CASE "4700"           ; Home
  786.         GOTO Home
  787.         ENDCASE
  788.       CASE "0D"             ; C/r
  789.         IF EOF GOTO VIBUEnd
  790.         GOTO PgDn
  791.         ENDCASE
  792.       ENDSWITCH
  793.     MESS S1
  794.     SOUND 100,100
  795.     GOTO VIBU210
  796. ;
  797. ;    Page up (go backwards)
  798. ;
  799. PgUp:
  800.     N10 = 0         ; Clear line ctr
  801.     FRESTOREI        ; Backup current pg
  802.     N11 = N11-1        ; Reset Page # for redisplay
  803.     FRESTOREI        ; Backup one more
  804.     IF NOT SUCCESS
  805.        SOUND 200,100    ; Indicate problem
  806.        GOTO Home
  807.        ENDIF
  808.     N11 = N11-1        ; Reset Page # for redisplay
  809.     GOTO VIBU100
  810. ;
  811. ;    Home (go to top)
  812. ;
  813. Home:
  814.     N10 = 0         ; Clear line ctr
  815.     N11 = 0         ; Set new pg number
  816.     FSAVEI CLEAR        ; Clear saved pages
  817.     REWIND            ; Rewind input
  818.     GOTO VIBU100
  819. ;
  820. ;    Page down (go forwards)
  821. ;
  822. PgDn:
  823.     IF EOF GOTO Home    ; Wrap to home at EOF
  824.     N10 = 0         ; Clear line ctr
  825.     GOTO VIBU100
  826. ;
  827. ;    And exit
  828. ;
  829. VIBUEnd:
  830.     FCLOSEI
  831.     RETURN
  832. ;
  833. ;    Escape entered
  834. ;
  835. VIBUESC:
  836.     SET FLAG(0) ON
  837.     ON ESCAPE GOSUB S11    ; Restore previous ON ESC
  838.     RETURN
  839. ; -----------------------------------------------------------------------
  840. ; ----- Subroutine: NewBull -> Create a new BBS-Bull file
  841. ;
  842. NewBull:
  843.     IF ISFILE S25&"\BBS-Bull" RETURN
  844.     FOPENO S25&"\BBS-Bull" TEXT
  845.     IF NOT SUCCESS RETURN    ; Open failed
  846.     WRITE "!^Z"             ; Make it empty
  847.     FCLOSEO         ; Done with it
  848.     RETURN
  849. ; -----------------------------------------------------------------------
  850. ; ----- Error:    Open a window, display a message, and wait for keypress
  851. ;    S0 passes the error message
  852. ;
  853. Error:
  854.     WOPEN 10,10,12,70 (cont) Err_Esc
  855.     ATSAY 10,12 (cont) " Error "
  856.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  857.     ATSAY 12,26 (cont) " Press any key to continue "
  858.     ;
  859.     ;    Wait a keypress
  860.     ;
  861.     KEYGET S0        ; Wait for any key
  862.     WCLOSE
  863. Err_Esc:
  864.     RETURN
  865.