home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / HILFEN / MODEM / COMAND28 / BBMAINT1.CMD < prev    next >
OS/2 REXX Batch file  |  1993-12-01  |  18KB  |  710 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS UserID maintenance script (User file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT1.CMD, produces the main window for
  8. ;    UserID 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) NOUSEsc
  16.        ATSAY 10,12 (cont) " BBS Users "
  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.        KEYGET S0        ; Wait for any key
  21.        WCLOSE        ; Close open window
  22.        EXIT         ; Terminate right here
  23.        ENDIF
  24.  
  25.     GOSUB UserFile        ; Invoke function
  26.     FRETURN         ; Return to caller
  27. ; -----------------------------------------------------------------------
  28. ; ----- NoUser:  Inform that there's no USER ID file to modify
  29. ;
  30. NoUser:
  31.     WOPEN 10,10,13,70 (cont) NOUSEsc
  32.     ATSAY 10,12 (cont) " BBS User "
  33.     ATSAY 11,12 (cont) " The file: "*S22&"\BBS-User"
  34.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  35.     ATSAY 13,26 (cont) " Press any key to continue "
  36.     ;
  37.     ;    Wait a keypress
  38.     ;
  39.     KEYGET S0        ; Wait for any key
  40.     WCLOSE
  41. NOUSEsc:
  42.     RETURN
  43. ; -----------------------------------------------------------------------
  44. ; ----- Subroutine: UserFile -> Update user ID directory
  45. ;
  46. UserFile:
  47.     GOSUB NewUser        ; Create if not there
  48.     IF NOT ISFILE S22&"\BBS-USER"
  49.        GOSUB NoUser     ; Inform there's no file
  50.        RETURN        ; .. so we can't continue
  51.        ENDIF
  52.  
  53.     WOPEN 0,0 23,79 (defa) User_Esc
  54.     ATSAY 0,2 (defa)   " BBS Users "
  55.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  56. USFI100:
  57.     CLEAR            ; Clear window
  58.     LOCATE 2,2
  59.  
  60.     MESS " 1) Add an ID"
  61.     MESS " 2) Delete an ID"
  62.     MESS " 3) Modify an ID's values"
  63.     MESS " 4) Print User list"
  64.     MESS " 5) View list of IDs"
  65.     MESS "_______________________________________"
  66.     MESS " "
  67.     MESS "Select item (carriage return = previous): "
  68. ;
  69. ;    Wait for entry, and interpret
  70. ;
  71.     GET S0 1        ; Wait for it
  72.     SWITCH S0        ; Act according to keyget
  73.       CASE "1"
  74.            GOSUB AddID
  75.            ENDCASE
  76.       CASE "2"
  77.            GOSUB DelID
  78.            ENDCASE
  79.       CASE "3"
  80.            GOSUB ModID
  81.            ENDCASE
  82.       CASE "4"
  83.            GOSUB PrnID
  84.            ENDCASE
  85.       CASE "5"
  86.            GOSUB ViewID
  87.            ENDCASE
  88.       CASE "_NULL"          ; c/r alone is exit
  89.            WCLOSE        ; Close window...
  90.            RETURN        ; and return to caller
  91.            ENDCASE
  92.       DEFAULT        ; None of the above
  93.            SOUND 100,100    ; Bronx cheer
  94.            ENDCASE
  95.       ENDSWITCH
  96.     GOTO USFI100        ; Repaint screen and ask again
  97. ;
  98. ;    End of Users procedure
  99. ;
  100. User_Esc:
  101.     S0 = ""                 ; Fake a nulll entry
  102.     RETURN            ; Leave users routine
  103. ; -----------------------------------------------------------------------
  104. ; ----- AddID:    Add an ID to the User file
  105. ;
  106. AddID:
  107.     SET FLAG(0) OFF     ; Flag for ESCAPE
  108.     WOPEN 10,10,15,70 (cont) ADIDEsc
  109.     ATSAY 10,12 (cont) " BBS User Add "
  110.     ATSAY 11,12 (cont) "Enter the ID to be added: "
  111.     ATSAY 15,26 (cont) " Press ESC to cancel "
  112.     ;
  113.     ;    Wait a keypress
  114.     ;
  115.     LOCATE 11,38
  116.     GET S0 8        ; get ID
  117.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  118.     LJ S0            ; Left justify
  119.     UPPER S0        ; ... and upper case
  120.     IF NULL S0 GOTO ADIDEnd ; get out on empty entry
  121.     GOSUB LkpID        ; Lookup ID in User file
  122.     IF FOUND        ; If its there we can't add it
  123.        WCLOSE        ; Close open window
  124.        GOTO ModID_Add    ; Skip if ID found
  125.        ENDIF
  126.     S10 = S0        ; Save ID
  127.     GOTO ADID100        ; And branch around parallel code
  128. ;
  129. ;    Entry from ModID... Nothing to modify
  130. ;
  131. AddID_Mod:
  132.     WOPEN 10,10,15,70 (cont) ADIDEsc
  133.     ATSAY 10,12 (cont) " BBS User Add "
  134.     ATSAY 11,12 (cont) "Enter the ID to be added: "
  135.     ATSAY 11,38 (cont) S0
  136.     ATSAY 15,26 (cont) " Press ESC to cancel "
  137.     S10 = S0        ; Copy it for remainder
  138. ;
  139. ;    Ask for a password
  140. ;
  141. ADID100:
  142.     ATSAY 12,12 (cont) "Enter the password:       "
  143.     LOCATE 12,38
  144.     GET S0 8        ; get resp
  145.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  146.     LJ S0            ; Left justify
  147.     UPPER S0        ; ... and upper case
  148.     IF NULL S0        ; Password MUST be filled in
  149.        SOUND 100,100    ; Indicate displeasure
  150.        GOTO ADID100     ; Try again
  151.        ENDIF
  152.     S10(8:15) = S0        ; Save password
  153. ;
  154. ;    Ask for privileged flag
  155. ;
  156. ADID200:
  157.     ATSAY 13,12 (cont) "Priveleged access (y/n):  "
  158.     LOCATE 13,38
  159.     GET S0 1        ; get resp
  160.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  161.     IF NULL S0 or NOT FIND "YN" S0(0)
  162.        SOUND 100,100    ; Indicate displeasure
  163.        GOTO ADID200     ; Try again
  164.        ENDIF
  165.     IF FIND "Y" S0(0) S10(16:16) = "P" ; Save priveleged access
  166. ;
  167. ;    Ask for one more look
  168. ;
  169. ADID300:
  170.     ATSAY 14,12 (cont) "OK to add this record?:   "
  171.     LOCATE 14,38
  172.     GET S0 1        ; get resp
  173.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  174.     IF NULL S0 or NOT FIND "YN" S0(0)
  175.        SOUND 100,100    ; Indicate displeasure
  176.        GOTO ADID300     ; Try again
  177.        ENDIF
  178.     IF FIND "N" S0(0)
  179.        WCLOSE        ; Close window
  180.        GOTO AddID        ; And try again
  181.        ENDIF
  182. ;
  183. ;    Add comments and write the record
  184. ;
  185.     S10(17:70) = "* Added "*"_DATE"*", at "*"_TIME"
  186.     GOSUB AddUser        ; Write to User file
  187. ;
  188. ;    End of add procedure
  189. ;
  190. ADIDEnd:
  191.     WCLOSE
  192. ADIDEsc:
  193.     SET FLAG(0) ON
  194.     RETURN
  195. ;
  196. ; ----- AddUser:  Add a record to the user file...
  197. ;    .. S10 passes the record to be written
  198. ;
  199. AddUser:
  200.     FOPENO S22&"\BBS-User" TEXT APPEND
  201.     IF NOT SUCCESS        ; Open failed
  202.        S0 = "Error opening: "*S22&"\BBS-User"
  203.        GOSUB Error        ; Report
  204.        RETURN        ; And we're done
  205.        ENDIF
  206.     PRESERVE S10        ; Preserve ^'s and !'s
  207.     WRITE S10        ; Write the record
  208.     WRITE "!^Z"             ; And finish it
  209.     FCLOSEO
  210.     RETURN
  211. ; -----------------------------------------------------------------------
  212. ; ----- LkpID:    Lookup an ID in the BBS-User file
  213. ;    .. S0 passes the ID to be tested
  214. ;    .. S10 returns the record read
  215. ;
  216. LkpID:
  217.     FOPENI S22&"\BBS-User" TEXT
  218.     IF NOT SUCCESS        ; Open failed
  219.        S0 = "Error opening: "*S22&"\BBS-User"
  220.        GOSUB Error        ; Report
  221.        SET FOUND OFF    ; Not found
  222.        RETURN        ; And we're done
  223.        ENDIF
  224. ;
  225. ;    Read loop
  226. ;
  227. LOID100:
  228.     READ S10 80 N0        ; Read a record
  229.     IF EOF GOTO LOID200    ; Skip on EOF
  230.     IF STRCMP S10(0:0) "<" GOTO LOID110
  231.     IF STRCMP S10(0:7) S0(0:7) GOTO LOID300
  232. ;
  233. ;    Record longer than 80 chars
  234. ;
  235. LOID110:
  236.     IF N0 LT 80 GOTO LOID100; If exactly 80 rtnd, c/r wasn't read
  237.     READ S10 80 N0        ; Read remainder of rec
  238.     GOTO LOID110        ; Read until less than 80
  239. ;
  240. ;    We have end-of-file - not found
  241. ;
  242. LOID200:
  243.     SET FOUND OFF        ; Indicate not found
  244.     GOTO LOIDEnd
  245. ;
  246. ;    We have a hit - return found
  247. ;
  248. LOID300:
  249.     SET FOUND ON        ; Indicate found
  250. ;
  251. ;    And exit
  252. ;
  253. LOIDEnd:
  254.     FCLOSEI
  255.     RETURN
  256. ; -----------------------------------------------------------------------
  257. ; ----- DelID:    Delete an ID from User file
  258. ;
  259. DelID:
  260.     SET FLAG(0) OFF     ; Flag for ESCAPE
  261.     WOPEN 10,10,15,70 (cont) DEIDEsc
  262.     ATSAY 10,12 (cont) " BBS User Delete "
  263.     ATSAY 11,12 (cont) "Enter the ID to be deleted: "
  264.     ATSAY 15,26 (cont) " Press ESC to cancel "
  265.     ;
  266.     ;    Wait a keypress
  267.     ;
  268.     LOCATE 11,40
  269.     GET S0 8        ; get ID
  270.     IF FLAG(0) GOTO DEIDEnd ; Exit if ESC hit
  271.     LJ S0            ; Left justify
  272.     UPPER S0        ; ... and upper case
  273.     IF NULL S0 GOTO DEIDEnd ; get out on empty entry
  274. ;
  275. ;    Open the User file and a temp copy file
  276. ;
  277.     GOSUB DelUser        ; Try to delete
  278.     IF FLAG(1) GOTO DEIDEnd ; Skip if record deleted
  279.     ATSAY 12,12 (cont) "ID could not be found... "
  280.     ATSAY 13,12 (cont) "Press any key to continue..."
  281.     KEYGET S0
  282. ;
  283. ;    End of add procedure
  284. ;
  285. DEIDEnd:
  286.     WCLOSE
  287. DEIDEsc:
  288.     SET FLAG(0) ON
  289.     RETURN
  290. ; -----------------------------------------------------------------------
  291. ; ----- DelUser:  Delete a record from the user file...
  292. ;    .. S0 passes the user-id
  293. ;    .. S1 destroyed in the process
  294. ;    .. FLAG(1) if rtn'd set, indicates record was FOUND
  295. ;
  296. DelUser:
  297. ;
  298. ;    Open the User file and a temp copy file
  299. ;
  300.     SET FLAG(1)  OFF    ; Initialize for found flag
  301.     FOPENI S22&"\BBS-User" TEXT
  302.     IF NOT SUCCESS        ; Open failed
  303.        S0 = "Error opening: "*S22&"\BBS-User"
  304.        GOSUB Error        ; Report
  305.        GOTO DEUSEnd     ; And we're done
  306.        ENDIF
  307.  
  308.     FOPENO S22&"\TempUser" TEXT
  309.     IF NOT SUCCESS        ; Open failed
  310.        S0 = "Error opening: "*S22&"\TempUser"
  311.        GOSUB Error        ; Report
  312.        GOTO DEUSEnd     ; And we're done
  313.        ENDIF
  314.     N10 = 0         ; Count recs output for file delete
  315. ;
  316. ;    Read records (40 chars at a time to allow PRESERVE)
  317. ;
  318. DEUS100:
  319.     READ S1 40 N0        ; Read 1st 40 chars
  320.     IF EOF GOTO DEUS300    ; Skip on EOF
  321.     IF ZERO N0 GOTO DEUS100 ; Don't copy blank lines
  322.     IF STRCMP S1(0:7) S0(0:7) GOTO DEUS200
  323.     INC N10         ; Count rec written
  324. ;
  325. ;    Copy the record read to the output file
  326. ;
  327. DEUS110:
  328.     PRESERVE S1        ; Save !'s and ^'s
  329.     WRITE S1        ; Write text
  330.  
  331.     IF N0 LT 40        ; If we wrote end of record
  332.        WRITE "!"            ; Finish w/cr/lf
  333.        GOTO DEUS100     ; And continue copying
  334.        ENDIF
  335.     READ S1 40 N0        ; Read remainder of rec
  336.     IF NOT EOF GOTO DEUS110 ; Skip if not eof
  337.     WRITE "!"               ; Finish record
  338.     GOTO DEUS300        ; End of file
  339. ;
  340. ;    We have a hit
  341. ;
  342. DEUS200:
  343.     SET FLAG(1) ON        ; Flag we deleted item
  344.     IF N0 LT 40 GOTO DEUS100
  345.     READ S1 40 N0        ; Read remainder of rec
  346.     IF NOT EOF GOTO DEUS200 ; Skip if not found
  347. ;
  348. ;    We hit EOF - may or may not have found the target rec
  349. ;
  350. DEUS300:
  351.     IF NOT FLAG(1) GOTO DEUS400 ; skip if not found
  352.     WRITE "^Z"              ; Finish ASCII file
  353.     FCLOSEO         ; Close output
  354.     FCLOSEI         ; Close input
  355.     DELETE S22&"\BBS-User"  ; Delete original
  356.     RENAME S22&"\TempUser" S22&"\BBS-User"
  357.     IF ZERO N10 DELETE S22&"\BBS-User" ; Delete empty file
  358.     GOTO DEUSEnd
  359. ;
  360. ;    We hit EOF - we did not find the record
  361. ;
  362. DEUS400:
  363.     FCLOSEO         ; Close output
  364.     FCLOSEI         ; Close input
  365.     DELETE S22&"\TempUser"  ; Delete copy file
  366. ;
  367. ;    End of procedure...
  368. ;
  369. DEUSEnd:
  370.     RETURN
  371. ; -----------------------------------------------------------------------
  372. ; ----- ModID:    Modify an ID in the User file
  373. ;
  374. ModID:
  375.     SET FLAG(0) OFF     ; Flag for ESCAPE
  376.     WOPEN 10,10,15,70 (cont) MOIDEsc
  377.     ATSAY 10,12 (cont) " BBS User Modify "
  378.     ATSAY 11,12 (cont) "Enter the ID to change: "
  379.     ATSAY 15,26 (cont) " Press ESC to cancel "
  380.     ;
  381.     ;    Wait a keypress
  382.     ;
  383.     LOCATE 11,38
  384.     GET S0 8        ; get ID
  385.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  386.     LJ S0            ; Left justify
  387.     UPPER S0        ; ... and upper case
  388.     IF NULL S0 GOTO MOIDEnd ; get out on empty entry
  389.     GOSUB LkpID        ; Lookup ID in User file
  390.     IF NOT FOUND        ; If its there we can't add it
  391.        WCLOSE        ; Close open window
  392.        GOTO AddID_Mod    ; Skip if ID NOT found
  393.        ENDIF
  394.     GOTO MOID100        ; And branch around parallel code
  395. ;
  396. ;    Entry from AddID... We have a rec in S10 - needs adding
  397. ;
  398. ModID_Add:
  399.     WOPEN 10,10,15,70 (cont) MOIDEsc
  400.     ATSAY 10,12 (cont) " BBS User Modify "
  401.     ATSAY 11,12 (cont) "Enter the ID to change: "
  402.     ATSAY 11,38 (cont) S0
  403.     ATSAY 15,26 (cont) " Press ESC to cancel "
  404. ;
  405. ;    Display the original values (rtnd in S10 by LkpID)
  406. ;
  407. MOID100:
  408.     ATSAY 10,49 (cont) " Old vals "
  409.     ATSAY 11,50 (cont) S10(0:7)
  410.     ATSAY 12,50 (cont) S10(8:15)
  411.     IF NOT NULL S10(16:16)
  412.        ATSAY 13,50 (cont) "y"
  413.     ELSE
  414.        ATSAY 13,50 (cont) "n"
  415.        ENDIF
  416. ;
  417. ;    Ask for a password
  418. ;
  419.     ATSAY 12,12 (cont) "Enter the password:       "
  420.     LOCATE 12,38
  421.     GET S0 8        ; get password
  422.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  423.     LJ S0            ; Left justify
  424.     UPPER S0        ; ... and upper case
  425.     IF NULL S0        ; Password c/r simly copies previous
  426.        ATSAY 12,38 (cont) S10(8:15)
  427.        GOTO MOID200     ; No update
  428.        ENDIF
  429.     S10(8:15) = S0        ; Save password
  430. ;
  431. ;    Ask for privileged flag
  432. ;
  433. MOID200:
  434.     ATSAY 13,12 (cont) "Priveleged access (y/n):  "
  435.     LOCATE 13,38
  436.     GET S0 1        ; get resp
  437.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  438.     IF NULL S0 ATSCR 13,50 1 S0 ; Read back previous value
  439.     IF NOT FIND "YN" S0(0)  ; If not y/n
  440.        SOUND 100,100    ; Indicate displeasure
  441.        GOTO MOID200     ; Try again
  442.        ENDIF
  443.     S10(16:16) = " "        ; Default no priv
  444.     IF FIND "Y" S0(0)       ; If privilege 'y'
  445.        S10(16:16) = "P"     ; Set priveleged access
  446.        ENDIF
  447. ;
  448. ;    Ask for one more look
  449. ;
  450. MOID300:
  451.     ATSAY 14,12 (cont) "OK to add this record?:   "
  452.     LOCATE 14,38
  453.     GET S0 1        ; get resp
  454.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  455.     IF NULL S0 or NOT FIND "YN" S0(0)
  456.        SOUND 100,100    ; Indicate displeasure
  457.        GOTO MOID300     ; Try again
  458.        ENDIF
  459.     IF FIND "N" S0(0)
  460.        WCLOSE        ; Close window
  461.        GOTO ModID        ; And try again
  462.        ENDIF
  463. ;
  464. ;    Add comments Delete the previous value... and add the new
  465. ;
  466.     S10(17:70) = "* Modified "*"_DATE"*", at "*"_TIME"
  467.     S0 = S10(0:7)        ; Setup ID key
  468.     GOSUB DelUser        ; Delete the previous key
  469.     IF NOT FLAG(1)        ; If not deleted
  470.        S0 = "Error modifying record for: "*S0
  471.        GOSUB Error        ; Report
  472.        GOTO MOIDEnd     ; And we're done
  473.        ENDIF
  474.     GOSUB AddUser        ; And add the new record
  475. ;
  476. ;    End of add procedure
  477. ;
  478. MOIDEnd:
  479.     WCLOSE
  480. MOIDEsc:
  481.     SET FLAG(0) ON
  482.     RETURN
  483. ; -----------------------------------------------------------------------
  484. ; ----- PrnID:    Print a list of IDs
  485. ;
  486. PrnID:
  487.     FOPENI S22&"\BBS-User" TEXT
  488.     IF NOT SUCCESS        ; Open failed
  489.        S0 = "Error opening: "*S22&"\BBS-User"
  490.        GOSUB Error        ; Report
  491.        RETURN        ; And we're done
  492.        ENDIF
  493. ;
  494. ;    Initialize a counter
  495. ;
  496.     N10 = 0         ; # Lines printed
  497.     N11 = 1         ; Page number
  498. ;
  499. ;    Read loop
  500. ;
  501. PRID100:
  502.     READ S10 80 N0        ; Read a record
  503.     IF EOF GOTO PRID200    ; Skip on EOF
  504.     IF STRCMP S10(0:0) "<" GOTO PRID120 ; skip comments
  505.     IF ZERO N0 GOTO PRID100 ; skip blank lines
  506. ;
  507. ;    Print a heading...
  508. ;
  509.     IF N10 GT 0 and N10 LE 50 GOTO PRID110
  510.     PRINT "COM-AND Scripted BBS User list as of "*"_DATE"*", "*"_TIME"*"      Page "*N11*"^M^J"
  511.     PRINT "From: "*"_IFILE"*"^M^J"
  512.     PRINT "----------------------------------------------------------------------^M^J"
  513.     PRINT "ID       Priv Comments^M^J"
  514.     PRINT "-------- ---- --------------------------------------------------------^M^J"
  515.     N10 = 0
  516.     INC N11
  517. ;
  518. ;    Build a record and print it
  519. ;
  520. PRID110:
  521.     S0 = S10(0:7)        ; ID Field
  522.     IF NOT NULL S10(16:16) S0(10:12) = "yes"
  523.     S0(14:79)  = S10(17:79) ; Comment field
  524.     PRESERVE S0
  525.     PRINT S0
  526.     PRINT "^M^J"            ; FInish line
  527.     INC N10         ; COunt lines printed
  528. ;
  529. ;    Handle record longer than 80 chars
  530. ;
  531. PRID120:
  532.     IF N0 LT 80 GOTO PRID100; If exactly 80 rtnd, c/r wasn't read
  533.     READ S10 80 N0        ; Read remainder of rec
  534.     GOTO PRID120        ; Read until less than 80
  535. ;
  536. ;    We have end-of-file
  537. ;
  538. PRID200:
  539.     PRINT "^L"              ; Do a final top-of-form
  540. ;
  541. ;    And exit
  542. ;
  543. PRIDEnd:
  544.     FCLOSEI
  545.     RETURN
  546. ; -----------------------------------------------------------------------
  547. ; ----- ViewID:  View a list of IDs
  548. ;
  549. ViewID:
  550.     FOPENI S22&"\BBS-User" TEXT
  551.     IF NOT SUCCESS        ; Open failed
  552.        S0 = "Error opening: "*S22&"\BBS-User"
  553.        GOSUB Error        ; Report
  554.        RETURN        ; And we're done
  555.        ENDIF
  556. ;
  557. ;    Initialize a counter
  558. ;
  559.     N10 = 0         ; # Lines printed
  560.     N11 = 0         ; Page number
  561.     SET FLAG(0) OFF     ; Initialize esc flag
  562.     S11 = "_ONESC"
  563.     ON ESCAPE GOSUB VIIDESC
  564. ;
  565. ;    Print a heading...
  566. ;
  567. VIID100:
  568.     IF N10 GT 0 GOTO VIID110
  569.     CLEAR            ; Clear the window
  570.     ATSAY 1,2 (defa) "ID       Priv Comments"
  571.     ATSAY 2,2 (defa) "-------- ---- ----------------------------------------------------"
  572.     N10 = 3         ; Set starting line no
  573.     INC N11         ; Set next page
  574. ;
  575. ;    Save the file position for the start of this page
  576. ;
  577.     FSAVEI
  578.     IF NOT SUCCESS
  579.        FSAVEI SHIFT     ; Save last 20 pos'ns
  580.        FSAVEI
  581.        ENDIF
  582. ;
  583. ;    Read loop
  584. ;
  585. VIID110:
  586.     READ S10 80 N0        ; Read a record
  587.     IF EOF GOTO VIID200    ; Skip on EOF
  588.     IF STRCMP S10(0:0) "<" GOTO VIID120 ; skip comments
  589.     IF ZERO N0 GOTO VIID110 ; skip blank lines
  590. ;
  591. ;    Build a record and print it
  592. ;
  593.     S0 = S10(0:7)        ; ID Field
  594.     IF NOT NULL S10(16:16) S0(10:12) = "yes"
  595.     S0(14:75)  = S10(17:79) ; Comment field
  596.     PRESERVE S0
  597.     ATSAY N10,2 (defa) S0
  598.     INC N10         ; COunt lines printed
  599. ;
  600. ;    Handle record longer than 80 chars
  601. ;
  602. VIID120:
  603.     IF N0 LT 80 GOTO VIID200; If exactly 80 rtnd, c/r wasn't read
  604.     READ S10 80 N0        ; Read remainder of rec
  605.     GOTO VIID120        ; Read until less than 80
  606. ;
  607. ;    Look for end of screen/end of file
  608. ;
  609. VIID200:
  610.     IF (NOT EOF) and N10 LT 21 GOTO VIID100
  611.     IF EOF
  612.        ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)"
  613.     ELSE
  614.        ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)"
  615.        ENDIF
  616. ;
  617. ;    Read a key and interpret
  618. ;
  619. VIID210:
  620.     IF FLAG(0) RETURN    ; End of routine when flag set
  621.     KEYGET S1
  622.     IF FLAG(0) RETURN    ; End of routine when flag set
  623.     SWITCH S1
  624.       CASE "4900"           ; Pgup
  625.         GOTO PgUp
  626.         ENDCASE
  627.       CASE "5100"           ; PgDn
  628.         GOTO PgDn
  629.         ENDCASE
  630.       CASE "4700"           ; Home
  631.         GOTO Home
  632.         ENDCASE
  633.       CASE "0D"             ; C/r
  634.         IF EOF GOTO VIIDEnd
  635.         GOTO PgDn
  636.         ENDCASE
  637.       ENDSWITCH
  638.     MESS S1
  639.     SOUND 100,100
  640.     GOTO VIID210
  641. ;
  642. ;    Page up (go backwards)
  643. ;
  644. PgUp:
  645.     N10 = 0         ; Clear line ctr
  646.     FRESTOREI        ; Backup current pg
  647.     N11 = N11-1        ; Reset Page # for redisplay
  648.     FRESTOREI        ; Backup one more
  649.     IF NOT SUCCESS
  650.        SOUND 200,100    ; Indicate problem
  651.        GOTO Home
  652.        ENDIF
  653.     N11 = N11-1        ; Reset Page # for redisplay
  654.     GOTO VIID100
  655. ;
  656. ;    Home (go to top)
  657. ;
  658. Home:
  659.     N10 = 0         ; Clear line ctr
  660.     N11 = 0         ; Set new pg number
  661.     FSAVEI CLEAR        ; Clear saved pages
  662.     REWIND            ; Rewind input
  663.     GOTO VIID100
  664. ;
  665. ;    Page down (go forwards)
  666. ;
  667. PgDn:
  668.     IF EOF GOTO Home    ; Wrap to home at EOF
  669.     N10 = 0         ; Clear line ctr
  670.     GOTO VIID100
  671. ;
  672. ;    And exit
  673. ;
  674. VIIDEnd:
  675.     FCLOSEI
  676.     RETURN
  677. ;
  678. ;    Escape entered
  679. ;
  680. VIIDESC:
  681.     SET FLAG(0) ON
  682.     ON ESCAPE GOSUB S11    ; Restore previous ON ESC
  683.     RETURN
  684. ;--------------------------------------------------------------------------
  685. ; ----- Subroutine: NewUser -> Create a new BBS-User file
  686. ;
  687. NewUser:
  688.     IF ISFILE S22&"\BBS-User" RETURN
  689.     FOPENO S22&"\BBS-User" TEXT
  690.     IF NOT SUCCESS RETURN    ; Open failed
  691.     WRITE "!^Z"             ; Make it empty
  692.     FCLOSEO         ; Done with it
  693.     RETURN
  694. ; -----------------------------------------------------------------------
  695. ; ----- Error:    Open a window, display a message, and wait for keypress
  696. ;    S0 passes the error message
  697. ;
  698. Error:
  699.     WOPEN 10,10,12,70 (cont) Err_Esc
  700.     ATSAY 10,12 (cont) " Error "
  701.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  702.     ATSAY 12,26 (cont) " Press any key to continue "
  703.     ;
  704.     ;    Wait a keypress
  705.     ;
  706.     KEYGET S0        ; Wait for any key
  707.     WCLOSE
  708. Err_Esc:
  709.     RETURN
  710.