Stars of Shareware: DFÜ und Kommunikation

home *** CD-ROM | disk | FTP | other *** search

/ Stars of Shareware: DFÜ und Kommunikation / SOS-DFUE.ISO / programm / dos / terminal / ca_29 / bbmaint3.cmd < prev next >

Wrap

Text File | 1992-03-24 | 23.8 KB | 914 lines

;**** TRACE ON ; Debugging ; ; ----- COM-AND BBS file maintenance script (BULLETIN file) ; Commenced: 11/90 R.McG ; ----------------------------------------------------------------------- ; Purpose: ; The script, named BBMAINT3.CMD, produces the main window for ; Bulletin functions of BBMAINT, and implements its functions. It ; is not directly callable itself. ; ----------------------------------------------------------------------- ; Usage: ; N99 -> Text attribute value (Setup by BBMAINT.CMD) ; N98 -> BBMAINT Mainline cursor position ; N97 -> BBMAINT Mainline cursor position ; N96 -> our mainline cursor position ; N95 -> our mainline cursor position ; ----------------------------------------------------------------------- ; ; This script is intended ONLY to be used for FCALL ; IF NOT FCALLED WOPEN 10,10,13,70 (cont) NOBUEsc ATSAY 10,12 (cont) " BBS Bulletin " ATSAY 11,12 (cont) " The script: "*"_SCRIPT" ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT" ATSAY 13,26 (cont) " Press any key to continue " ; ; Wait a keypress ; KEYGET S0 ; Wait for any key WCLOSE ; Close open window EXIT ; Terminate right here ENDIF GOSUB Bullfile ; Invoke function FRETURN ; Return to caller ; ----------------------------------------------------------------------- ; ----- NoBull: Inform that there's no BBS-Bull file to modify ; NoBull: WOPEN 10,10,13,70 (cont) NOBUEsc ATSAY 10,12 (cont) " BBS BullDir " ATSAY 11,12 (cont) " The file: "*S25&"\BBS-Bull" ATSAY 12,12 (cont) " does not exist. Please create subdirectories first." ATSAY 13,26 (cont) " Press any key to continue " ; ; Wait a keypress ; KEYGET S0 ; Wait for any key WCLOSE NOBUEsc: RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: BullFile -> Update Bulletin directory ; BullFile: GOSUB NewBull ; Create if not there IF NOT ISFILE S25&"\BBS-Bull" GOSUB NoBull ; Inform there's no file RETURN ; .. so we can't continue ENDIF ; ; Open a window ; WOPEN 0,0 23,79 (defa) Bull_Esc ATSAY 0,2 (defa) " BBS Bulletins " ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT " ; ; Paint the window ; BUFI100: CLEAR ; Clear window LOCATE 2,2 MESS " 1) Add a bulletin to the list" MESS " 2) Delete a bulletin from the list" MESS " 3) Modify a bulletin's listing" MESS " 4) Print the bulletin list" MESS " 5) View the bulletin list" MESS "──────────────────────────────────── " MESS "Note: Alt-Q to edit a file" MESS " Alt-F for a directory search" MESS " Alt-F10 to shell to DOS" MESS " " MESS "──────────────────────────────────── " MESS " " MESS "Select item (carriage return = previous): " CURSOR N96,N95 ; Read current cursor ; ; Wait for entry, and interpret ; BUFI200: LOCATE N96 N95 ; Reposition cursor KEYGET S0 ; Wait for it SWITCH S0 ; Act according to keyget CASE "1" GOSUB AddBull ENDCASE CASE "2" GOSUB DelBull ENDCASE CASE "3" GOSUB ModBull ENDCASE CASE "4" GOSUB PrnBull ENDCASE CASE "5" GOSUB ViewBull GOTO BUFI100 ; Repaint screen after this ENDCASE CASE "0d" ; c/r alone is exit WCLOSE ; Close window... RETURN ; and return to caller ENDCASE CASE "_NULL" ; ESC -> Null WCLOSE ; Close window... RETURN ; Leave Main routine ENDCASE CASE "2100" ; Alt-F MANUAL "0x2100" ; Perform Dir cmd ENDCASE CASE "1000" ; Alt-Q MANUAL "0x1000" ; Edit a file ENDCASE CASE "7100" ; Alt-F10 SHELL DWINDOW 1,2,22,78; Reset dwindow after shell LEGEND "_LEGEND" ; Redo the legend ENDCASE DEFAULT ; None of the above SOUND 100,100 ; Bronx cheer ENDCASE ENDSWITCH GOTO BUFI200 ; Repaint screen and ask again ; ; End of bulletin procedure ; Bull_Esc: S0 = "" ; Fake a null entry RETURN ; Leave bulletin routine ; ----------------------------------------------------------------------- ; ----- AddBUll: Add a file to the bulletin directory ; AddBull: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,17,75 (cont) ADBUEsc ATSAY 10,12 (cont) " BBS Bulletin Add " ATSAY 11,12 (cont) "Enter the bulletin number: " ATSAY 17,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,42 GET S0 5 ; get number IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; Upper casefy IF NULL S0 GOTO ADBUEnd ; get out on empty entry GOSUB LkpBull ; Lookup name in file IF FOUND ; If its there we can't add it WCLOSE ; Close open window GOTO ModBU_Add ; Skip if found ENDIF S10 = S0 ; Save File name GOTO ADBU100 ; And branch around parallel code ; ; Entry from ModBull... Nothing to modify ; AddBU_Mod: WOPEN 10,10,17,75 (cont) ADBUEsc ATSAY 10,12 (cont) " BBS Bulletin Add " ATSAY 11,12 (cont) "Enter the bulletin number: " ATSAY 11,42 (cont) S0 ATSAY 17,26 (cont) " Press ESC to cancel " S10 = S0 ; Copy it for remainder ; ; Place file date and time in record ; ADBU100: DATE S1 ; Want mm/dd/yy form S10(5:12) = S1 ; Save date added ATSAY 12,12 (cont) "Enter the file name:" LOCATE 12,42 GET S0 12 ; get file name IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit LJ S0 ; Left justify IF NULL S0 SOUND 100,100 ; Indicate displeasure GOTO ADBU100 ; Try again ENDIF FFIRST S25&"\"*S0 ; Test for file's existence S10(14:25) = S0 ; Save File name IF SUCCESS GOTO ADBU200 ; Skip if exists ; ; File does not exist... ; ADBU110: ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): " LOCATE 13,42 GET S0 1 ; get resp IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO ADBU110 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO AddBull ; And try again ENDIF ; ; Ask for a comment field ; ADBU200: ATSAY 14,12 (cont) "Description: " LOCATE 14,26 GET S0 40 ; get resp LJ S0 ; Left justify IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit IF NULL S0 SOUND 100,100 ; Indicate displeasure GOTO ADBU200 ; Try again ENDIF S10(26:79) = S0 ; Save comment text ; ; Ask for privileged flag ; ADBU250: ATSAY 15,12 (cont) "Priveleged access (y/n): " LOCATE 15,42 GET S0 1 ; get resp IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO ADBU250 ; Try again ENDIF IF FIND "Y" S0(0) S10(13:13) = "P" ; Save priveleged access ; ; Ask for one more look ; ADBU300: ATSAY 16,12 (cont) "OK to add this record?: " LOCATE 16,42 GET S0 1 ; get resp IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO ADBU300 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO AddBull ; And try again ENDIF ; ; Write the record ; GOSUB AddBRec ; Write to Bulletins file ; ; End of add procedure ; ADBUEnd: WCLOSE ADBUEsc: SET FLAG(0) ON RETURN ; ----------------------------------------------------------------------- ; ----- AddBRec: Add a record to the Bulletin file... ; .. S10 passes the record to be written ; AddBRec: FOPENO S25&"\BBS-bull" TEXT APPEND IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report RETURN ; And we're done ENDIF PRESERVE S10 ; Preserve ^'s and !'s WRITE S10 ; Write the record WRITE "!^Z" ; And finish it FCLOSEO RETURN ; ----------------------------------------------------------------------- ; ----- LkpFile: Lookup a file in the BBS-Bull file ; .. S0 passes the fname to be tested ; .. S10 returns the record read ; LkpBull: FOPENI S25&"\BBS-Bull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report SET FOUND OFF ; Not found RETURN ; And we're done ENDIF ; ; Read loop ; LOBU100: READ S10 80 N0 ; Read a record IF EOF GOTO LOBU200 ; Skip on EOF IF STRCMP S10(0:0) "*" GOTO LOBU110 IF STRCMP S10(0:4) S0(0:4) GOTO LOBU300 ; ; Record longer than 80 chars ; LOBU110: IF N0 LT 80 GOTO LOBU100; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO LOBU110 ; Read until less than 80 ; ; We have end-of-file - not found ; LOBU200: SET FOUND OFF ; Indicate not found GOTO LOBUEnd ; ; We have a hit - return found ; LOBU300: SET FOUND ON ; Indicate found ; ; And exit ; LOBUEnd: FCLOSEI RETURN ; ----------------------------------------------------------------------- ; ----- DelBull: Delete a file from Bulletin file ; DelBull: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,15,70 (cont) DEBUEsc ATSAY 10,12 (cont) " BBS Bulletin Delete " ATSAY 11,12 (cont) "Enter bulletin number to del: " ATSAY 15,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,42 GET S0 5 ; get resp IF FLAG(0) GOTO DEBUEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; Upper casefy IF NULL S0 GOTO DEBUEnd ; get out on empty entry ; ; Open the Bulletin file and a temp copy file ; GOSUB DelBRec ; Try to delete a record IF FLAG(1) GOTO DEBUEnd ; Skip if record deleted ATSAY 12,12 (cont) "Bulletin not in listing... " ATSAY 13,12 (cont) "Press any key to continue..." KEYGET S0 ; ; End of add procedure ; DEBUEnd: WCLOSE DEBUEsc: SET FLAG(0) ON RETURN ; ----------------------------------------------------------------------- ; ----- DelBRec: Delete a record from the Bulletin file... ; .. S0 passes the bulletin number key ; .. S1 destroyed in the process ; .. FLAG(1) if rtn'd set, indicates record was FOUND ; DelBRec: ; ; Open the Bulletin file and a temp copy file ; SET FLAG(1) OFF ; Initialize for found flag FOPENI S25&"\BBS-Bull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report GOTO DEBREnd ; And we're done ENDIF FOPENO S25&"\TempBull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\TempBull" GOSUB Error ; Report GOTO DEBREnd ; And we're done ENDIF N10 = 0 ; COunt recs written ; ; Read records (40 chars at a time to allow PRESERVE) ; DEBR100: READ S1 40 N0 ; Read 1st 40 chars IF EOF GOTO DEBR300 ; Skip on EOF IF STRCMP S1(0:4) S0(0:4) GOTO DEBR200 INC N10 ; COunt rec written ; ; Copy the record read to the output file ; DEBR110: PRESERVE S1 ; Save !'s and ^'s WRITE S1 ; Write text IF N0 LT 40 ; If we wrote end of record WRITE "!" ; Finish w/cr/lf GOTO DEBR100 ; And continue copying ENDIF READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO DEBR110 ; Skip if not eof WRITE "!" ; Finish record GOTO DEBR300 ; End of file ; ; We have a hit ; DEBR200: SET FLAG(1) ON ; Flag we deleted item IF N0 LT 40 GOTO DEBR100 READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO DEBR200 ; Skip if not found ; ; We hit EOF - may or may not have found the target rec ; DEBR300: IF NOT FLAG(1) GOTO DEBR400 ; skip if not found WRITE "^Z" ; Finish ASCII file FCLOSEO ; Close output FCLOSEI ; Close input DELETE S25&"\BBS-Bull" ; Delete original RENAME S25&"\TempBull" S25&"\BBS-Bull" IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file GOTO DEBREnd ; ; We hit EOF - we did not find the record ; DEBR400: FCLOSEO ; Close output FCLOSEI ; Close input DELETE S25&"\TempBull" ; Delete copy file ; ; End of procedure... ; DEBREnd: RETURN ; ----------------------------------------------------------------------- ; ----- ModBull: Modify a record in the bulletin file ; ModBull: SET FLAG(0) OFF ; Flag for ESCAPE WOPEN 10,10,18,75 (cont) MOBUEsc ATSAY 10,12 (cont) " BBS Bulletin Modify " ATSAY 11,12 (cont) "Enter number to change: " ATSAY 18,26 (cont) " Press ESC to cancel " ; ; Wait a keypress ; LOCATE 11,42 GET S0 5 ; get resp IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit LJ S0 ; Left justify UPPER S0 ; Upper case IF NULL S0 GOTO MOBUEnd ; get out on empty entry GOSUB LkpBull ; Lookup in Bulletin file IF NOT FOUND ; If its there we can't add it WCLOSE ; Close open window GOTO AddBU_Mod ; Skip if NOT found ENDIF GOTO MOBU100 ; And branch around parallel code ; ; Entry from AddBull... We have a rec in S10 - needs adding ; ModBU_Add: WOPEN 10,10,18,75 (cont) MOBUEsc ATSAY 10,12 (cont) " BBS Bulletin Modify " ATSAY 11,12 (cont) "Enter number to be changed: " ATSAY 11,42 (cont) S0 ATSAY 18,26 (cont) " Press ESC to cancel " ; ; Display the original values (rtnd in S10 by LkpBull) ; MOBU100: ATSAY 10,54 (cont) " Old vals " ATSAY 11,55 (cont) S10(0:4) ; Num ATSAY 12,55 (cont) S10(14:25) ; Fname ATSAY 15,26 (cont) S10(26:65) ; Description IF NOT NULL S10(13:13) ATSAY 16,55 (cont) "y" ELSE ATSAY 16,55 (cont) "n" ENDIF ; ; Ask for a file name (containing the bulletin) ; MOBU110: DATE S1 ; Want mm/dd/yy form S10(5:12) = S1 ; Save date mod'd ATSAY 12,12 (cont) "Enter the file name:" LOCATE 12,42 GET S0 12 ; get file name IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit LJ S0 ; Left justify IF NULL S0 GOTO MOBU200 ; Skip if null entry FFIRST S25&"\"*S0 ; Test for file's existence S10(14:25) = S0 ; Save File name IF SUCCESS GOTO MOBU200 ; Skip if exists ; ; File does not exist... ; MOBU120: ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): " LOCATE 13,42 GET S0 1 ; get resp IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO MOBU120 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO ModBull ; And try again ENDIF ; ; Ask for a comment field ; MOBU200: ATSAY 14,12 (cont) "Description: " LOCATE 14,26 GET S0 40 ; get resp LJ S0 ; Left justify IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit IF NULL S0 ; If null entry... ATSAY 14,26 (cont) S10(26:65) GOTO MOBU250 ; Skip store ENDIF S10(26:79) = S0 ; Save comment text ; ; Ask for privileged flag ; MOBU250: ATSAY 16,12 (cont) "Priveleged access (y/n): " LOCATE 16,42 GET S0 1 ; get resp IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit IF NULL S0 ATSCR 16,55 1 S0 ; Read back previous value IF NOT FIND "YN" S0(0) ; If not y/n SOUND 100,100 ; Indicate displeasure GOTO MOBU250 ; Try again ENDIF S10(13:13) = " " ; Default no priv IF FIND "Y" S0(0) ; If privilege 'y' S10(13:13) = "P" ; Set priveleged access ENDIF ; ; Ask for one more look ; MOBU300: ATSAY 17,12 (cont) "OK to add this record?: " LOCATE 17,42 GET S0 1 ; get resp IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit IF NULL S0 or NOT FIND "YN" S0(0) SOUND 100,100 ; Indicate displeasure GOTO MOBU300 ; Try again ENDIF IF FIND "N" S0(0) WCLOSE ; Close window GOTO ModBull ; And try again ENDIF ; ; Delete the previous value... and add the new ; .. Could do a Delete/add but don't want file re-ordered ; GOSUB ModBRec ; Modify the record in S10 IF NOT FLAG(1) ; If not deleted S0 = "Error modifying bulletin: "*S0 GOSUB Error ; Report GOTO MOBUEnd ; And we're done ENDIF ; ; End of add procedure ; MOBUEnd: WCLOSE MOBUEsc: SET FLAG(0) ON RETURN ; ----------------------------------------------------------------------- ; ----- ModBRec: Modify a record from the Files file... ; .. S10 passes the new record (same file name key) ; .. S1 destroyed in the process ; ModBRec: ; ; Open the Files file and a temp copy file ; SET FLAG(1) OFF ; Initialize for found flag FOPENI S25&"\BBS-Bull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report GOTO MOBREnd ; And we're done ENDIF FOPENO S25&"\TempFile" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\TempFile" GOSUB Error ; Report GOTO MOBREnd ; And we're done ENDIF N10 = 0 ; Count recs written ; ; Read records (40 chars at a time to allow PRESERVE) ; MOBR100: READ S1 40 N0 ; Read 1st 40 chars IF EOF GOTO MOBR300 ; Skip on EOF IF STRCMP S1(0:4) S10(0:4) GOTO MOBR200 INC N10 ; ; Copy the record read to the output file ; MOBR110: PRESERVE S1 ; Save !'s and ^'s WRITE S1 ; Write text IF N0 LT 40 ; If we wrote end of record WRITE "!" ; Finish w/cr/lf GOTO MOBR100 ; And continue copying ENDIF READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO MOBR110 ; Skip if not eof WRITE "!" ; Finish record GOTO MOBR300 ; End of file ; ; We have a match on the key. ; MOBR200: SET FLAG(1) ON ; Flag we deleted item S1 = S10(0:39) ; Take 1st part of rec to write PRESERVE S1 ; Save !s and ^s WRITE S1 ; Write text LENGTH S10 N1 ; Get new rec length IF N1 LT 40 GOTO MOBR210 S1 = S10(40:79) ; Take 2nd part of rec to write PRESERVE S1 ; Save !s and ^s WRITE S1 ; Write text ; ; Finish the new record ; MOBR210: WRITE "!" ; Finish record ; ; Finish reading the original record ; MOBR220: IF N0 LT 40 GOTO MOBR100 READ S1 40 N0 ; Read remainder of rec IF NOT EOF GOTO MOBR220 ; Skip if not found ; ; We hit EOF - may or may not have found the target rec ; MOBR300: IF NOT FLAG(1) GOTO MOBR200 ; skip if not found WRITE "^Z" ; Finish ASCII file FCLOSEO ; Close output FCLOSEI ; Close input DELETE S25&"\BBS-Bull" ; Delete original RENAME S25&"\TempFile" S25&"\BBS-Bull" IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file ; ; End of procedure... ; MOBREnd: RETURN ; ----------------------------------------------------------------------- ; ----- PrnBull: Print a list of bulletins ; PrnBull: FOPENI S25&"\BBS-Bull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Initialize a counter ; N10 = 0 ; # Lines printed N11 = 1 ; Page number ; ; Read loop ; PRBU100: READ S10 80 N0 ; Read a record IF EOF GOTO PRBU200 ; Skip on EOF IF STRCMP S10(0:0) "<" GOTO PRBU120 ; skip comments IF ZERO N0 GOTO PRBU100 ; skip blank lines ; ; Print a heading... ; IF N10 GT 0 and N10 LE 50 GOTO PRBU110 PRINT "COM-AND Scripted BBS Bulletin list as of "*"_DATE"*", "*"_TIME"*" Page "*N11*"^M^J" PRINT "From: "*"_IFILE"*"^M^J" PRINT "--------------------------------------------------------------------------^M^J" PRINT "Numbr File Priv Description^M^J" PRINT "----- ------------ ---- --------------------------------------------------^M^J" N10 = 0 INC N11 ; ; Build a record and print it ; PRBU110: S0 = S10(0:4) ; Number Field S0(6:17) = S10(14:25) ; Fname Field IF NOT NULL S10(13:13) S0(20:22) = "yes" S0(24:79) = S10(26:79) ; Description PRESERVE S0 PRINT S0 PRINT "^M^J" ; Finish line INC N10 ; COunt lines printed ; ; Handle record longer than 80 chars ; PRBU120: IF N0 LT 80 GOTO PRBU100; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO PRBU120 ; Read until less than 80 ; ; We have end-of-file ; PRBU200: PRINT "^L" ; Do a final top-of-form ; ; And exit ; PRBUEnd: FCLOSEI RETURN ; ----------------------------------------------------------------------- ; ----- ViewBull: View a list of bulletins ; ViewBull: FOPENI S25&"\BBS-Bull" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S25&"\BBS-Bull" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Initialize a counter ; N10 = 0 ; # Lines printed N11 = 0 ; Page number SET FLAG(0) OFF ; Initialize esc flag S11 = "_ONESC" ON ESCAPE GOSUB VIBUESC ; ; Print a heading... ; VIBU100: IF N10 GT 0 GOTO VIBU110 CLEAR ; Clear the window ATSAY 1,2 (defa) "Numbr File Priv Description" ATSAY 2,2 (defa) "----- ------------ ---- --------------------------------------------------" N10 = 3 ; Set starting line no INC N11 ; Set next page ; ; Save the file position for the start of this page ; FSAVEI IF NOT SUCCESS FSAVEI SHIFT ; Save last 20 pos'ns FSAVEI ENDIF ; ; Read loop ; VIBU110: READ S10 80 N0 ; Read a record IF EOF GOTO VIBU200 ; Skip on EOF IF STRCMP S10(0:0) "<" GOTO VIBU120 ; skip comments IF ZERO N0 GOTO VIBU110 ; skip blank lines ; ; Build a record and print it ; S0 = S10(0:4) ; Number Field S0(6:17) = S10(14:25) ; Fname Field IF NOT NULL S10(13:13) S0(20:22) = "yes" S0(24:74) = S10(26:79) ; Description PRESERVE S0 ATSAY N10,2 (defa) S0 INC N10 ; COunt lines printed ; ; Handle record longer than 80 chars ; VIBU120: IF N0 LT 80 GOTO VIBU200; If exactly 80 rtnd, c/r wasn't read READ S10 80 N0 ; Read remainder of rec GOTO VIBU120 ; Read until less than 80 ; ; Look for end of screen/end of file ; VIBU200: IF (NOT EOF) and N10 LT 21 GOTO VIBU100 IF EOF ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)" ELSE ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)" ENDIF ; ; Read a key and interpret ; VIBU210: IF FLAG(0) RETURN ; End of routine when flag set KEYGET S1 IF FLAG(0) RETURN ; End of routine when flag set SWITCH S1 CASE "4900" ; Pgup GOTO PgUp ENDCASE CASE "5100" ; PgDn GOTO PgDn ENDCASE CASE "4700" ; Home GOTO Home ENDCASE CASE "0D" ; C/r IF EOF GOTO VIBUEnd GOTO PgDn ENDCASE CASE "2100" ; Alt-F MANUAL "0x2100" ; Perform Dir cmd ENDCASE CASE "1000" ; Alt-Q MANUAL "0x1000" ; Edit a file ENDCASE CASE "7100" ; Alt-F10 SHELL DWINDOW 1,2,22,78 ; Reset dwindow after shell LEGEND "_LEGEND" ; Redo the legend ENDCASE DEFAULT MESS S1 SOUND 100,100 ENDCASE ENDSWITCH GOTO VIBU210 ; ; Page up (go backwards) ; PgUp: N10 = 0 ; Clear line ctr FRESTOREI ; Backup current pg N11 = N11-1 ; Reset Page # for redisplay FRESTOREI ; Backup one more IF NOT SUCCESS SOUND 200,100 ; Indicate problem GOTO Home ENDIF N11 = N11-1 ; Reset Page # for redisplay GOTO VIBU100 ; ; Home (go to top) ; Home: N10 = 0 ; Clear line ctr N11 = 0 ; Set new pg number FSAVEI CLEAR ; Clear saved pages REWIND ; Rewind input GOTO VIBU100 ; ; Page down (go forwards) ; PgDn: IF EOF GOTO Home ; Wrap to home at EOF N10 = 0 ; Clear line ctr GOTO VIBU100 ; ; And exit ; VIBUEnd: FCLOSEI RETURN ; ; Escape entered ; VIBUESC: SET FLAG(0) ON ON ESCAPE GOSUB S11 ; Restore previous ON ESC RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: NewBull -> Create a new BBS-Bull file ; NewBull: IF ISFILE S25&"\BBS-Bull" RETURN FOPENO S25&"\BBS-Bull" TEXT IF NOT SUCCESS RETURN ; Open failed WRITE "!^Z" ; Make it empty FCLOSEO ; Done with it RETURN ; ----------------------------------------------------------------------- ; ----- Error: Open a window, display a message, and wait for keypress ; S0 passes the error message ; Error: WOPEN 10,10,12,70 (cont) Err_Esc ATSAY 10,12 (cont) " Error " ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars ATSAY 12,26 (cont) " Press any key to continue " ; ; Wait a keypress ; KEYGET S0 ; Wait for any key WCLOSE Err_Esc: RETURN