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 / bbmaint4.cmd < prev next >

Wrap

Text File | 1992-03-24 | 34.1 KB | 1,195 lines

;**** TRACE ON ; Debugging ; ; ----- COM-AND BBS file maintenance script (MAIL file) ; Commenced: 11/90 R.McG ; ----------------------------------------------------------------------- ; Purpose: ; The script, named BBMAINT4.CMD, produces the main window for ; Mail 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) NOMAEsc ATSAY 10,12 (cont) " BBS Mail " 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 Mailfile ; Invoke function FRETURN ; Return to caller ; ----------------------------------------------------------------------- ; ----- NoMail: Inform that there's no BBS-Mail file to modify ; NoMail: WOPEN 10,10,13,70 (cont) NOMAEsc ATSAY 10,12 (cont) " BBS MailDir " ATSAY 11,12 (cont) " The file: "*S24&"\BBS-Mail" 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 NOMAEsc: RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: MailFile -> Update Mail directory ; MailFile: GOSUB NewMail ; Create if not there IF NOT ISFILE S24&"\BBS-Mail" GOSUB NoMail ; Inform there's no file RETURN ; .. so we can't continue ENDIF ; ; Open a new window ; WOPEN 0,0 23,79 (defa) Mail_Esc ATSAY 0,2 (defa) " BBS Mail " ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT " ; ; Paint a new menu ; MAFI100: CLEAR ; Clear window LOCATE 2,2 MESS " 1) Clean up mail directory" MESS " 2) Delete notes older than ..." MESS " 3) Read notes newer than ..." MESS " 4) Post a new note" 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 ; MAFI200: LOCATE N96 N95 ; Reposition cursor KEYGET S0 ; Wait for it SWITCH S0 ; Act according to keyget CASE "1" GOSUB ClrMail GOTO MAFI100 ; Repaint after this ENDCASE CASE "2" GOSUB DelMail GOTO MAFI100 ; Repaint after this ENDCASE CASE "3" GOSUB ReadMail GOTO MAFI100 ; Repaint after this ENDCASE CASE "4" GOSUB Compose GOTO MAFI200 ; This sub saves screen 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 MAFI200 ; Repaint screen and ask again ; ; End of mail procedure ; Mail_Esc: S0 = "" ; Fake a null entry RETURN ; Leave Mail routine ; ----------------------------------------------------------------------- ; ----- ClrMail: Clear mail directory of unneeded entries ; ClrMail: FOPENI S24&"\BBS-Mail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\BBS-Mail" GOSUB Error ; Report RETURN ; And we're done ENDIF FOPENO S24&"\TempMail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\TempMail" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Initialize ; CLEAR ; Clear window N9 = 0 ; Count recs written ; ; Read loop (40 chars at a time to allow PRESERVE) ; CLMA100: READ S10 40 N0 ; Read a record IF EOF GOTO CLMA200 ; Skip on EOF IF STRCMP S10(0:0) "*" GOTO CLMA115 ; Copy comments IF ZERO N0 GOTO CLMA115 ; Copy blank lines ; ; Test for the existence of the indicated file ; CLMA110: S0 = S24&"\"*S10(25:37) ; Make a file name IF NOT ISFILE S0 ; Test existence MESS S0*" does not exist - deleting record" GOTO CLMA130 ; Remove entry ENDIF MESS S0*" exists - copying record" ; ; Count the write ; CLMA115: INC N9 ; Count recs written ; ; Copy record just read to output file ; CLMA120: PRESERVE S10 ; Save !'s and ^'s WRITE S10 ; Write text IF N0 LT 40 ; If we wrote end of record WRITE "!" ; Finish w/cr/lf GOTO CLMA100 ; And continue copying ENDIF READ S10 40 N0 ; Read remainder of rec IF NOT EOF GOTO CLMA120 ; Skip if not eof WRITE "!" ; Finish record GOTO CLMA200 ; End of file ; ; Throw away the current record ; CLMA130: IF N0 LT 40 GOTO CLMA100 READ S10 40 N0 ; Read remainder of rec IF NOT EOF GOTO CLMA130 ; Skip if not eof ; ; We have end-of-file ; CLMA200: WRITE "^Z" ; Finish ASCII file FCLOSEO ; Close output FCLOSEI ; Close input DELETE S24&"\BBS-Mail" ; Delete original RENAME S24&"\TempMail" S24&"\BBS-Mail" IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file RETURN ; ----------------------------------------------------------------------- ; ----- DelMail: Delete mail files older than some date... ; .. Note this only works through current and last year ; DelMail: FOPENI S24&"\BBS-Mail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\BBS-Mail" GOSUB Error ; Report RETURN ; And we're done ENDIF FOPENO S24&"\TempMail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\TempMail" GOSUB Error ; Report GOTO DEMAErr ; And we're done ENDIF N9 = 0 ; Counter for recs written ; ; Initialize ; .. (N2 = # days to keep, N3 = today's julian dayno, N4 = current yr) ; S0 = "Enter age in days of the oldest file to keep" GOSUB Get_Number ; Ask for a value IF FLAG(0) GOTO DEMAERR ; IF ESCAPE pressed... IF N0 LE 0 N0 = 1 ; No negative dates N2 = N0 ; Save value for later DATE S0 1 ; get current date (mm/dd/yyyy) N4 = S0(6:9) ; Save current year number GOSUB Julian ; make Julian date from current date N3 = N0 ; Save current julian day number CLEAR ; Clear window ; ; Read loop (40 chars at a time to allow PRESERVE) ; DEMA100: READ S10 40 N10 ; Read a record IF EOF GOTO DEMA200 ; Skip on EOF IF STRCMP S10(0:0) "*" GOTO DEMA115 ; Copy comments IF ZERO N10 GOTO DEMA115; Copy blank lines ; ; Test for the existence of the indicated file ; DEMA110: S1 = S24&"\"*S10(25:37) ; Make a file name IF NOT ISFILE S1 ; Test existence MESS S1*" does not exist - cleaning dir" GOTO DEMA130 ; Remove entry ENDIF ; ; Find the date of the file. NOTE: The years we limit this code ; .. to recognizing are the current and previous years. ; FDATE S0 S1 1 ; Get the file's date into S0 (mm/dd/yyyy) N5 = N4-S0(6:9) ; Compute # years difference fdate and cur yr IF N5 LT 0 ; If file year is future.... MESS S1*" date is in the future... saving(!!)" GOTO DEMA115 ; Save the entry ENDIF IF N5 GT 1 ; if file older than 1 year MESS S1*" more than a year old ... deleting" DELETE S1 ; Delete the file... GOTO DEMA130 ; Delete the entry ENDIF GOSUB Julian ; Convert date to Julian day no ; ; Compute the days difference and act according to user set max ; IF N5 EQ 0 ; if file date same year as current... N1 = N3-N0 ; Same year... N1 = age of file ELSE ; If file date previous year N1 = N3-(N1-N0) ; [Julian returns N1 = #days that year] ENDIF IF N1 GT N2 ; If fileage > max age MESS S1*" is "*N1*" days old - deleting" DELETE S1 ; Delete the file... GOTO DEMA130 ; Delete the entry ENDIF MESS S1*" is "*N1*" days old - keeping" ; ; Count the write ; DEMA115: INC N9 ; Count recs written ; ; Copy record just read to output file ; DEMA120: PRESERVE S10 ; Save !'s and ^'s WRITE S10 ; Write text IF N10 LT 40 ; If we wrote end of record WRITE "!" ; Finish w/cr/lf GOTO DEMA100 ; And continue copying ENDIF READ S10 40 N10 ; Read remainder of rec IF NOT EOF GOTO DEMA120 ; Skip if not eof WRITE "!" ; Finish record GOTO DEMA200 ; End of file ; ; Throw away the current record ; DEMA130: IF N10 LT 40 GOTO DEMA100 READ S10 40 N10 ; Read remainder of rec IF NOT EOF GOTO DEMA130 ; Skip if not eof ; ; We have end-of-file ; DEMA200: WRITE "^Z" ; Finish ASCII file FCLOSEO ; Close output FCLOSEI ; Close input DELETE S24&"\BBS-Mail" ; Delete original RENAME S24&"\TempMail" S24&"\BBS-Mail" IF ZERO N9 DELETE S24&"\BBS-Mail" ; Delete empty file RETURN ; ; Error exit ; DEMAERR: FCLOSEO ; Close output FCLOSEI ; Close input RETURN ; ------------------------------------------------------------------------- ; ----- Get_Number ; S0 passes the prompt ; N0 returns the value entered ; FLAG(0) returned true indicates ESC was pressed ; Get_Number: SET FLAG(0) OFF ; ESCAPE flag WOPEN 10,10,13,70 (cont) GENU_ESC ATSAY 10,12 (cont) " Enter Value " ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars ATSAY 12,12 (cont) "-> " ATSAY 13,26 (cont) " Press ESCAPE to cancel " N0 = -1 ; Default value ; ; Wait a keypress ; GENU100: LOCATE 12,15 GET S0 5 ; Wait for a number IF NOT FLAG(0) and NOT (FIND S0 "all" or NULL S0) ATOI S0 N0 ; Convert w/o err msg IF ERROR ; If couldn't convert SOUND 100,100 ; Bronx cheer GOTO GENU100 ; Ask again ENDIF ELSE IF NOT (FIND S0 "all" or NULL S0) SOUND 100,100 ; Bronx cheer GOTO GENU100 ; Ask again ENDIF ENDIF WCLOSE ; Close open window RETURN ; ; Escape during GET ; GENU_Esc: SET FLAG(0) ON ; Flag Escape pressed RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: NewMail -> Create a new BBS-Mail file ; NewMail: IF ISFILE S24&"\BBS-Mail" RETURN FOPENO S24&"\BBS-Mail" TEXT IF NOT SUCCESS RETURN ; Open failed WRITE "!^Z" ; Make it empty FCLOSEO ; Done with it RETURN ;-------------------------------------------------------------------------- ;------ Julian: Simple (not true) Julian date conversion ; ; Passed: S0 contains a date formatted: mm/dd/yyyy left justified ; as per COM-AND "DATE Sx 1" format ; Rtnd: N0 returns the julian date number (1-366) ; N1 returns 365 or 366 as the total # days in the given year ; if SUCCESS is set ; ; NOTE: This routine is placed near beginning of file to speed access. ; This script exceeds the 100 label limit of COM-AND's cache! ; Julian: IF NOT (NUMERIC S0(0) and NUMERIC S0(3) and NUMERIC S0(6)) GOTO JULERR N0 = S0(3:4) ; Extract day number N1 = S0(0:1) ; Set default value to be rtnd SWITCH N1 ; Switch on Month # CASE 1 ; January GOTO JUL200 ; And continue ENDCASE CASE 2 ; February N0 = N0+31 ; Preceeding mo has 31 days GOTO JUL200 ; And continue ENDCASE CASE 3 ; March N0 = N0+59 ; Preceeding mo has 28 days GOTO JUL100 ; And continue ENDCASE CASE 4 ; April N0 = N0+90 ; Preceeding mo has 31 days GOTO JUL100 ; And continue ENDCASE CASE 5 ; May N0 = N0+120 ; Preceeding mo has 30 days GOTO JUL100 ; And continue ENDCASE CASE 6 ; June N0 = N0+151 ; Preceeding mo has 31 days GOTO JUL100 ; And continue ENDCASE CASE 7 ; July N0 = N0+181 ; Preceeding mo has 30 days GOTO JUL100 ; And continue ENDCASE CASE 8 ; August N0 = N0+212 ; Preceeding mo has 31 days GOTO JUL100 ; And continue ENDCASE CASE 9 ; September N0 = N0+243 ; Preceeding mo has 31 days GOTO JUL100 ; And continue ENDCASE CASE 10 ; October N0 = N0+273 ; Preceeding mo has 30 days GOTO JUL100 ; And continue ENDCASE CASE 11 ; November N0 = N0+304 ; Preceeding mo has 31 days GOTO JUL100 ; And continue ENDCASE CASE 12 ; December N0 = N0+334 ; Preceeding mo has 30 days GOTO JUL100 ; And continue ENDCASE DEFAULT ; Month not 1-12 GOTO JULERR ; And continue ENDCASE ENDSWITCH ; ; Month is after February - handle leap year ; .. leap year is divisible by 4 but not by 400 ; JUL100: IF (NOT ZERO (S0(6:9)\4)) or ZERO (S0(6:9)\400) GOTO JUL200 INC N0 ; Add a day for leap year N1 = 366 ; Set value to be rtnd (total # days) ; ; Return with a number 1-366 in N0 ; JUL200: IF N1 LT 366 N1 = 365 ; Total # days SET SUCCESS ON ; Indicate success RETURN ; ; Error in passed date ; JULERR: SET SUCCESS OFF ; Indicate FAILURE 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 ; ----------------------------------------------------------------------- ; ----- ReadMail: Read mail files newer than some date... ; .. Note this only works through current and last year ; Uses: S29,S28,S27,S10 ; ReadMail: FOPENI S24&"\BBS-Mail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\BBS-Mail" GOSUB Error ; Report RETURN ; And we're done ENDIF ; ; Alloc dyn vars (for message text display) ; ALLOCATE 100 ; Need 100 dynamic variables IF FAILED ; If allocation failed S0 = "Cannot allocate memory for variables" GOSUB Error ; Report the problem GOTO REMA900 ; Go clean up ENDIF ; ; Initialize ; .. (N2 = # days to keep, N3 = today's julian dayno, N4 = current yr) ; S0 = "Enter age in days of the oldest file to read:" GOSUB Get_Number ; Ask for a value IF FLAG(0) GOTO REMA900 ; IF ESCAPE pressed... N2 = N0 ; Save value for later DATE S0 1 ; get current date (mm/dd/yyyy) N4 = S0(6:9) ; Save current year number GOSUB Julian ; make Julian date from current date N3 = N0 ; Save current julian day number CLEAR ; Clear the current screen ; ; Read loop ; REMA100: FSAVEI ; Save current place in file IF FAILED ; .. if stack full FSAVEI SHIFT ; .. throw away oldest FSAVEI ; .. and NOW save it ENDIF READ S10 80 N10 ; Read a record IF EOF GOTO REMA900 ; Skip on EOF IF STRCMP S10(0:0) "*" GOTO REMA100 ; Skip comments IF ZERO N10 GOTO REMA100; Skip blank lines ; ; Test for the existence of the indicated file ; REMA110: S1 = S24&"\"*S10(25:37) ; Make a file name IF NOT ISFILE S1 GOTO REMA100 ; ; Skip if 'ALL' selected ; IF N2 LT 0 GOTO REMA200 ; ; Find the date of the file. NOTE: This code limits the years ; .. recognized to the current and previous years. ; FDATE S0 S1 1 ; Get the file's date into S0 (mm/dd/yyyy) N5 = N4-S0(6:9) ; Compute # years difference fdate and cur yr IF N5 LT 0 GOTO REMA200 ; If file year is future.... read it IF N5 GT 1 GOTO REMA100 ; If file older than 1 year skip it GOSUB Julian ; Convert date to Julian day no ; ; Compute the days difference and act according to user set max ; IF N5 EQ 0 ; if file date same year as current... N1 = N3-N0 ; Same year... N1 = age of file ELSE ; If file date previous year N1 = N3-(N1-N0) ; [Julian returns N1 = #days that year] ENDIF IF N1 GT N2 GOTO REMA100; If fileage > max age ; ; Save the current in-file's position and open the mail file ; REMA200: S29 = "_IPOS" ; Save input file position as a string FOPENI S1 text ; OPen input file as text IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S1 GOSUB Error ; Report N10 = 0 ; Clear # text lines (to skip display) GOTO REMA400 ; And continue ENDIF ; ; Load text into dynamic variables ; N10 = 0 ; Clear count of lines N11 = 5 ; # header lines to skip WHILE NOT EOF and N10 LT 100 ; We have 100 lines possible READ S0 80 N0 ; Read a line IF NOT EOF and ZERO N11 ; If a line was read... PRESERVE S0 ; Retain !s ^s and `s V0[N10] = S0 ; Save the line INC N10 ; Move to next ENDIF IF N11 GT 0 DEC N11 ; Count header lines ENDWHILE ; ; Re-open the BBS-Mail file and restore its position ; REMA400: FOPENI S24&"\BBS-Mail" TEXT IF NOT SUCCESS ; Open failed S0 = "Error opening: "*S24&"\BBS-Mail" GOSUB Error ; Report GOTO REMA900 ; And we're done ENDIF SET IPOS S29 ; Restore saved position LOAD FSAVEI "BBMAINT4.STK" ; ; Display (and prepare relpies to) the note ; IF NOT ZERO N10 GOSUB Display IF FLAG(0) GOTO REMA900 ; Exit if ESC GOTO REMA100 ; and continue ; ; We have end-of-file ; REMA900: SET FLAG(0) OFF ; Clear ESC flag FCLOSEI ; CLose input file DEALLOCATE ; Deallocate variables DELETE "BBMAINT4.STK" ; Delete temp file RETURN ; ----------------------------------------------------------------------- ; ----- Display: Display mail listings ; ; Entry: S1 -----> File name carrying mail ; S10 ----> BBS-Mail record ; V0-V99 -> Contain the records to display ; N10 ----> Carries the # Vx records ; Exit: FLAG(0) is set to return to main (ESC) ; Note: All values, except N99 may be modified ; Display: S28 = "_Legend" LEGEND "F10 (help), <cr>, PgUp, PgDn" ; ; Save current variables ; S27 = "_ONESCape" ; Save original handler ON ESCAPE GOSUB DispEsc ; Set new ESC handler ; ; Open a window ; SSIZE N80 ; Get # lines SAVE 0,0 N80-2,79 ; Save screen area DWINDOW 1,0 N80-3,79 ; Set new DWINDOW CLEAR N99 ; Clear window and set new attr SET WRAP OFF ; No line wrap at col 80 ATSAY 0,0 N99 "▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓" ATSAY N80-2,0 N99 "▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓" ATSAY 0,2 N99 " BBS Mail " S0 = S10(25:37)&"" ; Extract fname LENGTH S0 N0 ; get fname length ATSAY 0,76-N0 N99 " "*S0&" " ATSAY N80-2,25 N99 " Press ESC to return to main " ; ; Display fixed portion ; ATSAY 2,0 N99 "From: "*S10(8:15) ATSAY 3,0 N99 "To: "*S10(0:7) ATSAY 4,0 N99 "Posted: "*S10(17:24) ATSAY 5,0 N99 "────────────────────────────────────────────────────────────────────────────" ATSAY 6,0 N99 "Subject: "*S10(38:78) ATSAY 7,0 N99 "────────────────────────────────────────────────────────────────────────────" ; ; Display text ; N11 = N80-12 ; Compute end line IF N11 GE N10 N11 = N10-1 ; .. SCREEN 9,0 9+N11,79 N99 V0 ; Display all at once IF N10 GT N80-11 LEGEND "_LEGEND"&", CurUp, CurDn" ; ; Now, wait for entry ; DISP100: IF NOT FLAG(0) KEYGET S0 ; Wait for entry IF FLAG(0) GOTO DISPXIT ; Return on ESC SWITCH S0 ; Act upon entry CASE "0d" ; Carriage return GOTO DISPXIT ; Done with display ENDCASE CASE "5100" ; PgDn GOTO DISPXIT ; Done with display ENDCASE CASE "4900" ; PgUp S3 = "_IPOS" ; Read current position FRESTOREI ; Restore current file pos IF SUCCESS ; .. if that worked FRESTOREI ; .. do it again IF SUCCESS GOTO DISPXIT FSAVEI ; Restore the one stacked addr ENDIF ; If not 2 stored on stack, fall thru SET IPOS S3 ; Failed... restore original pos SOUND 100,400 ; Bronx cheer KFLUSH ; FLush typeahead GOTO DISP100 ; And continue ENDCASE CASE "4800" ; Cursor up IF N11 GT N80-12 ; If anything to scroll SCROLL -1 9,0 N80-3,79 N99 DEC N11 ATSAY 9,0 N99 V0[N11-N80+12] ELSE ; Nothing to scroll SOUND 100,400 ; Bronx cheer ENDIF KFLUSH ; FLush typeahead GOTO DISP100 ENDCASE CASE "5000" ; Cursor down IF N11 LT N10-1 ; If anything to scroll SCROLL 1 9,0 N80-3,79 N99 INC N11 ATSAY N80-3,0 N99 V0[N11] ELSE ; Nothing to scroll SOUND 100,400 ; Bronx cheer ENDIF KFLUSH ; FLush typeahead GOTO DISP100 ENDCASE CASE "4700" ; Home SCROLL 0 9,0 N80-3,79 N99 N11 = N80-12 ; Compute end line IF N11 GE N10 N11 = N10-1; .. SCREEN 9,0 9+N11,79 N99 V0 ; Display all at once GOTO DISP100 ENDCASE CASE "4400" ; F10 N0 = 0 ; Indicate call from Display GOSUB Help ; Display help screen ENDCASE CASE "1300" ; Alt-R GOSUB Reply ; Reply to Forum messages 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,0,N80-3,79 ; Reset dwindow after shell LEGEND "_LEGEND" ; Redo the legend ENDCASE DEFAULT ; None of the above SOUND 100,400 ; Bronx cheer KFLUSH ; Flush kbd ENDCASE ENDSWITCH IF FLAG(0) GOTO DISPXIT ; Return on ESC GOTO DISP100 ; ; End of display - restore screen ; DISPXIT: ON ESCAPE GOSUB S27 ; Set original handler LEGEND S28 ; Set original legend CLEAR "_DEFA" ; Set attrs back RESTORE DWIND 1,2 22,78 ; Re-Establish scrolling region SET WRAP ON ; line wrap at col 80 again RETURN ; Done with display ; ; ESC pressed during routine ; DispEsc: SET FLAG(0) ON ; Flag fact RETURN ; ----------------------------------------------------------------------- ; ----- Reply: Replay to a note ; ; Entry: S1 -> File name carrying mail ; S10 -> BBS-Mail record ; Exit: FLAG(0) is set to return to main (ESC) ; Reply: WOPEN 8,15,10,55 (defa) DispEsc ATSAY 8,17 (defa) " Message Type " ATSAY 9,17 (defa) " Private reply (Y/N,cr=N)?" ATSAY 10,29 (defa) " Press ESC to cancel " ; ; Ask for a selection ; S0 = "" ; Make a NULL for loop WHILE NULL S0 ATGET 9,44 (defa) 1 S0 ; Get resp IF FLAG(0) ; Exit if ESC hit SET FLAG(0) OFF ; Clear flag setting WCLOSE ; CLose open window RETURN ; Exit if ESC hit ENDIF IF NULL S0 S0 = "n" ; Default cr=no IF NOT FIND "YN" S0 ; Require y/n SOUND 100,100 ; Displeased S0 = "" ; Force a loop ENDIF ENDWHILE WCLOSE ; CLose window S12 = S0 ; Save private flag ; ; Ask for a subject ; WOPEN 8,15,11,65 (defa) DispEsc ATSAY 8,17 (defa) " Subject " ATSAY 9,17 (defa) "Enter the subject line please:" ATSAY 11,29 (defa) " Press ESC to cancel " ; ; Ask for a subject ; S0 = "" ; Make a NULL for loop ATGET 10,17 (defa) 48 S0 ; Get resp IF FLAG(0) ; Exit if ESC hit SET FLAG(0) OFF ; Clear flag setting WCLOSE ; CLose open window RETURN ; Exit if ESC hit ENDIF IF NULL S0 ; If no response... S0 = S10(38:77)&"" ; Default response IF NOT FIND S10(38:47) "Reply to: " S0 = "Reply to: "*S0 ENDIF WCLOSE ; CLose window S13 = S0 ; Save subject line ; ; Construct a file name for the new message ; N2 = 0 ; Make smallest possible date S11 = S24&"\"*S10(8:15)&"." ; Save fname WHILE ISFILE S11*N2 and N2 LT 1000 INC N2 ; Move to next ENDWHILE ; If no error IF N2 GE 1000 S0 = "Cannot reply... you have "*N2*" notes outstanding" GOSUB Error RETURN ENDIF S11 = S11*N2 ; Save fname to use ; ; Build an editor batch file ; FOPENO "BBMAINT.TMP" text ; Try to open file IF FAILED ; From FOPENO above S0 = "Error opening BBMAINT.TMP" GOSUB Error ; Report RETURN ; Return to caller ENDIF ; ; The first command is to open the new file ; WRITE "edit " S0 = S11&"" ; Replicate PRESERVE S0 ; Retain !s ^s and `s WRITE S0 ; Write <fname> WRITE "!" ; And a crlf ; ; Place the header to the file ; S0 = S10(8:15) PRESERVE S0 WRITE "To: "*S0 WRITE "!Insert!" WRITE "From: "*"Sysop" WRITE "!Insert!" WRITE "Date: "*"_DATE"*" "*"_Time" WRITE "!Insert!" S0 = S13 PRESERVE S0 WRITE "Subject: "*S0 WRITE "!Insert!" WRITE "!Insert!" ; ; If a response batch file exists, the next command executes THAT ; IF ISFILE S24&"\BBMAINT.RES" S0 = S24&"" ; Replicate PRESERVE S0 ; Retain !s ^s and `s WRITE "@"*S0 ; Write beginning of cmd WRITE "\BBMAINT.RES!" ; Write tail of cmd GOTO REPL100 ; and continue ENDIF ; ; No pre-existing batch file - make one ; WRITE "set margin 1 76!" WRITE "set exit text!" WRITE "Top!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Home!" WRITE ""*S10(8:15)&", greetings!" WRITE "Insert!" WRITE "Insert!" WRITE "Begin text here; margin is set to 1:76; Wordwrap and INSERT enabled.!" WRITE "Insert!" WRITE "Press F3 to save response; Press F4 to cancel response; F10 for help!" WRITE "Insert!" WRITE "Press F8 to view the original note; F8 from that window returns here.!" WRITE "Insert!" WRITE "Insert!" WRITE "Sysop!" WRITE "Top!" WRITE "Home!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "set insert!" WRITE "^Z" ; ; Close the batch file ; REPL100: FCLOSEO ; Ready to use it ; ; Invoke the editor to write a response ; SET TEXT N99 ; Reset Text attr STACK "^@A@BBMAINT.TMP!" ; ^@A -> F7; Stack batch file cmd EDIT S1 ; Open original 1st, then "response" SET TEXT "_DEFA" ; Make text mode DELETE "BBMAINT.TMP" ; Delete temp file we created IF NOT ISFILE S11 RETURN ; Skip if no response text prep'd ; ; Open the mail control file ; FOPENO S24&"\BBS-Mail" text append IF FAILED ; From FOPENO above S0 = "Error opening BBS-Mail" GOSUB Error ; Report RETURN ; Return to caller ENDIF ; ; Add a record to the mail file ; S2(0:7) = S10(8:15) ; New 'to' is old from S2(8:15) = "SYSOP" ; From ID S2(16:16) = " " ; Privacy flag IF FIND S12 "Y" S2(16:16) = "P" ; .. S2(17:24) = "_DATE" ; Set date field S2(25:37) = S10(8:15)&"."*N2 ; FIle name S2(38:77) = S13 ; Subject PRESERVE S2 ; Retain !s ^s and `s WRITE S2 ; Issue Merge command WRITE "!" ; And a crlf ; ; And we're done ; FCLOSEO ; Done with file RETURN ; ----------------------------------------------------------------------- ; ----- Subroutine: Help ; Help: WOPEN 0, 0,23,78 (default) DispEsc ATSAY 0, 2 (Default) " BBMAINT Help " ATSAY 23,28 (Default) " Press any key to continue " ; ; Constants for all displays ; ATSAY 1,2 (default) "<escape> Returns to BBMAINT main menu" ATSAY 2,2 (default) "<return> Moves to next message" ATSAY 4,2 (default) "CurUp Scrolls text up" ATSAY 5,2 (default) "CurDn Scrolls text down" ATSAY 6,2 (default) "Home Moves to top of text" ATSAY 7,2 (default) "PgDn Moves to next display" ATSAY 8,2 (default) "PgUp Moves to previous display" ATSAY 10,2 (default) "Alt-F10 Shell-to-DOS" ATSAY 11,2 (default) "Alt-F Directory search" ATSAY 12,2 (default) "Alt-Q Edit a file" ATSAY 14,2 (default) "Alt-R Reply to current message" ; ; Wait for a keypress, and return ; KEYGET S0 WCLOSE ; ; ESCAPE during this screen ; SET FLAG(0) OFF ; Clear flag if set RETURN ; ----------------------------------------------------------------------- ; ----- Compose: Compose and post an ad hoc note ; ; Entry: nothing ; Exit: FLAG(0) is set to return to main (ESC) ; Compose: WOPEN 8,15,10,55 N99 DispEsc ATSAY 8,17 N99 " Addressee " ATSAY 9,17 N99 " To: " ATSAY 10,29 N99 " Press ESC to cancel " ; ; Ask for a selection ; S0 = "" ; Make a NULL for loop WHILE NULL S0 ATGET 9,22 N99 8 S0 ; Get resp IF FLAG(0) ; Exit if ESC hit SET FLAG(0) OFF ; Clear flag setting WCLOSE ; CLose open window RETURN ; Exit if ESC hit ENDIF LJ S0 ; Left justify UPPER S0 ; Upper case it IF NULL S0 ; Require a name SOUND 100,100 ; Displeased S0 = "" ; Force a loop ENDIF ENDWHILE WCLOSE ; CLose window S10 = S0 ; Save addressee ; ; Ask if private... ; WOPEN 8,15,10,55 N99 DispEsc ATSAY 8,17 N99 " Message Type " ATSAY 9,17 N99 " Private reply (Y/N,cr=N)?" ATSAY 10,29 N99 " Press ESC to cancel " ; ; Ask for a selection ; S0 = "" ; Make a NULL for loop WHILE NULL S0 ATGET 9,44 N99 1 S0 ; Get resp IF FLAG(0) ; Exit if ESC hit SET FLAG(0) OFF ; Clear flag setting WCLOSE ; CLose open window RETURN ; Exit if ESC hit ENDIF IF NULL S0 S0 = "n" ; Default cr=no IF NOT FIND "YN" S0 ; Require y/n SOUND 100,100 ; Displeased S0 = "" ; Force a loop ENDIF ENDWHILE WCLOSE ; CLose window S11 = S0 ; Save private flag ; ; Ask for a subject ; WOPEN 8,15,11,65 N99 DispEsc ATSAY 8,17 N99 " Subject " ATSAY 9,17 N99 "Enter the subject line please:" ATSAY 11,29 N99 " Press ESC to cancel " ; ; Ask for a subject ; S0 = "" ; Make a NULL for loop ATGET 10,17 N99 48 S0 ; Get resp IF FLAG(0) ; Exit if ESC hit SET FLAG(0) OFF ; Clear flag setting WCLOSE ; CLose open window RETURN ; Exit if ESC hit ENDIF IF NULL S0 S0 = ".." ; If no response... WCLOSE ; CLose window S13 = S0 ; Save subject line ; ; Construct a file name for the new message ; N2 = 0 ; Make smallest possible date S14 = S24&"\"*S10&"." ; Save fname WHILE ISFILE S14*N2 and N2 LT 1000 INC N2 ; Move to next ENDWHILE ; If no error IF N2 GE 1000 S0 = "Cannot reply... you have "*N2*" notes outstanding" GOSUB Error RETURN ENDIF S14 = S14*N2 ; Save fname to use ; ; Build an editor batch file ; FOPENO "BBMAINT.TMP" text ; Try to open file IF FAILED ; From FOPENO above S0 = "Error opening BBMAINT.TMP" GOSUB Error ; Report RETURN ; Return to caller ENDIF ; ; Place the header to the file ; S0 = S10 PRESERVE S0 WRITE "To: "*S0 WRITE "!Insert!" WRITE "From: "*"Sysop" WRITE "!Insert!" WRITE "Date: "*"_DATE"*" "*"_Time" WRITE "!Insert!" S0 = S13 PRESERVE S0 WRITE "Subject: "*S0 WRITE "!Insert!" WRITE "!Insert!" ; ; If a response batch file exists, the next command executes THAT ; IF ISFILE S24&"\BBMAINT.MES" S0 = S24&"" ; Replicate PRESERVE S0 ; Retain !s ^s and `s WRITE "@"*S0 ; Write beginning of cmd WRITE "\BBMAINT.MES!" ; Write tail of cmd GOTO COMP100 ; and continue ENDIF ; ; No pre-existing batch file - make one ; WRITE "set margin 1 76!" WRITE "set exit text!" WRITE "Top!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Home!" WRITE ""*S10&", greetings!" WRITE "Insert!" WRITE "Insert!" WRITE "Begin text here; margin is set to 1:76; Wordwrap and INSERT enabled.!" WRITE "Insert!" WRITE "Press F3 to save response; Press F4 to cancel response; F10 for help!" WRITE "Insert!" WRITE "Insert!" WRITE "Sysop!" WRITE "Top!" WRITE "Home!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "Down!" WRITE "set insert!" WRITE "^Z" ; ; Close the batch file ; COMP100: FCLOSEO ; Ready to use it ; ; Invoke the editor to write a response ; SET TEXT N99 ; Reset Text attr STACK "^@A@BBMAINT.TMP!" ; ^@A -> F7; Stack batch file cmd EDIT S14 ; Open original 1st, then "response" SET TEXT "_DEFA" ; Make text mode DELETE "BBMAINT.TMP" ; Delete temp file we created IF NOT ISFILE S14 RETURN ; Skip if no response text prep'd ; ; Open the mail control file ; FOPENO S24&"\BBS-Mail" text append IF FAILED ; From FOPENO above S0 = "Error opening BBS-Mail" GOSUB Error ; Report RETURN ; Return to caller ENDIF ; ; Add a record to the mail file ; S2(0:7) = S10 ; New 'to' is old from S2(8:15) = "SYSOP" ; From ID S2(16:16) = " " ; Privacy flag IF FIND S11 "Y" S2(16:16) = "P" ; .. S2(17:24) = "_DATE" ; Set date field S2(25:37) = S10&"."*N2 ; FIle name S2(38:77) = S13 ; Subject PRESERVE S2 ; Retain !s ^s and `s WRITE S2 ; Issue Merge command WRITE "!" ; And a crlf ; ; And we're done ; FCLOSEO ; Done with file RETURN