home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Boston 2
/
boston-2.iso
/
DOS
/
HILFEN
/
MODEM
/
COMAND28
/
BBMAINT4.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-12-01
|
13KB
|
449 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.
; -----------------------------------------------------------------------
;
; 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
;
; Paint 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 "
MAFI100:
CLEAR ; Clear window
LOCATE 2,2
MESS " 1) Clean up mail directory"
MESS " 2) Delete notes older than ..."
MESS "_______________________________________"
MESS " "
MESS "Select item (carriage return = previous): "
;
; Wait for entry, and interpret
;
GET S0 1 ; Wait for it
SWITCH S0 ; Act according to keyget
CASE "1"
GOSUB ClrMail
ENDCASE
CASE "2"
GOSUB DelMail
ENDCASE
CASE "_NULL" ; c/r alone is exit
WCLOSE ; Close window...
RETURN ; and return to caller
ENDCASE
DEFAULT ; None of the above
SOUND 100,100 ; Bronx cheer
ENDCASE
ENDSWITCH
GOTO MAFI100 ; 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 any key to continue "
;
; Wait a keypress
;
GENU100:
LOCATE 12,15
GET S0 5 ; Wait for a number
IF NOT FLAG(0) ; If wasn't ESCAPE
ATOI S0 N0 ; Convert w/o err msg
IF ERROR ; If couldn't convert
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