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 / bbs.src < prev next >

Wrap

Text File | 1993-07-14 | 80.1 KB | 2,589 lines

; ----- 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) ; Ver 1.3: 4/--/93 R.McG (Added SCHEDULER hook for one-call use) ; (Added drop-to-DOS doorway) ; (allow sysop to type user commands from kbd) ; ----------------------------------------------------------------------- ; 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) ; o .. including drop-to-DOS using a doorway function ; -------------------------------------------------------------- ; Data for this script are established through the BBSETUP script. ; The drop-to-DOS requires a doorway function (such as DOORWAY, ; by Marshsall Dudley), and the script HOSTART. The only other ; file requisite to this HOST script is the TREED p/d utility. ; -------------------------------------------------------------- ; ----------------------------------------------------------------------- ; 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 ; S26 -> Doorway command (or null) ; S27 -----> 1 char read buffer used by Read_comm ; S28 -----> DLDIR on entry ; S29 -----> subdirectory on entry ; ; N0 ------> # minutes allowed for call (set by logon) ; N10-N19 -> Generally scratch ; N27-N30 -> Counters used by Read_Comm ; 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.3); 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 S26 = "" ; Doorway command init empty ; ; 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 IF 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 PORT S20(0:3) ; Starting port SET INAFTER OFF ; Turn off init after hangup 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.3); Press ESC to terminate or to CHAT." WCLOSE ; End init (before ON ESC) ON ESCAPE GOSUB Escape ; Enter chat mode on operator escape ; ; If this is a restart, pickup at the main prompt ; SET PORT S20(0:3) ; Starting port IF ISFILE "HOSTTEMP.STR" and ISFILE "HOSTTEMP.BAT" SET RECHO ON ; Restart - need to reenable LOAD STRING "HOSTTEMP.STR" ; Restore previous values SET FLAG(1) S0(0:2) ; Set flags back too SET FLAG(2) S0(3:5) ; Set flags back too SET FLAG(3) S0(6:8) ; Set flags back too DELETE "HOSTTEMP.STR" ; Done w/the file S9 = "* Return from drop-to-DOS" GOSUB Log_Item ; Log it CLOG S9 GOTO Main_Prompt ENDIF ; ; Initialize values that change port setting, and start a new call ; TRANSMIT "_MESCAPE" ; Initialize modem (modem escape) SET BAUD S20(5:8) ; Starting speed 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.3); 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 GOTO End ; 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 ; 4/93: Transmit MINIT *before* RESET, in case modem in use by BBS ; is not modem default for COM-AND (MINIT turns off answer) ; ----------------------------------------------------------------------- ; 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 MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J" TRAN "_MINIT" ; Initialize modem from defaults DELETE "\HOSTTEMP.TXT" ; Cleanup RESET ; Reset default values WCLOSE ; Close window opened above CLEAR ; Clear screen IF ISSC "$$$SCHED" EXECUTE "$$$SCHED"; And chain back after call 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.3); 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 (modified 7/93 for kbd) ; .. This handles 'disconnect' and timeouts, and allows sysop typethru ; ----------------------------------------------------------------- ; S27, S28, S29, N30, N27 and TIMER(0) are used in this procedure ; S9 returns the text read (if any) ; ; FLAG(0) off -> Line read correctly ; on --> Disconnect or timeout ; ----------------------------------------------------------------------- ; Test timeout ; Read_Comm: 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 ; ; Initialize for loop ; S9 = "" ; Clear buffer N27 = 0 ; Size of S9 buffer SET RMODE BINARY ; Binary comm read ; ; Now, sit on the COMM port waiting for a read ; RCOM100: SET TIMER ; Set timer for now WHILE NOT RECEIVE and NOT HITKEY; Loop, awaiting activity IF NOT CONNECTED GOTO RCOM500; If modem reports CD dropped TSINCE N28,N29,N30 ; Look at time since start IF NOT ZERO N28 or N29 GT 3 GOTO RCOM400 ENDWHILE ; ; Catch comm chars ; IF RECEIVE ; Something on the comm port RGET S27 1 180 ; .. so read it IF FIND S27 "^M" GOTO RCOM300; Catch c/r here GOTO RCOM200 ; And skip to process ENDIF ; ; Catch sysop (kbd) chars ; IF HITKEY ; Something on the kbd KEYGET S27 ; .. so read it IF FIND S27(0:1) "0d" ; Allow sysop to do c/r TRANS "!" ; Echo to caller GOTO RCOM300 ; go handle c/r ENDIF IF FIND S27(0:1) "08" ; Allow sysop to do b/s ITOC 8 S27 ; Place in buffer S27(1:79) = "" ; and remove remainder ENDIF LENGTH S27 N28 ; Take length of read IF N28 GT 1 ; Must be ascii char SOUND 100,400 ; Else, bronx cheer GOTO RCOM100 ; .. and throw away ENDIF IF NOT (FIND S27 "^H" and N27 EQ 0) TRANS S27; Echo char to caller CURSOR N28 N29 ; Read cursor pos ATSAY N28 N29 (text) S27 ; Echo to console IF FIND S27 "^H" ; If backspace entered IF N27 GT 0 DEC N29 ; Backspace cursor position ELSE ; Not a backspace INC N29 ; Increment col pos ENDIF LOCATE N28 N29 ; Set new cursor pos ENDIF ; ; Handle the received char - 1st, look for backspaces ; RCOM200: IF FIND S27(0:0) "^H" ; Backspace IF ZERO N27 GOTO RCOM100 ; Don't backspace past rightmost DEC N27 ; Decrement count so far IF N27 GT 0 ; If anything remains in buffer S9 = S9(0:N27-1) ; .. remove last char ELSE S9 = "" ; Make null again ENDIF GOTO RCOM100 ; And continue looping ENDIF ; ; Buffer up anything else ; S9 = S9*S27 ; Concatenate char INC N27 ; Increment count bufferred IF N27 LT 80 GOTO RCOM100 ; Loop if we haven't 80 ; ; Look at the buffer we've collected ; RCOM300: FIND S9 "NO CARRIER" ; Test for message from modem IF FOUND GOTO RCOM500 ; If modem didn't report 'CD' true ; ; Return 'text read' ; SET RMODE ASCII ; Normal comm read restored SET FLAG(0) OFF ; Report to caller RETURN ; Return with text in S9 ; ; Timeout on the call ; RCOM400: 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. ; RCOM500: MESSAGE "^M^JCaller disconnected" ; ; Read_Comm error exit ; RComm_Exit: SET RMODE ASCII ; Normal comm read restored 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 ; IF NOT ISSC "$$$SCHED" ; If scheduler didn't invoke us HANGUP ; HANGUP and leave modem in cmd mode MESSAGE "^M^JWaiting..." PAUSE 3 ; Wait 3 secs for modem to settle ENDIF 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 Exit 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 IF ISSC "$$$SCHED" GOTO End ; Hook for scheduler return 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 IF NULL S26 S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: " ELSE S9 = "^M^JL)ist, P)ath, S)ubdir, doorW)ay, D)OS, M)ain or E)xit: " ENDIF 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 ; ; Doorway command ; CASE "W" ; Drop-to-DOS and do doorway GOTO DropDOS 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 ; ----------------------------------------------------------------------- ; DROPDOS command: Request a password ; ----------------------------------------------------------------------- ; DROPDOS: IF NULL S26 TRAN "^M^JCommand not recognized... try again" GOTO Priv_Prompt ; Can't do it ENDIF ; ; DROPDOS... Build a batch file ; FOPENO "HOSTTEMP.BAT" TEXT IF NOT SUCCESS TRAN "File error - cannot drop to DOS^M^J" GOTO Priv_Prompt ENDIF WRITE "ECHO OFF!" ; Start the batch file S0 = S26 ; Setup up drop to DOS command PRESERVE S0 ; Make it printable WRITE S0 ; Write the Drop to DOS command WRITE "!" ; And a terminating cr WRITE S29(0:1)*"!" ; Change to drive IF NOT NULL S29(2:79) WRITE "CD "*S29(2:79)&"!" ; Rtn to original dir WRITE "COM-AND /q/p/f" ; Inhibit COM-AND.CMD; take modem as set WRITE "_SCRIPT"&"!" ; .. rtn to this self-same script WRITE "^Z" FCLOSEO ; And we're done with it ; ; Construct a file to retain our settings ; S0 = "OFFOFFOFF" ; Save flag(1-3) values IF FLAG(1) S0(0:2) = "ON" IF FLAG(2) S0(3:5) = "ON" IF FLAG(3) S0(6:8) = "ON" STORE STRING "HOSTTEMP.STR" ; Used by main-line to signal doorway rtn ; ; And drop-to-DOS ; CLOG "* Drop-to-DOS" SET TTHRU OFF ; Disable type through STACK CLEAR ; Place invocation of the batch file STACK "HOSTTEMP.BAT!" ; .. into BIOS's area BYE ; Do it. ; ----------------------------------------------------------------------- ; 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 "_DDOVER" "ON" GOTO AUBA100 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.