Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : BBS.SRC

 
Output of file : BBS.SRC contained in archive : CA29-3.ZIP
; ----- COM-AND Scripted BBS mode
; Commenced: 03/18/88 R.McG
; Updated: 2/--/89 R.McG
; 10/--/89 R.McG (Allow blank lines, preserve lines to disc)
; Ver 1.1: 11/--/90 R.McG (Make BBSETUP utility script)
; Ver 1.2: 11/--/91 R.McG (Correct 88 char record len in BBS-MAIL)
; 4/--/91 R.McG (Add editor to BBMAINT scripts)
; -----------------------------------------------------------------------
; Goals:
; o Must autodetect caller's baud rate
; o Must work correctly for modems reporting true CD and otherwise.
;
; Functions:
; o ID/Passworded log-on (with registration)
; o Capabilities set by SYSOP
; o UP and DOWNLOADS
; o Mail and bulletins
; o Privileged access (Pathlist,CHDIR, DOS commands)
; -----------------------------------------------------------------------
; Usages:
; S0 ------> General scratch buffer
; S1 ------> ID;password during logon; ID after logon upper cased
; S2-S5 ---> scratch
; S6 ------> Logon time (used by Read_Comm to timeout)
; S7 ------> scratch
; S8 ------> Scratch buffer
; S9 ------> General read buffer
; S10-S18 -> Scratch buffers
; S19 -----> Is used to save default subdir within commands
; S20-S25 -> Default values from BBSDAT
; S20 -> port, speed
; S21 -> modem init we'll use for restart
; S22 -> BBS default subdir
; S23 -> BBS default files subdir
; S24 -> BBS default mail subdir
; S25 -> BBS default bulletin subdir
; S28 -----> DLDIR on entry
; S29 -----> subdirectory on entry
;
; N0 ------> # minutes allowed for call (set by logon)
; N10-N19 -> Generally scratch
; N97-N99 -> Generally scratch
;
; FLAG(0) -> ON if an error condition is being reported...
; Upon return from Read_Comm: ON -> timeout or disconn
; Upon return from Logon -> OFF -> Logon OK
; FLAG(1) -> After Logon, privileged access if ON
; FLAG(2) -> a CHDIR has been performed by a privileged user
; FLAG(3) -> There is a logged on caller (if true)
; -----------------------------------------------------------------------
;
LEGEND "Scripted BBS (1.2); initializing"
WOPEN 10,1 12,78 (default)
ATSAY 11,3 (default) "Initializing BBS.. "
;
; Set default values (in case BBSDAT does not exist)
;
S20 = "_PARM"(11:14)*","*"_PARM"(0:3) ; Port(4),speed(4)
S21 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M" ; Standard MINIT for BBS
S22 = "\BBS" ; Set to our subdirectory
S23 = "\BBS\FILES" ; Set subdir for files
S24 = "\BBS\MAIL" ; Set subdir for mail
S25 = "\BBS\BULLETIN" ; Set subdir for bulletins
;
; Initialize COM related values (This is done here to allow BBSDAT
; ... edits to override these settings)
;
SET PARITY NONE ; BBS is fixed no parity
SET DATA 8 ; BBS is fixed 8 data bits
SET STOP 1 ; bbs is fixed 1 stop bit
SET MASK ON ; accept 7 or 8 bits
SET CR_IN CR_LF ; Display received c/rs as a cr/lf
SET ASCII UP_LF LF ; Send LFs
SET SOFTFLOW ON ; Allow XON/XOFF
SET ZMODEM AUTO OFF ; Automatic ZMODEM (user must say 'z')
SET ZMODEM RECOVER OFF ; No ZMODEM recovery
;
; Replace above values from BBSDAT, if that script exists
;
IF ISSC "BBSDAT"
FCALL "BBSDAT"
ELSE
S10 = "_SCRIPT" ; Get current script fname
GOSUB Parse_Fname ; Extract drive:Subdir from name
S10 = S10*"\BBSDAT" ; Make new name
IF ISSC S10 FCALL S10 ; Invoke it if its THERE
ENDIF
;
; Initialize variables that must be constant
;
SUBDIR S29 ; Read current subdir
DLDIR S28 ; Read current download subdir

FFIRST S22 ; Test for presence of main subd
IF FAILURE or NOT ISFILE S22*"\BBS-User" ; Test presence of user file
WCLOSE ; Clear 'initializing' window
GOTO NoUser ; .. Skip if not found
ENDIF
;
; Initialize other values
;
SET BAUD S20(5:8) ; Starting speed
SET PORT S20(0:3) ; Starting port
SET INAFTER OFF ; Turn off init after hangup
;
; Initialize other values
;
SET ALARM OFF ; Turn off alarm
SET ATIME 1 ; Set alarm time to 1 second
CHDIR S22 ; Set to our subdirectory
SET DLDIR S23 ; Set DLDIR
LEGEND "Scripted BBS (1.1); Press ESC to terminate or to CHAT."
TRANSMIT "_MESCAPE" ; Initialize modem (modem escape)
WCLOSE ; End init (before ON ESC)

ON ESCAPE GOSUB Escape ; Enter chat mode on operator escape
S9 = "* BBS script loaded" ; Set text of msg
CLOG S9 ; .. to call log
GOSUB Log_Item ; .. and to BBS-Log
GOTO Restart ; Branch around subroutines
; -----------------------------------------------------------------------
; Subroutine: Parse drive:subdirectory from file name
;
; S10 passes fully name S10 returns drive:subdirectory
; S11 returns file name
; N10,N11 are scratch values
; -----------------------------------------------------------------------
;
Parse_Fname:
LENGTH S10 N10 ; Find length of string
FOR N11 = (N10-1),0,-1 ; Scan backwards through string
IF STRCMP S10(N11:N11) ":" or STRCMP S10(N11:N11) "\" GOTO PAFN100
ENDFOR
S11 = S10 ; No drive or path
S10 = "" ; Return null drive:path spec
RETURN
;
; Extract drive and path from name; N11 points to ":" or "\"
;
PAFN100:
S11 = S10(N11+1:N10) ; Extract name portion
IF STRCMP S10(N11:N11) "\" DEC N11
S10 = S10(0:N11) ; Save ":", remove last "\"
RETURN
; -----------------------------------------------------------------------
; Subroutine: No user ID file
;
; S0 is used as scratch
; -----------------------------------------------------------------------
;
NoUser:
;
; Issue a pop-up
;
LEGEND "Scripted BBS (1.1); Error initializing"
WOPEN 10,10,17,70 (default) NoUser_End
ATSAY 10,12 (default) " BBS initialization "
ATSAY 11,12 (default) "There is no user ID file (BBS-User) to be found on the"
ATSAY 12,12 (default) "subdirectory: "*S22
ATSAY 14,12 (default) "The script BBSETUP must be used to identify the subdir-"
ATSAY 15,12 (default) "ectory used by this BBS, and to create and maintain the"
ATSAY 16,12 (default) "files it uses."
ATSAY 17,29 (default) " Press any key to continue "
KEYGET S0
NoUser_End:
WCLOSE ; Close window we opened
EXIT ; Finish - no changes need be reset
;
; -----------------------------------------------------------------------
; Subroutine: Operator ESCAPE
; -----------------------------------------------------------------------
;
Escape:
CURSOR N98,N97
WOPEN 10,1 20,78 (default) ESC_ESC
ATSAY 10,3 (default) " BBS Operator menu "
ATSAY 12,3 (default) "1) Terminate the BBS"
IF FLAG(3) ; Not during call
ATSAY 13,3 (default) "2) Enter chat with caller"
ELSE
ATSAY 13,3 (default) ".. No caller currently on "
ENDIF
ATSAY 14,3 (default) "3) Cancel this window"
ATSAY 15,1 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
IF ISSCRIPT "BBMAINT" and NOT FLAG(3) ; Not during call
ATSAY 16,3 (default) "4) Invoke BBS maintenance scripts"
ELSE
ATSAY 16,3 (default) ".. Maintenance script not available"
ENDIF
IF ISSCRIPT "BBSETUP" and NOT FLAG(3) ; Not during call
ATSAY 17,3 (default) "5) Invoke BBS setup script"
ELSE
ATSAY 17,3 (default) ".. Setup script not available"
ENDIF
ATSAY 18,1 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY 19,3 (default) "Select item: "
ATSAY 20,31 (default) " Press ESC to cancel "
LOCATE 19,16
KEYGET S0
WCLOSE
LOCATE N98,N97
;
; Interpret the response
;
SWITCH S0 ; Interpret resp in S0
CASE "1" ; Terminate
GOTO End
ENDCASE
CASE "2" ; Chat
IF FLAG(3) GOTO Chat
ENDCASE
CASE "3" ; Bulletin
RETURN
ENDCASE
CASE "4" ; Maintenance
GOSUB EndBBS ; Terminate BBS
IF ISFILE "BBMaint" EXECUTE "BBMaint"
ENDCASE
CASE "5" ; Setup
GOSUB EndBBS ; Terminate BBS
IF ISFILE "BBSetup" EXECUTE "BBSetup"
ENDCASE

DEFAULT ; None of the above
SOUND 100,100 ; Rsapberry
ENDCASE
ENDSWITCH
GOTO Escape
;
; Escape during ESCAPE window
;
ESC_ESC:
S0 = "3" ; Selection = return
RETURN ; We're done
;
; -----------------------------------------------------------------------
; Subroutine: End of BBS
; -----------------------------------------------------------------------
;
End:
GOSUB EndBBS
EXIT
;
; -----------------------------------------------------------------------
; Subroutine: End of BBS
; -----------------------------------------------------------------------
;
EndBBS:
SET TTHRU OFF ; Inhibit type thru
WOPEN 10,1 12,78 (default)
ATSAY 11,3 (default) "Terminating BBS.. "

HANGUP ; Hangup the phone
S9 = "* BBS script terminated" ; Set msg to log
CLOG S9 ; Log completion
GOSUB Log_Item ; .. both places
SET DLDIR S28 ; Reset dldir
CHDIR S29 ; Reset to default directory
RESET ; Reset default values
CLEAR ; Clear screen
MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
TRAN "_MINIT" ; Initialize modem from defaults
DELETE "\HOSTTEMP.TXT" ; Cleanup

WCLOSE
RETURN ; We're done
; -----------------------------------------------------------------------
; Subroutine: Chat mode: Operator entered escape
;
; S0 is used as scratch
; -----------------------------------------------------------------------
;
Chat:
;
; Start chat mode.
;
TRAN "^M^J" ; Send a c/r
TRAN "^M^JOperator initiated chat mode..."
S2 = "_LEGEND" ; Save previous legend
LEGEND "Scripted BBS (1.1); Chat mode; null entry at prompt to exit"
;
; Read from the operator
;
Chat_Loop:
MESS "^M^JSYSOP: " ; Prompt
GET S0 80 ; Read from kbd

IF NULL S0 ; If blank entry
MESS "Continue? (Y/N, cr=y): "
GET S0 2 ; Read a response
IF FIND S0 "N" ; If response was no
TRAN "^M^JChat terminated by SYSOP"
LEGEND S2 ; Restore previous legend
RETURN ; Return to what we were doing
ENDIF
S0 = " " ; Make a blank line
ENDIF
TRAN "^M^JSYSOP: "
TRAN S0 ; Send the line
;
; Read from the caller
;
MESS "Caller: " ; NO c/r req'd
TRAN "^M^JCaller: " ; Prompt
GOSUB Read_Comm ; read the comm port
IF FLAG(0) ; If caller disconn
MESS "^M^JCaller disconnected" ; Inform sysop
LEGEND S2 ; Restore previous legend
RETURN ; ANd return
ENDIF
GOTO Chat_Loop ; And continue
; -----------------------------------------------------------------------
; Subroutine: Limit time on-line
; .. S6 -> Time of logon
; .. N0 -> Max minutes allowed
;
; FLAG(0) off -> Time remaining
; on --> Disconnect the caller
;
; S9 and N18,N19 are used as scratch
; -----------------------------------------------------------------------
;
Limit_Time:
;
; If privileged user, just return true
;
IF FLAG(1) ; If privileged user
SET FLAG(0) OFF ; Return OK
RETURN ; Return to caller
ENDIF
;
; Convert times to numeric quantities
;
TIME S9 1 ; Get current time (military fmt)
N19 = S9(0:1)*60+S9(3:4) ; Compute current time since midnight
N18 = S6(0:1)*60+S6(3:4) ; Time of logon since midnight
;
; And test the time remaining
;
IF GT N18 N19 ; If timeout on the RGET
N19 = N19+1440 ; Allow wrap accross midnight
ENDIF
N19 = N19-N18 ; COmpute time on

IF GT N19 N0 ; Test against logon determined time
TRAN "^M^JYour alotted time has expired..."
TRAN "^M^JYou are being disconnected."
SET FLAG(0) ON ; Indicate disconnect
RETURN ; RETURN to caller
ENDIF
;
; Return 'OK'
;
SET FLAG(0) OFF ; Report to caller
RETURN ; Return with text in S9
; -----------------------------------------------------------------------
; Subroutine: Read from the caller into S9
; .. This handles 'disconnect' and timeouts.
;
; FLAG(0) off -> Line read correctly
; on --> Disconnect or timeout
; -----------------------------------------------------------------------
;
Read_Comm:
;
; Test timeout
;
IF FLAG(3) ; If user logged on now
GOSUB Limit_Time ; Test time on-line
IF FLAG(0) RETURN ; If error returns set, end proc here
ENDIF
;
; Now, sit on the COMM port waiting for a read
;
RGET S9 80 180 ; Wait for a connection
IF NOT CONNECTED GOTO Disconnect; If modem reports CD dropped
IF FAILED GOTO Timeout ; If timeout on the RGET issue msg and disconn
FIND S9 "NO CARRIER" ; Test for message from modem
IF FOUND GOTO Disconnect ; If modem didn't report 'CD' true
;
; Return 'text read'
;
SET FLAG(0) OFF ; Report to caller
RETURN ; Return with text in S9
;
; Timeout on the call
;
Timeout:
TRAN "^M^J... autodisconnect due to timeout^M^J"
MESSAGE "^M^J... autodisconnect due to timeout"
GOTO RComm_Exit ; Exit cycle in the usual manner
;
; Disconnect was reported.
;
Disconnect:
MESSAGE "^M^JCaller disconnected"
;
; Read_Comm error exit
;
RComm_Exit:
SET FLAG(0) ON ; Report to caller
RETURN ; Return to the caller
; -----------------------------------------------------------------------
; Subroutine: Display the # of allotted minutes remaining
; .. S6 -> Time of logon
; .. N0 -> Max minutes allowed
;
; S9 and N18,N19 are used as scratch
; -----------------------------------------------------------------------
;
Display_Limit:
;
; If privileged user, just return (no message)
;
IF FLAG(1) RETURN ; If privileged user, rtn to caller
;
; Convert times to numeric quantities
;
TIME S9 1 ; Get current time (military fmt)
N19 = S9(0:1)*60+S9(3:4) ; Compute current time since midnight
N18 = S6(0:1)*60+S6(3:4) ; Time of logon since midnight
;
; Compute the time remaining
;
IF GT N18 N19 ; If timeout on the RGET
N19 = N19+1440 ; Allow wrap accross midnight
ENDIF
N19 = N0-(N19-N18) ; Compute remaining time
;
; Display the quantity and we're done
;
STRFMT S9 "^M^J(%d minutes remaining)" N19
TRAN S9
RETURN ; Return with text in S9
; -----------------------------------------------------------------------
; Subroutine: Logon - ID/password are in S1 (0:15)
;
; On exit:
; FLAG(0) ON -> indicate falure of logon
; FLAG(1) ON -> if logon successful to indicate privileged access
; -----------------------------------------------------------------------
;
Logon:
FOPENI "BBS-User" TEXT ; OPEN file for input
IF FAILED ; if open failed
SET FLAG(0) ON ; Report an error
RETURN ; Return to caller
ENDIF
;
; Read records from BBS-User
;
Logon_Loop:
READ S9 80 N19 ; Read a record * COM-AND
IF EOF ; Test for EOF
FCLOSEI ; CLose the input file
SET FLAG(0) ON ; Report an error
RETURN ; Return to caller
ENDIF

FIND S9(0:0) "<" ; Test for comment line
IF FOUND GOTO Logon_Loop ; IF "<" found,

SWITCH S1 ; Test ID/Password
CASE S9(0:15) ; .. against record
GOTO Logon_OK ; We have a match
ENDCASE
ENDSWITCH
GOTO Logon_Loop ; Read the next record
;
; We have a successful logon
;
Logon_OK:
SET FLAG(1) OFF ; Default no privilege
SET FLAG(3) ON ; Set flag to say 'logged-on'
N0 = 60 ; Set time limit for non-privileged user

FIND S9(16:16) "P" ; Test for privilege
IF FOUND ; IF "P" found,
SET FLAG(1) ON ; Indicate privilege
N0 = 3000 ; 50 hours ought to be enough
ENDIF

TIME S6 1 ; Set time of logon (military fmt)

FCLOSEI ; CLose the input file
SET FLAG(0) OFF ; Indicate successful logon
RETURN
; -----------------------------------------------------------------------
; Subroutine: DispFile: Display a file
;
; On entry:
; S8 -> The file to be opened (and displayed)
; S9 -> A message to be displayed if the file D.N.E
; -----------------------------------------------------------------------

;
Disp_File:
IF ISFILE S8 ; If File exists
TRAN "^M^J" ; Send an initial delimiter
SENDFILE ASCII S8 ; Send the file
RETURN ; Return to caller
ENDIF

IF ISFILE S22&"\"*S8 ; If file exists on primary subdir
TRAN "^M^J" ; Send an initial delimiter
SENDFILE ASCII S22&"\"*S8 ; Send the file
RETURN ; Return to caller
ENDIF

TRAN S9 ; Display the alternative message
RETURN ; Return to caller
; -----------------------------------------------------------------------
; Subroutine: Log_Item: Add a line to the activity log
;
; On entry:
; S9 -> The line to be added
;
; S7 is used as a scratch reg; S9 is modified
; -----------------------------------------------------------------------
;
Log_Item:
FOPENO S22&"\BBS-LOG" TEXT APPEND ; OPEN file for output
IF FAILED RETURN ; If open failed, rtn here

DATE S7 ; Get current date
CONCAT S9(59) S7 ; Add date to S9 line
TIME S7 1 ; Get current time (military fmt)
CONCAT S9(70) S7 ; Add time to S9 line

WRITE S9 ; Write a record * COM-AND
WRITE "^M" ; Write a cr/lf * COM-AND
FCLOSEO ; CLose the output file
RETURN ; And we're done
;
; -----------------------------------------------------------------------
; Subroutine: Copy text to an open file (write a message)
; The output file must be opened by the caller
;
; S9, N18 are used as scratch
; N20 carries the current linenum (and must be preserved on GOSUBs)
; -----------------------------------------------------------------------
;
Copy_Text:
N20 = 0
;
; Prompt with a line number, and read a line of text in response
;
Copy_Loop:
INC N20 ; Increment line counter
S9 = N20 & ": ^H" ; Convert to decimal ascii
TRAN S9 ; Transmit line number

GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error, make end of text
;
; If the line is not blank, copy it to the output file
;
LENGTH S9 N18 ; Get proper length
IF NOT ZERO N18 ; Test for an empty line
PRESERVE S9 ; Preserve "!"s and "^"s
WRITE S9 ; Write the line * COM-AND
IF FAILED ; if write failed
TRAN "Error recording text - please try later^M^J"
RETURN ; Return to caller
ENDIF
WRITE "!" ; And a record delimiter * COM-AND
GOTO Copy_Loop ; And loop
;
; A blank line was entered - ask if we are to terminate
;
ELSE
TRAN "^M^JComplete? (Y/N, cr=n): " ; Ask if this is end of input
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error - disconn
IF NOT FIND S9 "Y" ; Test for positive response
WRITE "!" ; Write a blank line
GOTO Copy_Loop ; COntinue copying
ENDIF
ENDIF
RETURN ; Return - we're done
; -----------------------------------------------------------------------
; ----- Begin ... reset values, and set the modem to accept a call
; -----------------------------------------------------------------------
;
Restart:
CHDIR S22 ; Reset to default drive
SET RECHO OFF ; Turn off echo for us
SET RDISP OFF ; Turn on display of received chars
CLEAR ; Clear screen
LOCATE 0,0 ; Set to home

SET FLAG(1) OFF ; Turn off privilege flag
SET FLAG(2) OFF ; Turn off CHDIR flag
SET FLAG(3) OFF ; Turn off logged-on flag
;
; Go into auto answer (echo off, answer on 3rd)
; Also: Return result codes, word form, with CONNECT 1200
;
HANGUP ; HANGUP and leave modem in cmd mode
MESSAGE "^M^JWaiting..."
PAUSE 3 ; Wait 3 secs
SET BAUD S20(5:8) ; Starting speed
TRANSMIT S21 ; Transmit modem initialization
;
; -----------------------------------------------------------------------
; ----- Wait for a connect
; -----------------------------------------------------------------------
;
Wait_Connect:
RGET S9 80 180 ; Wait for a line
IF FAILED GOTO Wait_Connect ; If nothing was read

FIND S9 "NO CARRIER" ; Look for a disconn
IF FOUND GOTO Restart

FIND S9 "CONNECT" ; Anything else BUT CONNECT
IF NOT FOUND GOTO Wait_Connect ; .. waits
;
; ----- Connection established: Adjust our linespeed if need be
;
GOSUB AutoBaud ; Change rate according to CONNECT MSG
;
; ----- Issue a greeting
;
PAUSE 3 ; Let the modem settle
RFLUSH ; Clear line

SET RECHO ON ; Turn on echo (echo back to caller)
SET RDISP ON ; Turn on display of received chars
PAUSE 1 ; MOdem settling

S9 = "^M^JThe Flying Scotsman greets you!! ^M^J"
S8 = "BBS-Welc" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E

N10 = 0 ; Set count of logon tries
;
; ----- Request an ID
;
ID_Query:
MESS "^M^JID prompt: " ; Local console indicator
TRANSMIT "^M^JEnter your ID (or enter GUEST): "
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set disconn

IF NULL S9 ; Test for nothing entered
INC N10 ; Count it as a logon try
IF GE N10 3 GOTO Logon_Fail ; If tried 3 times to logon quit
GOTO ID_Query ; Require an ID
ENDIF ; End of empty test

SWITCH S9
CASE "GUEST" ; Test for nothing entered
GOSUB Register ; Try to register the caller
GOTO Exit ; And exit the sequence
ENDCASE ; End of GUEST test
ENDSWITCH ; End of ID test
S1 = S9(0:7) ; Save 8 chars of ID
UPPER S1 ; Make ID upper case
;
; ----- Request a password
;
Password_Query:
TRANSMIT "^M^JEnter your password: "
SET RECHO OFF ; Turn of echo of received text
SET RDISPLAY OFF ; Turn off echo to console too

GOSUB Read_Comm ; Read into S9
SET RECHO ON ; Restore echo
IF FLAG(0) GOTO Exit ; If first flag rtns set disconn
SET RDISPLAY ON ; Turn on echo to console again

IF NULL S9 ; Test for nothing entered
INC N10 ; Count it as a logon try
IF GE N10 3 GOTO Logon_Fail ; If tried 3 times to logon quit
GOTO Password_Query ; Require a password
ENDIF ; End of empty test
;
; Build the ID/password string and test logon
;
S1(8:79) = S9(0:7) ; Add password to S1
GOSUB Logon ; Test logon
IF NOT FLAG(0) ; If flag(0) returns reset, its ok
S9 = "Logon: "*S1(0:7) ; Set activity
GOSUB Log_Item ; Add S9 to BBS-LOG
SET FLAG(2) OFF ; Indicate no CHDIR this user
S1 = S1(0:7) ; Throw away password
CLOG "* BBS logon: "*S1
TRAN "^M^J" ; Space one line fror caller
GOTO Main_Prompt ; OK - we're on
ENDIF
;
; Unrecognized ID/password
;
Logon_Fail:
TRAN "Unrecognized ID/Password^M^J"
INC N10 ; Increment count of tries
IF GE N10 3 ; If tried 3 times to logon
TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
MESS "^M^JLogon attempts failed^M^J"
S9 = "Failed logon" ; Report to log
GOSUB Log_Item
GOTO Exit ; ANd hangup
ENDIF
GOTO ID_Query ; And try again
; -----------------------------------------------------------------------
; ----- Main Loop: Prompt for a command and interpret the return
; -----------------------------------------------------------------------
;
Main_Prompt:
MESS "^M^JMain prompt: " ; Local console indicator
GOSUB Display_Limit ; Report amount of time remaining

IF NOT FLAG(1) ; According to privilege
S9 = "^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
S8 = "BBS-NpMn" ; Set file name
ELSE
S9 = "^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
S8 = "BBS-PrMn" ; Set file name
ENDIF
GOSUB Disp_File ; Display file contents or S9 if file D.N.E
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Perform commands
;
SWITCH S9 ; Test the entry
;
; Alarm
;
CASE "A" ; Signal request for chat mode
GOTO Alarm
ENDCASE
;
; Mail
;
CASE "M" ; Messages
GOTO Mail_Command
ENDCASE
;
; Files command
;
CASE "F" ; Files
GOTO File_Command
ENDCASE
;
; Comment command
;
CASE "C" ; Leave a note
GOTO Comment
ENDCASE
;
; Bulletin command
;
CASE "B" ; Read bulletins
GOTO Bull_Command
ENDCASE
;
; Exit command
;
CASE "E" ; Exit
GOTO Logoff ; Transmit acknowlegement and Exit
ENDCASE
;
; Privileged command
;
CASE "P" ; Privilege
IF FLAG(1) GOTO Priv_Prompt; Execute only if privileged
ENDCASE
ENDSWITCH
;
; Invalid command
;
TRAN "^M^JCommand not recognized... try again^M^J"
GOTO Main_Prompt
;
; -----------------------------------------------------------------------
; Logoff
; -----------------------------------------------------------------------
;
Logoff:
CHDIR S22 ; Set to our subdirectory
TRAN "^M^JOK... Bye^M^J" ; Say g'bye and fall thru to Exit
S9 = "Logoff: "*S1(0:7) ; Set activity
CLOG S9 ; Log here too
GOSUB Log_Item ; Add S9 to BBS-LOG
;
; -----------------------------------------------------------------------
; General exit routine - don't GOTO from within a subroutine!!!
; -----------------------------------------------------------------------
;
Exit:
S9 = "* BBS cycled" ; Set activity
CLOG S9 ; Call log it too
GOSUB Log_Item ; Add S9 to BBS-LOG
MESS "^G" ; Beep console to indicate exit
GOTO Restart ; And start over
;
; -----------------------------------------------------------------------
; Alarm routine - make some noise, in hopes we can upset somebody
; -----------------------------------------------------------------------
;
Alarm:
SOUND 440 500 ; 1/2 sec Scale in 'A'
SOUND 493 100 ; 1/10 sec
SOUND 554 100 ; 1/10 sec
SOUND 587 100 ; 1/10 sec
SOUND 659 100 ; 1/10 sec
SOUND 739 100 ; 1/10 sec
SOUND 830 100 ; 1/10 sec
SOUND 880 500 ; 1/2 sec
GOTO Main_Prompt ; And start over
; -----------------------------------------------------------------------
; ----- Privileged commands submenu.
; -----------------------------------------------------------------------
;
Priv_Prompt:
MESS "^M^JPrivilege prompt: " ; Local console indicator
GOSUB Display_Limit ; Report amount of time remaining
S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
S8 = "BBS-PPMn" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Execute a command
;
SWITCH S9 ; Test the entry
;
; List command
;
CASE "L" ; List
GOTO DIR
ENDCASE
;
; Subdir command
;
CASE "S" ; Chdir
GOTO CHDIR
ENDCASE
;
; Pathlist command
;
CASE "P" ; Pathlist
GOTO PATHLIST
ENDCASE
;
; Shell command
;
CASE "D" ; Shell
GOTO Shell
ENDCASE
;
; Main command
;
CASE "M" ; Go back to main prompt
GOTO Main_Prompt
ENDCASE
;
; Exit command
;
CASE "E" ; Exit
GOTO Logoff ; Transmit acknowlegement and Exit
ENDCASE
ENDSWITCH
;
; Invalid command
;
TRAN "^M^JCommand not recognized... try again^M^J"
GOTO Priv_Prompt
; -----------------------------------------------------------------------
; Privileged user: CHDIR... Query for a path.
; -----------------------------------------------------------------------
;
CHDIR:
MESS "^M^JCHDIR Command: " ; Local console indicator
TRAN "^M^JEnter the drive:subdirectory: "

GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NOT NULL S9 ; If something entered
CHDIR S9 ; Do it.
SET FLAG(2) ON ; Save the fact we've done a CHDIR
ENDIF
GOTO Priv_Prompt ; And continue
; -----------------------------------------------------------------------
; Privileged user: Path tree... awkward... but it works
; -----------------------------------------------------------------------
;
PATHLIST:
MESS "^M^JPathlist command: " ; Local console indicator
TRAN "^M^JWorking..." ; May take a moment

DOS "TREED >\HOSTTEMP.TXT" ; To a temp file

TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
SENDFILE ASCII "\HOSTTEMP.TXT"
TRAN "^M^J" ; Send a c/r

DELETE "\HOSTTEMP.TXT" ; Clean up after us
GOTO Priv_Prompt ; And continue
; -----------------------------------------------------------------------
; Privileged user: DOS SHELL... Query for a command
; -----------------------------------------------------------------------
;
Shell:
MESS "^M^JDOS Command: " ; Local console indicator
TRAN "^M^JWarning: this command may be used to invoke ANY COMMAND that"
TRAN "^M^JDOS can execute. If you load a program requiring keyboard "
TRAN "^M^Jentry, you lock yourself out and leave the board unusable."
TRAN "^M^J"
TRAN "^M^JEnter your command: "

GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NULL S9 ; If nothing entered
GOTO Priv_Prompt ; User decided better
ENDIF

IF FIND S9 "FORMAT" ; Disallow any format commands
TRAN "^M^JFormat commands are not allowed..."
GOTO Priv_Prompt ; And continue
ENDIF
;
; Perform it
;
TRAN "^M^JWorking..." ; May take a moment

CONCAT S9 ">\HOSTTEMP.TXT"
DOS S9 ; Do it.

TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
SENDFILE ASCII "\HOSTTEMP.TXT"
TRAN "^M^J" ; Send a c/r


DELETE "\HOSTTEMP.TXT" ; Clean up after us
GOTO Priv_Prompt ; And continue
; -----------------------------------------------------------------------
; Directory list... awkward... but it works
; -----------------------------------------------------------------------
;
Dir:
MESS "^M^JDirectory command: " ; Local console indicator
TRAN "^M^JWorking..." ; May take a moment

DOS "DIR >\HOSTTEMP.TXT" ; To a temp file
TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
SENDFILE ASCII "\HOSTTEMP.TXT"
TRAN "^M^J" ; Send a c/r

DELETE "\HOSTTEMP.TXT" ; Clean up after us
GOTO Priv_Prompt ; And continue
; -----------------------------------------------------------------------
; Files command: File list, Upload, download or back to main
;
; Note: S19 must be retained throughout this submenu...
; It is used to save the current subdir
; -----------------------------------------------------------------------
;
File_Command:
MESS "^M^JFile prompt: " ; Local console indicator
SUBDIR S19 ; Save current subdir
CHDIR S23 ; Set to default subdir
;
; Prompt for a command
;
File_Prompt:
GOSUB Display_Limit ; Report amount of time remaining
S9 = "^M^JL)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
S8 = "BBS-FiMe" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Interpret the command
;
SWITCH S9 ; Test the entry
;
; Download command
;
CASE "D" ; Download
GOTO DOWNLOAD
ENDCASE
;
; Upload command
;
CASE "U" ; Upload
GOTO UPLOAD
ENDCASE
;
; List command
;
CASE "L" ; File list
GOTO FILELIST
ENDCASE
;
; Search command
;
CASE "S" ; Search list
GOTO Search
ENDCASE
;
; Main command
;
CASE "M" ; Go back to main prompt
CHDIR S19 ; Reset subdir
GOTO Main_Prompt
ENDCASE
;
; Exit command
;
CASE "E" ; Exit
GOTO Logoff ; Transmit acknowlegement and Exit
ENDCASE
ENDSWITCH

TRAN "Invalid selection - try again^M^J"
GOTO FILE_Prompt
; -----------------------------------------------------------------------
; Subroutine: Query for a file name - return in S8
; On exit:
; FLAG(0) Returned ON to indicate caller disconn/timedout
; -----------------------------------------------------------------------
;
File_Query:
MESS "^M^JFname query: " ; Local console indicator
TRAN "^M^JEnter the file name: "

GOSUB Read_Comm ; Read into S9
RETURN ; Return to caller (w/flag(0) set)
;
; -----------------------------------------------------------------------
; XMODEM Upload (up from caller)
;
; Files unqualified by drive:subdir are placed in the default
; DLOAD subdirectory.
;
; Note: Qualified names (containing subdir) are permitted
; only if the privilege flag (FLAG(1)) is set.
; -----------------------------------------------------------------------
;
UPLOAD:
MESS "^M^JUpload from caller "

GOSUB File_Query ; Ask for a file name
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NULL S9 ; If no file returned
GOTO File_Prompt ; .. start over
ENDIF ; ..

IF FIND S9 "\" and NOT FLAG(1) ; Test for subdir in name and privilege
TRAN "^M^JQualified file names are not permitted."
GOTO UPLOAD ; Ask again
ENDIF

IF ISDLFILE S9 ; If file exists in DL subdir
TRAN "^M^JFile already exists"
GOTO UPLOAD ; Ask again
ENDIF
;
; Prompt for a method
;
MESS "^M^JUlo Method prompt: " ; Local console indicator
TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, or K)ermit: "

S8 = S9 ; Save file name
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Interpret the response
;
TIME S10 1 ; Save start of upload time
SWITCH S9 ; Test the entry
CASE "W"
TRAN "^M^JBegin your transfer procedure..."
GETFILE WXMODEM S8
ENDCASE
CASE "X"
TRAN "^M^JBegin your transfer procedure..."
GETFILE XMODEM S8
ENDCASE
CASE "Y"
TRAN "^M^JBegin your transfer procedure..."
GETFILE YMODEM S8
ENDCASE
CASE "Z"
TRAN "^M^JBegin your transfer procedure..."
GETFILE ZMODEM
ENDCASE
CASE "K"
TRAN "^M^JBegin your transfer procedure..."
GETFILE KERMIT ; FIle name supplied by caller
ENDCASE
DEFAULT
TRAN "^M^JInvalid transfer selection"
SET SUCCESS OFF
GOTO EOTransfer
ENDCASE
ENDSWITCH
;
; Log the transfer
;
IF FAILED
S9 = "Upload ("*S9(0:0)*"): "*S8&", Failure"
GOSUB Log_Item ; Add S9 to BBS-LOG
DELETE S8 ; Delete parial file
SET SUCCESS OFF ; Control msg to console
GOTO EOTransfer
ELSE
S9 = "Upload ("*S9(0:0)*"): "*S8&", Success"
GOSUB Log_Item ; Add S9 to BBS-LOG
ENDIF
;
; A file uploaded with subdirectory doesn't get logged
;
IF FIND S8 "\" ; Test for subdir in name
GOTO File_Prompt ; Skip logging it
ENDIF
;
; Convert times to numeric quantities
;
TIME S11 1 ; Get current time (military fmt)
N19 = S11(0:1)*60+S11(3:4) ; Compute current time since midnight
N18 = S10(0:1)*60+S10(3:4) ; Time of upload since midnight
;
; Compute the time remaining and add it to the max
;
IF GT N18 N19 ; If timeout on the RGET
N19 = N19+1440 ; Allow wrap accross midnight
ENDIF
N0 = N0+(N19-N18) ; Compute time to upload and add it in
;
; At this point, ask for a description for the file
;
Describe:
TRAN "^M^JDescription: " ; Prompt
GOSUB Read_Comm ; Read response
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NULL S9 ; If nothing entered
TRAN "^M^JPlease leave something of a description"
GOTO Describe ; Try again
ENDIF
;
; Open the file list, and append the file
;
FOPENO "BBS-File" TEXT APPEND ; Open the file to append
IF FAILED
S9 = "Uload of "*S8&" succeeded, but BBS-FIle open failed"
GOSUB Log_Item ; Log it
SET SUCCESS OFF ; Indicate failure for console
GOTO EOTransfer ; If error, exit
ENDIF
;
; Build a record for BBS-FIle
;
DATE S0 ; Get the current date
S8 = S8 & " " ; Ensure blank padding
FSIZE S11 S8 ; Get file size using fname
S10 = S8(0:11) * S0(0:7) *" "* S11(0:6) * S9
WRITE S10 ; write the record
WRITE "!" ; Write a delimiter

FCLOSEO ; Close the output file
SET SUCCESS ON ; Indicate success
GOTO EOTransfer ; Report success/failure
; -----------------------------------------------------------------------
; XMODEM Download (down to caller)
;
; Download occurs from the default drive:subdir unless explicitly
; qualified.
;
; Note: Qualified names (containing subdir) are permitted
; only if the privilege flag (FLAG(1)) is set.
; -----------------------------------------------------------------------
;
DOWNLOAD:
MESS "^M^JDownload to caller "

GOSUB File_Query ; Ask for a file name
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NULL S9 GOTO File_Prompt ; If no file returned, start over
IF FIND S9 "\" ; Test for subdir
IF NOT FLAG(1) ; Test for privilege
TRAN "^M^JQualified file names are not permitted."
GOTO DOWNLOAD ; Ask again
ENDIF
ENDIF

IF NOT ISFILE S9 ; If file doesn't exist
GOSUB FileTest ; Look in BBS-File
IF FAILED ; If not found
TRAN "^M^JFile doesn't exist"
GOTO DOWNLOAD ; Ask again
ENDIF ; Else S9 contains file name
ENDIF
S8 = S9 ; Save file name
;
; Prompt for a method
;
MESS "^M^JDlo Method prompt "
TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, K)ermit, or A)scii: "
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Interpret the response
;
SWITCH S9 ; Test the entry
CASE "A"
TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
SENDFILE ASCII S8
ENDCASE
CASE "W"
TRAN "^M^JBegin your transfer procedure..."
SENDFILE WXMODEM S8
ENDCASE
CASE "X"
TRAN "^M^JBegin your transfer procedure..."
SENDFILE XMODEM S8
ENDCASE
CASE "Y"
TRAN "^M^JBegin your transfer procedure..."
SENDFILE YMODEM S8
ENDCASE
CASE "Z"
TRAN "^M^JBegin your transfer procedure..."
SENDFILE ZMODEM S8
ENDCASE
CASE "K"
TRAN "^M^JBegin your transfer procedure..."
SENDFILE KERMIT S8
ENDCASE
DEFAULT
TRAN "^M^JInvalid transfer selection"
SET SUCCESS OFF ; Indicate failure for console
GOTO EOTransfer
ENDCASE
ENDSWITCH
;
; Log the download
;
IF FAILED
S9 = "Download ("*S9(0:0)*"): "*S8&", Failure"
GOSUB Log_Item ; Add S9 to BBS-LOG
SET SUCCESS OFF
ELSE
S9 = "Download ("*S9(0:0)*"): "*S8&", Success"
GOSUB Log_Item ; Add S9 to BBS-LOG
SET SUCCESS ON
ENDIF
;
; End of transfer... note result on local console
;
EOTransfer:
IF FAILED
MESS "^M^JTransfer failed "
ELSE
MESS "^M^JTransfer OK "
ENDIF
GOTO File_Prompt
; -----------------------------------------------------------------------
; FileTest - take qualification for fname from description
; S8 passes the name to use - returned fully qualified
; -----------------------------------------------------------------------
;
FileTest:
FOPENI "BBS-File" TEXT ; Open the mailkey file
IF FAILED ; IF error opening
SET SUCCESS OFF ; Indicate file dne
RETURN ; Rtn to caller
ENDIF
LJ S9 ; Left justify
;
; Read records from BBS-File
;
FTestLoop:
READ S0 80 N19 ; Read a record
IF EOF GOTO FTestEnd ; On end of file, report not found
;
; With the exception of comments, test for file availability
;
IF FIND S0(0:0) "*" GOTO FTestLoop ; Ignore comments simply
IF NOT FIND S0(0:11) S9 GOTO FTestLoop
S2 = S0(0:11) ; Extract File name
IF FIND S0(28:28) "^A" ; Look for ^A in description
IF FIND S0(29:79) "^A" N11 ; .. want a pair...
S2 = S0(29:29+N11-1)&"\"*S2 ; Use between as subdir
ENDIF
ENDIF
IF NOT ISFILE S2 GOTO FTestLoop ; If file dosn't exist
;
; We have a match...
;
S9 = S2 ; Rtn file name in S9
FCLOSEI ; Close input file
SET SUCCESS ON ; And indicate success
RETURN ; Rtn to caller
;
; End of loop
;
FTestEnd:
FCLOSEI ; CLOSE the keys file
SET SUCCESS OFF ; Indicate not found
RETURN ; Rtn to caller
; -----------------------------------------------------------------------
; List command - list file directories
; -----------------------------------------------------------------------
;
Filelist:
N10 = 0 ; Initialize counter (# records)

FOPENI "BBS-File" TEXT ; Open the mailkey file
IF FAILED ; IF error opening
TRAN "^M^JNo files are available at this time^M^J"
GOTO File_Prompt ; And go back to files mainline
ENDIF
;
; Read records from BBS-File
;
FListLoop:
READ S9 80 N19 ; Read a record
IF EOF GOTO FListEnd ; On end of file, report count found
;
; With the exception of comments, test for file availability
;
IF FIND S9(0:0) "*" GOTO FListPrint ; Print comments simply
S0 = S9(0:11) ; Extract File name
IF FIND S9(28:28) "^A" ; Look for ^A in description
IF FIND S9(29:79) "^A" N11 ; .. want a pair...
S0 = S9(29:29+N11-1)&"\"*S0 ; Use between as subdir
S9(28:79) = S9(29+N11+1:79) ; Remove from description
ENDIF
ENDIF
IF NOT ISFILE S0 GOTO FListLoop ; If file dosn't exist
IF FIND S9(12:12) "*" ; If not dated...
FDATE S2 S0 1 ; .. get date
FSIZE S3 S0 ; .. and size
S9(12:19) = S2 ; .. and put into record
S9(21:27) = S3 ; For display
ENDIF
;
; If nothing has been displayed yet, do a heading
;
IF ZERO N10 ; If no recs displayed yet
TRAN "^M^JName Dated Size Description ^M^J"
TRAN "------------ -------- ------- ----------------------------------------------^M^J"
ENDIF
;
; Format the record for printing
;
S9 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
;
; And display the record
;
FListPrint:
PRESERVE S9 ; Retain !s ^s and `s
TRAN S9 ; Display the record
TRAN "^M^J" ; And a cr/lf
N10 = N10+1 ; COunt this one
GOTO FListLoop ; Loop until EOF
;
; End of loop
;
FListEnd:
FCLOSEI ; CLOSE the keys file
GOTO File_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Search command - search file directory
; -----------------------------------------------------------------------
;
Search:
TRAN "^M^JEnter the search string: "
GOSUB Read_Comm ; Read response
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

IF NULL S9 GOTO File_Prompt ; If blank response exit
S18 = S9 ; Save search string
;
; Open the directory for searching
;
FOPENI "BBS-File" TEXT ; Open the mailkey file
IF FAILED ; IF error opening
TRAN "^M^JNo files are available at this time^M^J"
GOTO File_Prompt ; And go back to mainline
ENDIF
N10 = 0 ; Initialize counter (# records)
;
; Read a record
;
Search_Loop:
READ S9 80 N19 ; Read a record
IF EOF GOTO Search_End ; On end of file, Skip
;
; With the exception of comments, test for file availability
;
IF FIND S9(0:0) "*" GOTO Search_Loop ; Always skip comments
S0 = S9(0:11) ; Extract File name
IF FIND S9(28:28) "^A" ; Look for ^A in description
IF FIND S9(29:79) "^A" N11 ; .. want a pair...
S0 = S9(29:29+N11-1)&"\"*S0 ; Use between as subdir
S9(28:79) = S9(29+N11+1:79) ; Remove from description
ENDIF
ENDIF
IF NOT ISFILE S0 GOTO Search_Loop ; If file dosn't exist
IF FIND S9(12:12) "*" ; If not dated...
FDATE S2 S0 1 ; .. get date
FSIZE S3 S0 ; .. and size
S9(12:19) = S2 ; .. and put into record
S9(21:27) = S3 ; For display
ENDIF
;
; Test for target string in record
;
IF NOT FIND S9 S18 GOTO Search_Loop
;
; If nothing has been displayed yet, do a heading
;
IF ZERO N10 ; If no recs displayed yet
TRAN "^M^JName Dated Size Description ^M^J"
TRAN "------------ -------- ------- ----------------------------------------------^M^J"
ENDIF
;
; Format the record for printing
;
S0 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
PRESERVE S0 ; Retain !s ^s and `s
TRAN S0 ; Display the record
TRAN "^M^J" ; And a cr/lf
N10 = N10+1 ; COunt this one
GOTO Search_Loop ; Loop until EOF
;
; End of loop
;
Search_End:
IF ZERO N10 ; If nothing found...
TRAN "^M^JNo matches" ; Indicate it
ENDIF

FCLOSEI ; CLOSE the keys file
GOTO File_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Leave a comment (branched to - "Main_Prompt")
;
; This routine executes out of the defined BBS subdir, no matter
; what subdir a privileged user has selected. It saves the current
; subdir and restores it upon completion.
;
; Note: S19 must be retained throughout this submenu...
; It is used to save the current subdir
; -----------------------------------------------------------------------
;
Comment:
SUBDIR S19 ; Save current subdir
CHDIR S22 ; Reset current subdir

MESS "^M^JComment requested "
S9 = "Do you wish to leave a comment? (Y/N, cr=n): "
S8 = "BBS-NoMe" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E

GOSUB Read_Comm ; Read a response
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

FIND S9 "Y" ; Look for "Y"
IF NOT FOUND ; IF answer wan't 'Y'
TRAN "OK" ; Odd character
CHDIR S19 ; Reset default subdir
GOTO Main_Prompt ; We're done.
ENDIF
;
; Open the comments file
;
FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
IF FAILED ; if open failed
TRAN "Error recording note - please try later^M^J"
CHDIR S19 ; Reset default subdir
GOTO Main_Prompt ; GOTO Main_Prompt to caller
ENDIF

S9 = "*** Note left by "
CONCAT S9(17) S1 ; Add User ID
DATE S8
CONCAT S9(25) S8(0:9) ; Add date
TIME S8 1 ; (military fmt)
CONCAT S9(35) S8(0:7) ; Add time
WRITE S9 ; Write header to file * COM-AND
WRITE "!" ; Write a record delim * COM-AND
;
; Ask for lines, and write them to the output file
;
TRAN "Each line, as you enter it will be recorded. No edits, yet...^M^J"
TRAN "Enter a line/line(s) of text. A blank line ends the note.^M^J"
GOSUB Copy_Text ; Note FLAG(0) test below
;
; We have a blank line - and the end of a note
;
WRITE "------------!" ; Write a delimiter
FCLOSEO ; CLose the file
IF FLAG(0) GOTO Exit ; If COPY_Text rtns flag set, disconn
TRAN "Your note has been recorded - thanks^M^J"
;
; Log the fact, cleanup and we're done
;
S9 = "Comment recorded"
GOSUB Log_Item ; Write to BBS-Log

CHDIR S19 ; Reset default subdir
GOTO Main_Prompt ; GO for next cmd
; -----------------------------------------------------------------------
; Bulletin command: List, and read a specific item
;
; The BBS-BULL file is structured:
; 0 5 13 14 26
; +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
; ! Number ! Date ! ! Fname ! Subject (40 char)!
; +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
; ^ Privileged user bulletin flag
;
; Note: S19 must be retained throughout this submenu...
; It is used to save the current subdir
; -----------------------------------------------------------------------
;
Bull_Command:
SUBDIR S19 ; Save current subdir
CHDIR S25 ; Switch to Bulletins subdir
;
; Restart (perform a list command) at this point
;
BULL_List:
MESS "^M^JBulletin list: " ; Local console indicator
N10 = 0 ; Initialize a counter

FOPENI "BBS-Bull" TEXT ; Open the bulletin file
IF FAILED ; IF error opening
TRAN "^M^JNo bulletins exist^M^J"
CHDIR S19 ; Return to default subdir
GOTO Main_Prompt ; And go back to mainline
ENDIF
;
; Read a record
;
Bull_Loop:
READ S9 80 N19 ; Read a record
IF EOF GOTO Bull_Prompt ; Test for end of file
IF NOT NULL S9(13:13) ; Test privilege flag
IF NOT FLAG(1) GOTO Bull_Loop; Only display if privileged user
ENDIF
;
; With the exception of comments, test for file availability
;
IF FIND S9(0:0) "*" GOTO Bull_Loop ; Skip comments

S0 = S9(14:25) ; Extract File name
IF NOT ISFILE S0 GOTO Bull_Loop ; If file dosn't exist
;
; If nothing has been displayed yet, do a heading
;
IF ZERO N10 ; If no recs displayed yet
TRAN "^M^JNum Dated Subject^M^J"
TRAN "----- -------- -------------------------------------------------------------^M^J"
ENDIF
;
; And display the record
;
S0 = S9(0:4)*" "*S9(5:12)*" "*S9(26:79)
PRESERVE S0 ; Retain !s ^s and `s
TRAN S0 ; Display the record
TRAN "^M^J" ; And a cr/lf
N10 = N10+1 ; COunt this one
GOTO Bull_Loop ; Loop until EOF
;
; End of loop: prompt for a bulletin number
;
Bull_Prompt:
FCLOSEI ; CLose the input file
GOSUB Display_Limit ; Report amount of time remaining
S9 = "^M^JL)ist, M)ain, E)xit, or a bulletin number: "
S8 = "BBS-BuMe" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E
;
; Read a response
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set disconn and restart
;
; Test for alpha commands
;
LJ S9 ; Left justify S9
IF FIND S9(0:0) "L" ; If command was List
GOTO Bull_List ; Perform the list again
ENDIF

IF FIND S9(0:0) "M" ; If command was Main
CHDIR S19 ; Return to default subdir
GOTO Main_Prompt ; Go back to main
ENDIF

IF FIND S9(0:0) "E" ; If command was Exit
GOTO Logoff ; Transmit acknowlegement and Exit
ENDIF
;
; We're going to scan the keys file for the input
;
FOPENI "BBS-Bull" TEXT ; Open the bulletin file
IF FAILED ; IF error opening
TRAN "^M^JNo bulletins available^M^J"
CHDIR S19 ; Return to default subdir
GOTO Main_Prompt ; And go back to mainline
ENDIF
S0 = S9 ; Save response in S0
;
; Read a record from BBS-Bull
;
Bull_Scan:
READ S9 80 N19 ; Read a record
IF EOF ; Test for end of file
TRAN "^M^JNo such bulletin!! ^M^J"
FCLOSEI ; CLose input file
GOTO Bull_Prompt ; Select one specific
ENDIF

IF FIND S9(0:0) "*" GOTO Bull_Scan; Throw away comments

IF NOT NULL S9(13:13) ; Test privilege flag
IF NOT FLAG(1) GOTO Bull_Scan; Only display if privileged user
ENDIF
;
; Test for file availability
;
S8 = S9(14:25) ; Extract File name
IF NOT ISFILE S8 GOTO Bull_Scan ; If file dosn't exist
;
; Test the record number field against the given
;
S9 = S9(0:4) ; Extract just the number
LJ S9 ; Justify the field in S9; S0 already so
SWITCH S9 ; Test using the given #
CASE S0(0:4) ; .. against the rec number field
GOTO Bull_Read ; Match - go read it
ENDCASE
ENDSWITCH
GOTO Bull_Scan ; Loop until EOF
;
; Read a single bulletin - the name is in S8
;
Bull_Read:
FCLOSEI ; Close the mail keys file
MESS "^M^JReading bulletin: "*S8; Local console indicator

S9 = "^M^JError opening bulletin file" ; Error msg just in case
GOSUB Disp_File ; Display the file
;
; Log the fact
;
S9 = "Bulletin "*S8&" read"
GOSUB Log_Item ; Write to BBS-Log
GOTO Bull_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Mail command: Read, write or back to main
;
; Note: S19 must be retained throughout this submenu...
; It is used to save the current subdir
; -----------------------------------------------------------------------
;
Mail_Command:
MESS "^M^JMail prompt: " ; Local console indicator
SUBDIR S19 ; Save current default
CHDIR S24 ; Set to Messages subdir
;
; Prompt for a submenu command
;
Mail_Prompt:
GOSUB Display_Limit ; Report amount of time remaining
S9 = "^M^JS)can, L)ist, N)ew, A)ll, W)rite, M)ain or E)xit: "
S8 = "BBS-MeMe" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E
;
; Keep just the first char entered
;
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
;
; Interpret the command
;
SWITCH S9 ; Test the entry
;
; Read-new command
;
CASE "N" ; New-Read
GOTO Read_New
ENDCASE
;
; Read command
;
CASE "A" ; All-Read
GOTO Read_All
ENDCASE
;
; Write command
;
CASE "W" ; Write
GOTO Write_msg
ENDCASE
;
; Scan command
;
CASE "S" ; Scan
GOTO Scan_Msg
ENDCASE
;
; List command
;
CASE "L" ; Scan
GOTO List_Msg
ENDCASE
;
; Main command
;
CASE "M" ; Go back to main prompt
CHDIR S19 ; Reset subdir
GOTO Main_Prompt
ENDCASE
;
; Exit command
;
CASE "E" ; Exit
GOTO Logoff ; Transmit acknowlegement and Exit
ENDCASE
ENDSWITCH

TRAN "Invalid selection - try again^M^J"
GOTO Mail_Prompt
; -----------------------------------------------------------------------
; Scan command: Scan for files 'to' the current user
;
; The MAILKEY file is structured:
; 0 8 16 17 25 38
; +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
; ! To ID ! From ID ! ! Date ! Fname ! Subject (40 char)!
; +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
; ^Privacy flag = P
; -----------------------------------------------------------------------
;
Scan_Msg:
N10 = 0 ; Initialize counter (# records)
N11 = 0 ; Initialize counter (# to current ID)

FOPENI "BBS-Mail" TEXT ; Open the mailkey file
IF FAILED GOTO Scan_Rpt ; IF error opening, Use zero cnt
TRAN "^M^JWorking..." ; May take a moment
;
; Read records from BBS_Mail
;
Scan_Loop:
READ S9 80 N19 ; Read a record
IF EOF GOTO Scan_Rpt ; On end of file, report count found

S0 = S9(0:7) ; Look at 'to ID' field
SWITCH S0 ; Test for our ID
CASE S1 ; .. in the record
S0 = S9(25:37) ; Extract File name
IF ISFILE S0 INC N11 ; If file exists, count it
ENDCASE
ENDSWITCH

INC N10 ; Count the read
N12 = N10/10*10 ; Every 10th record
IF EQ N10 N12 ; .. or so
TRAN "." ; .. indicate we didn't die
ENDIF
GOTO Scan_Loop ; Loop until EOF
;
; Report the count found
;
Scan_Rpt:
IF ZERO N11 ; If no files found
TRAN "^M^JYou have no messages waiting"
ELSE
STRFMT S0 "^M^JYou have %d message(s) waiting." N11
TRAN S0 ; Transmit the text
ENDIF

FCLOSEI ; CLOSE the keys file
GOTO Mail_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Mail List command: List files available to be read.
; -----------------------------------------------------------------------
;
List_Msg:
N10 = 0 ; Initialize counter (# records)

FOPENI "BBS-Mail" TEXT ; Open the mailkey file
IF FAILED ; IF error opening
TRAN "^M^JNo mail exists - why not write something?^M^J"
GOTO Mail_Prompt ; And go back to mainline
ENDIF
;
; Read a record from BBS-Mail
;
List_Loop:
READ S9 80 N19 ; Read a record
IF EOF GOTO List_End ; On end of file, report count found

S0 = S9(0:7) ; Look at 'to ID' field
SWITCH S0 ; Test for our ID
CASE S1 ; .. in the record
ENDCASE ; OK if addressed to us
DEFAULT ; If not our ID, test privacy
IF FIND S9(16:16) "P" ; Test privacy flag
IF NOT STRCMP S9(8:15) S1 ; If we didn't write it
GOTO List_Loop ; Ignore private messages
ENDIF
ENDIF
ENDCASE
ENDSWITCH

S0 = S9(25:37) ; Extract File name
IF NOT ISFILE S0 GOTO List_Loop ; If file dosn't exist
;
; If nothing has been displayed yet, do a heading
;
IF ZERO N10 ; If no recs displayed yet
TRAN "^M^JTo From Date Subject^M^J"
TRAN "-------- -------- -------- -------------------------------------------------^M^J"
ENDIF
;
; And display the record
;
S0 = S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)
PRESERVE S0 ; Retain !s ^s and `s
TRAN S0 ; Display the record
TRAN "^M^J" ; And a cr/lf
N10 = N10+1 ; COunt this one
GOTO List_Loop ; Loop until EOF
;
; End of loop
;
List_End:
FCLOSEI ; CLOSE the keys file
GOTO Mail_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Read NEW command: Read NEW mail files 'to' the current user
; Setup S7 limiting date
; -----------------------------------------------------------------------
;
Read_New:
S7 = " " ; Make earliest possible date
IF NOT ISFILE S1&".NEW" GOTO Read_Msg
FOPENI S1&".NEW" TEXT ; Open ID.NEW file
IF FAILED GOTO Read_Msg ; Skip on error
READ S7 8 N19 ; Read oldest date read
FCLOSEI ; Close file
GOTO Read_Msg ; And read using this date
; -----------------------------------------------------------------------
; Read ALL command: Read ALL mail files 'to' the current user
; Setup S7 limiting date
; -----------------------------------------------------------------------
;
Read_All:
S7 = " " ; Make earliest possible date
GOTO Read_Msg ; And read using this date
; -----------------------------------------------------------------------
; Test two dates, one in S0 and one in S2 (each fmttd mm/dd/yy)
; N10 returns -1 if S0 date < S2 date
; 0 if S0 date = S2 date
; +1 if S0 date > S2 date
; -----------------------------------------------------------------------
;
DateTest:
IF NOT NUMERIC S2(0) or NOT NUMERIC S2(3) or NOT NUMERIC S2(6)
N10 = 0 ; Fake they're equal
RETURN ; .. and done
ENDIF

IF NOT NUMERIC S0(0) or NOT NUMERIC S0(3) or NOT NUMERIC S0(6)
N10 = 0 ; Fake they're equal
RETURN ; .. and done
ENDIF

IF S0(6:7) EQ S2(6:7) ; If recordyear = limityear
N10 = (S0(0:1)*100+S0(3:4)) - (S2(0:1)*100+S2(3:4))
IF N10 LT 0 ; S0 < S2
N10 = -1 ; Return S0 < S2
ELSE
IF N10 GT 0 ; S0 > S2
N10 = 1 ; Return S0 > S2
ELSE
N10 = 0 ; Return S0 = S2
ENDIF
ENDIF
RETURN ; And we're done here
ENDIF

N10 = S0(6:7)+1900 ; Extract S0 year, dft 1900 century
N11 = S2(6:7)+1900 ; Extract S2 year, dft 1900 century
IF S0(6:7) LT 80 N10 = N10+100 ; 00-79 -> 2000 century
IF S2(6:7) LT 80 N11 = N10+100 ; 00-79 -> 2000 century

IF N10 LT N11 ; S0 < S2
N10 = -1 ; Return S0 < S2
ELSE
IF N10 GT N11 ; S0 > S2
N10 = 1 ; Return S0 > S2
ELSE
N10 = 0 ; Return S0 = S2
ENDIF
ENDIF
RETURN
; -----------------------------------------------------------------------
; Read command: Read mail files 'to' the current user
; S7 passes the date on/after which to read (formatted yymmdd)
; S2 will be used to keep the date of the last record read
; S3 will be used to keep latest date read
; S4 will be used to keep the sender ID
; S5 will be used to keep the subject text
; -----------------------------------------------------------------------
;
Read_Msg:
FOPENI "BBS-Mail" TEXT ; Open the mailkey file
IF FAILED ; IF error opening
TRAN "^M^JNo mail exists - why not write something?^M^J"
GOTO Mail_Prompt ; And continue
ENDIF
S3 = " " ; Date of oldest note read
;
; Read a line from BBS-Mail
;
Read_Loop:
READ S9 80 N19 ; Read a record
IF EOF GOTO Read_End ; On end of file, exit
;
; Test the date of the item against the passed limiting date
; .. if either contain non-alpha, skip this step
;
S2 = S9(17:24) ; Extract date from record
S0 = S7 ; Setup limiting date for compare
GOSUB DateTest ; Compare date in S0 to date in S7
IF N10 GT 0 GOTO Read_Loop ; Skip if limitdate > recorddate
;
; Test the ID from the record
;
S0 = S9(0:7) ; Look at 'to ID' field
SWITCH S0 ; Test ID from the record
;
; Test for mail to current caller
;
CASE S1 ; Against our own ID
SET FLAG(9) ON ; Flag for delete
ENDCASE
;
; Not to current caller - test sender/privacy
;
DEFAULT ; If not our ID, test privacy
SET FLAG(9) OFF ; Flag no delete
IF STRCMP S9(8:15) S1 SET FLAG(9) ON ; If we wrote it
IF FIND S9(16:16) "P" and NOT FLAG(9)
GOTO Read_Loop ; So.. ignore private messages
ENDIF
ENDCASE
ENDSWITCH
;
; We'll read the message
;
S0 = S9(25:37) ; Extract File name
IF NOT ISFILE S0 GOTO Read_Loop ; If file dosn't exist
;
; Save a few values for reply...
;
S4 = S9(8:15) ; Setup from-ID for later
S5 = S9(38:79) ; Save subject for later too
;
; Display the current file
;
S8 = S0 ; Set-up file name
S9 = "^M^JError opening mailfile"
GOSUB Disp_File ; Display the file
;
; Save the date of the record read (S2 contains record date)
;
S0 = S3 ; Setup oldest date read
GOSUB DateTest ; Compare the two dates
IF NULL S3 or N10 LT 0 S3 = S2 ; If oldestdate < recorddate, save new oldest
;
; Prompt for next action
;
Read_Disposition:
IF FLAG(9) ; If delete is possible
TRAN "^M^JD)elete, R)eply, Q)uit (cr=continue): "
ELSE ; Delete not possible
TRAN "^M^JR)eply, Q)uit (cr=continue): "
ENDIF
GOSUB Read_Comm ; Read into S9
IF FLAG(0) GOTO Exit ; If first flag rtns set, disconn

LJ S9 ; Left justify S9
S9 = S9(0:0) ; Keep just the first char
IF NULL S9 S9 = "c" ; Fake 'continue'
;
; Interpret the command
;
SWITCH S9 ; Test the entry
;
; Delete command
;
CASE "D" ; Delete
IF FLAG(9) ; If it was ours
DELETE S8 ; Delete file named in S8
TRAN "Message deleted^M^J"; Indicate its done
ELSE
TRAN "You may not delete this note^M^J"
ENDIF
ENDCASE
;
; Reply command
;
CASE "R" ; All-Read
S10 = S4 ; Reply To-ID is current note from-id
S11 = S5 ; Default reply subj text
IF NOT STRCMP S5(0:9) "Reply to: " S11 = "Reply to: "*S5
GOSUB Reply ; COmpose the reply
IF FLAG(0) GOTO Exit ; Exit on disconn
ENDCASE
;
; Continue command
;
CASE "C" ; Continue
GOTO Read_Loop
ENDCASE
;
; Quit command
;
CASE "Q" ; Quit
GOTO Read_End
ENDCASE
;
; Unrecognized command
;
DEFAULT ; Anything else
TRAN "^M^JUnrecognized command - please try again^M^J"
ENDCASE
ENDSWITCH
GOTO Read_Disposition
;
; End of read... close input file, and we're done
;
Read_End:
FCLOSEI ; Close the mail keys file
IF NOT NULL S3 ; If we read something
FOPENO S1&".NEW" TEXT ; Open ID.NEW file
IF FAILED GOTO Mail_Prompt ; Skip on error
WRITE S3*"!" ; Write saved date
FCLOSEO ; Close file
ENDIF
GOTO Mail_Prompt ; And loop until EOF
; -----------------------------------------------------------------------
; Write command - write mail
; -----------------------------------------------------------------------
;
Write_Msg:
GOSUB Compose ; Invoke compose a note
IF FLAG(0) GOTO Exit ; Exit on disconn
GOTO Mail_Prompt ; GO for next cmd
; -----------------------------------------------------------------------
; Write a mail note - this is a subroutine, as it is called by both
; Read-mail (reply) and Write-Mail. Note:
; S3 and S7 must be preserved for Read_Msg...
; The caller must test FLAG(0) for disconn...
; An existing FOPENI must be preserved
; -----------------------------------------------------------------------
; The entry point 'Reply' requires that S10 contain the TO ID and
; S11 contain the subject line
; -----------------------------------------------------------------------
;
Compose:
TRAN "To: ^H" ; Prompt for ID
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If first flag rtns set, disconn

LJ S9 ; Left justify ID
IF NULL S9 RETURN ; If blank entry - exit here
S10 = S9(0:7) ; Save TO ID
UPPER S10 ; Force it upper case
;
; Prompt for a subject
;
TRAN "Subject: ^H" ; Prompt for subject
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If first flag rtns set, disconn
S11 = S9 ; Save returned subject
PRESERVE S11 ; Retain !s ^s and `s
;
; Open a temporary file
;
Reply:
FOPENO "\HOSTTEMP.TXT" TEXT ; OPEN file for output
IF FAILED ; if open failed
TRAN "Error opening file - please try later^M^J"
RETURN ; Back to submenu
ENDIF
;
; Place a header
;
S9 = "To: " ; Set Sender ID
CONCAT S9(7) S10 ; ..
WRITE S9 ; Write header to file * COM-AND
WRITE "!" ; Write a record delim * COM-AND

S9 = "From: " ; Set Sender ID
CONCAT S9(7) S1 ; ..
WRITE S9 ; Write header to file * COM-AND
WRITE "!" ; Write a record delim * COM-AND

S9 = "Date: " ; Set date and time
DATE S12
CONCAT S9(7) S12 ; Add date
TIME S8 1 ; (military fmt)
CONCAT S9(17) S8 ; Add time
WRITE S9 ; Write header to file * COM-AND
WRITE "!" ; Write a record delim * COM-AND

S9 = "Subject: " ; Set subject
CONCAT S9(9) S11 ; ..
WRITE S9 ; Write header to file * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE "!" ; Write a text delim * COM-AND
;
; Ask for lines, and write them to the output file
;
TRAN "Each line, as you enter it will be recorded. No edits, yet...^M^J"
TRAN "Enter a line/line(s) of text. A blank line ends the text.^M^J"
GOSUB Copy_Text ; Note FLAG(0) test below
FCLOSEO ; Close the file
IF FLAG(0) RETURN ; If first flag rtns set, disconn
;
; Ask if the file is to be saved
;
TRAN "Save? (Y/N, cr=y): ^H" ; Ask if its to be saved
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If first flag rtns set, disconn

IF FIND S9 "N" RETURN ; Test for "N"
;
; Now - scan for the last used file name
;
TRAN "^M^JScanning for free slot"
N10 = 0 ; Set default extension we'll use
S0 = S10(0:7) ; Look at 'to ID' field
;
; Look for a free file name
;
WHILE ISFILE S0&"."&N10 ; Find unused note #
INC N10 ; Bump ptr
IF N10 GT 999 ; If max msgs reached...
TRAN "^M^JToo many notes left undeleted - cannot save^M^J"
RETURN ; Back to caller
ENDIF
ENDWHILE ; Loop until match
;
; We have found the first free file name
;
TRAN "^M^JPrivate? (Y/N, cr=n): "; Ask if its to a private msg
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If first flag rtns set, disconn

S13 = " " ; Set privacy flag
IF FIND S9 "Y" S13 = "P" ; Test for "Y" - set flag val

S0 = S0&"."&N10 ; Make a new file name
S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command
DOS S9 ; Cannot do own copy (FOPENI in use)

FOPENO "BBS-Mail" TEXT APPEND ; Open the keys file for append
WRITE S10 8 ; Write the 'TO ID'
WRITE S1 8 ; Write the from ID
WRITE S13 1 ; Write privacy flag
WRITE S12 8 ; Write date
WRITE S0 13 ; Write file name
WRITE S11 40 ; Write the subject
WRITE "!" ; And a delimiter
FCLOSEO ; ANd close the keys file
RETURN ; GO for next cmd
; -----------------------------------------------------------------------
; Registration (Exit must be performed after)
;
; Upon return: FLAG(0) ON -> Caller disconnected
; -----------------------------------------------------------------------
;
Register:
MESS "^M^JRegistration requested "
S9 = "Do you wish to register? (Y/N, cr=y): "
S8 = "BBS-ReMe" ; Set file name
GOSUB Disp_File ; Display file contents or S9 if file D.N.E

GOSUB Read_Comm ; Read a response
IF FLAG(0) ; If error
S9 = "Registration aborted - disconn"
GOSUB Log_Item ; Log the fact
RETURN ; SImply return
ENDIF

IF FIND S9 "N" ; IF answer wasn't 'n'
S9 = "Registration declined by caller"
GOSUB Log_Item ; Log the fact
TRAN "OK - bye^M^J" ; Say g'night Gracie
RETURN ; We're done.
ENDIF
;
; Ask for a name/address/csz phone and ID/Password
;
TRAN "Enter your full name: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error
S18 = S9 ; Save return

TRAN "Enter your street address: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error
S17 = S9 ; Save return

TRAN "Enter your city/state and zip: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error
S16 = S9 ; Save return

TRAN "Enter a area code and phone number where^M^J"
TRAN "you may be reached: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error
S15 = S9 ; Save return
;
; Request an ID
;
Reg_ID:
TRAN "Enter the ID (1-8 chars) you wish to use: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error

IF FIND S9(0:7) "."
TRAN "ID may not contain '.'s^M^J"
GOTO Reg_ID
ENDIF
IF FIND S9(0:7) ","
TRAN "ID may not contain ','s^M^J"
GOTO Reg_ID
ENDIF
IF FIND S9(0:7) "\"
TRAN "ID may not contain '\'s^M^J"
GOTO Reg_ID
ENDIF
IF FIND S9(0:7) "/"
TRAN "ID may not contain '/'s^M^J"
GOTO Reg_ID
ENDIF
S14 = S9(0:7) ; Save return
;
; Request a password
;
Reg_Pass:
TRAN "Enter the password (1-8 chars) you wish to use: "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error

IF NULL S9(0:7) ; Test for blank entered
TRAN "You must have a password^M^J"
GOTO Reg_Pass
ENDIF
S14 = S14 & ";" &S9(0:7) ; Concatenate PASSWORD to ID
;
; Repeat for validity:
;
TRAN "^M^JRepeating your entry...^M^J"
TRAN S18 ; Transmit name
TRAN "^M^J"
TRAN S17 ; Transmit Street address
TRAN "^M^J"
TRAN S16 ; Transmit CSZ
TRAN "^M^J"
TRAN S15 ; Transmit Phone
TRAN "^M^J"
TRAN S14 ; Transmit ID/password

TRAN "^M^JIs this correct? (Y/N, cr=n): "
GOSUB Read_Comm ; Read a response
IF FLAG(0) RETURN ; If error

FIND S9 "Y" ; Look for "Y"
IF NOT FOUND GOTO Register ; IF answer wan't 'Y', try again
;
; Open the comments file
;
FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
IF FAILED ; if open failed
TRAN "Error recording registration - please call back^M^J"
RETURN ; Return to caller
ENDIF

S9 = "*** Registration requested: "
DATE S1
CONCAT S9(27) S1 ; S1 would be ID anyway
TIME S1 1 ; (military fmt)
CONCAT S9(38) S1
WRITE S9 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND

WRITE S18 80 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE S17 80 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE S16 80 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE S15 80 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE S14 80 ; Write a record * COM-AND
WRITE "!" ; Write a record delim * COM-AND
WRITE "------------!" ; Write a delimiter
;
; Log the fact
;
S9 = "Registration requested"
GOSUB Log_Item ; Write to BBS-Log
;
; We have a successful record
;
TRAN "Your request will be processed by the SYSOP^M^J"
TRAN "Thanks for calling...^M^J"

FCLOSEO ; CLose the file
RETURN ; Return from subroutine
; -----------------------------------------------------------------------
; Auto baudrate detect (according to message in S9)
;
; This procedure is placed last to ensure that the entire script
; file is scanned once before the main prompt. COM-AND caches
; label addresses, so this ensures that the 1st 100 labels are
; known by COM-AND (and thus can be quickly reached).
; -----------------------------------------------------------------------
;
AutoBaud:
IF FIND S9 "1200"
SET BAUD 1200 ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "2400"
SET BAUD 2400 ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "4800"
SET BAUD 4800 ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "9600"
SET BAUD 9600 ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "14400" or FIND S9 "14.4"
SET BAUD 14k ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "19200" or FIND S9 "19.2"
SET BAUD 19k ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "38400" or FIND S9 "38.4"
SET BAUD 38k ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF

IF FIND S9 "57600" or FIND S9 "57.6"
SET BAUD 57k ; Set to new rate
GOTO AUBA100 ; Log the fact
ENDIF
;
; None of the above... set to 300
;
SET BAUD 300 ; Set to 1200 baud
;
; Log the connect string to the log
;
AUBA100:
GOSUB Log_Item ; Write connect string to log
RETURN ; We're done.


  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : BBS.SRC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/