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