Programmer 7500

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

/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / COMMUNIC / CA24_1.ZIP / BBS&HOST.ZIP / BBS-SRC.CMD next >

Wrap

Text File | 1989-02-23 | 61.6 KB | 2,117 lines

; ----- COM-AND Scripted BBS mode ; Commenced: 03/18/88 R.McG ; Updated: 2/--/89 R.McG ; ----------------------------------------------------------------------- ; 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 ------> Default drive/subdir for entry ; S3 ------> Default drive/subdir for files ; S4 ------> Default drive/subdir for mail ; S5 ------> Default drive/subdir for bulletins ; S6 ------> Logon time (used by Read_Comm to timeout) ; S8 ------> Scratch buffer (file name parm for Disp_File) ; S9 ------> General read buffer ; S10-S18 -> Scratch buffers ; S19 -----> Is used to save default subdir within commands ; ; N0 ------> # minutes allowed for call (set by logon) ; N10-N19 -> 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) ; ----------------------------------------------------------------------- ; ; Initialize COM related values ; SET BAUD 1200 ; Starting parms SET PARITY NONE SET DATA 8 SET STOP 1 SET PORT COM2 SET MASK ON ; accept 7 or 8 bits SET ASCII UP_LF LF ; Send LFs ; ; Initialize variables that must be constant ; S2 = "\BBS" ; Set to our subdirectory S3 = "\BBS\FILES" ; Set subdir for files S4 = "\BBS\MAIL" ; Set subdir for mail S5 = "\BBS\BULLETIN" ; Set subdir for bulletins ; ; Initialize other values ; SET ALARM OFF ; Turn off alarm SET ATIME 1 ; Set alarm time to 1 second CHDIR S2 ; Set to our subdirectory SET DLDIR S3 ; Set DLDIR LEGEND "Scripted BBS mode. Press ESC to terminate or to CHAT." TRANSMIT "~~~+++~~~ATZ^M" ; Initialize modem ON ESCAPE GOSUB Chat ; Enter chat mode on operator escape CLOG "* BBS script loaded" GOTO Restart ; Branch around subroutines ; ----------------------------------------------------------------------- ; Subroutine: Chat mode: Operator entered escape ; ; S0 is used as scratch ; ----------------------------------------------------------------------- ; Chat: ; ; Ask if we're to terminate. ; MESS "^M^JDo you wish to terminate? (Y/N) " GET S0 2 ; Read a response IF FIND S0 "Y" ; If response was yes HANGUP ; Hangup the phone CLOG "* BBS script terminated" EXIT ; Exit ENDIF ; ; If no user is logged on, just return to what we were doing ; IF NOT FLAG(3) ; If noone logged on RETURN ; Return to caller ENDIF ; ; Ask if we're to chat. ; MESS "^M^JDo you wish to chat with the caller (Y/N) " GET S0 2 ; Read a response IF FIND S0 "N" ; If response was no RETURN ; Return to what we were doing ENDIF ; ; Start chat mode. ; TRAN "^M^J" ; Send a c/r TRAN "^M^JOperator initiated chat mode..." ; ; 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) " GET S0 2 ; Read a response IF FIND S0 "N" ; If response was no TRAN "^M^JChat terminated by SYSOP" 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 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 ; Index from 0 N18 = S6(0:1)*60+S6(3:4) ; Time of logon since midnight ; Index from 0 ; ; 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) ; If error returns set RETURN ; .. End the proc here ENDIF ; .. with a simulated disconn ENDIF ; ; Now, sit on the COMM port waiting for a read ; RGET S9 80 180 ; Wait for a connection IF NOT CONNECTED ; If modem reports CD dropped GOTO Disconnect ; Goto disconnect ENDIF IF NOT SUCCESS ; If timeout on the RGET GOTO Timeout ; .. issue message and disconnect ENDIF FIND S9 "NO CARRIER" ; Test for message from modem IF FOUND ; If modem didn't report 'CD' true GOTO Disconnect ; Goto disconnect ENDIF ; ; 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... autodisconnect due to timeout" GOTO RComm_Exit ; Exit cycle in the usual manner ; ; Disconnect was reported. ; Disconnect: MESSAGE "^MCaller 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) ; If privileged user 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 ; Index from 0 N18 = S6(0:1)*60+S6(3:4) ; Time of logon since midnight ; Index from 0 ; ; 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 NOT SUCCESS ; if open failed SET FLAG(0) ON ; Report an error RETURN ; Return to caller ENDIF 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 ; Index from 0 IF FOUND ; IF "<" found, GOTO Logon_Loop ; Skip comment lines ENDIF SWITCH S1 ; Test ID/Password CASE S9(0:15) ; .. against record ; Index from 0 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 ; Index from 0 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: ISFILE S8 ; Test file for existance IF NOT SUCCESS ; if open d.n.e TRAN S9 ; Display the alternative message RETURN ; Return to caller ENDIF TRAN "^M^J" ; Send an initial delimiter SENDFILE ASCII S8 ; Send the file TRAN "^M^J" ; Send a final delimiter RETURN ; Return to caller ; ; ----------------------------------------------------------------------- ; Subroutine: Left_justify: Left justify the string in S9 ; ; N19 is used as a scratch reg ; ----------------------------------------------------------------------- ; Left_Justify: LENGTH S9 N19 ; Set a loop stopper LJ_Loop: IF NOT NULL S9(0:0) ; If column 1 is not blank ; Index from 0 RETURN ; End of procedure ENDIF S9 = S9(1:79) ; Strip the blank ; Index from 0 DEC N19 ; Count the strip IF GT N19 0 ; If still within string GOTO LJ_Loop ; Continue stripping ENDIF RETURN ; Whole string was blank ; ----------------------------------------------------------------------- ; Subroutine: Log_Item: Add a line to the activity log ; ; On entry: ; S9 -> The line to be added ; ; S8 is used as a scratch reg; S9 is modified ; ----------------------------------------------------------------------- ; Log_Item: FOPENO "BBS-LOG" TEXT APPEND ; OPEN file for output IF NOT SUCCESS ; if open failed RETURN ; Return to caller ENDIF DATE S8 ; Get current date CONCAT S9(59) S8 ; Add date to S9 line ; Index from 0 TIME S8 1 ; Get current time (military fmt) CONCAT S9(70) S8 ; Add time to S9 line ; Index from 0 WRITE S9 80 ; Write a record * COM-AND WRITE "^M" 1 ; 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 and N19 are used as scratch ; ----------------------------------------------------------------------- ; Copy_Text: N19 = 0 Copy_Loop: INC N19 ; Increment line counter S9 = N19 & ": ^H" ; Convert to decimal ascii TRAN S9 ; Transmit line number GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error RETURN ; RETURN - end of text ENDIF ; ; If the line is not blank, copy it to the output file ; IF NOT NULL S9 ; Test for a blank line LENGTH S9 N18 ; Get proper length WRITE S9 N18 ; Write the line * COM-AND IF NOT SUCCESS ; if write failed TRAN "Error recording text - please try later^M^J" RETURN ; Return to caller ENDIF WRITE "!" 1 ; 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) " ; Ask if this is end of input GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error RETURN ; RETURN - disconn ENDIF IF NOT FIND S9 "Y" ; Test for positive response WRITE "!" 1 ; 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 S2 ; Reset to default drive SET RECHO OFF ; Turn off echo for us SET RDISP ON ; 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 ; MESSAGE "^MWaiting..." Pause 3 ; Wait 3 seconds HANGUP ; HANGUP and leave modem in cmd mode PAUSE 3 ; Wait 3 secs TRANSMIT "ATE0Q0V1X1S0=2 S7=30 S9=10^M" ; ; ----------------------------------------------------------------------- ; ----- Wait for a connect ; ----------------------------------------------------------------------- ; Wait_Connect: RGET S9 80 180 ; Wait for a line IF NOT SUCCESS ; If nothing was read GOTO Wait_Connect ENDIF FIND S9 "NO CARRIER" ; Look for a disconn IF FOUND GOTO Restart ENDIF FIND S9 "CONNECT" ; Anything else BUT CONNECT IF NOT FOUND ; .. waits GOTO Wait_Connect ENDIF ;*** IF NOT CONNECTED ;*** GOTO Wait_Connect ;*** ENDIF ; ; ----- Connection established: Adjust our linespeed if need be ; GOSUB AutoBaud ; Change rate according to CONNECT MSG ; ; ----- Issue a greeting ; 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 SET RECHO ON ; Turn on echo (echo back to caller) N10 = 0 ; Set count of logon tries ; ----- Request an ID ; ID_Query: TRANSMIT "^MEnter your ID (or enter GUEST): " GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. IF NULL S9 ; Test for nothing entered 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 ; Index from 0 UPPER S1 ; Make ID upper case ; ; ----- Request a password ; Password_Query: TRANSMIT "^MEnter 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 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. SET RECHO ON ; Restore echo SET RDISPLAY ON ; Turn on echo to console again IF NULL S9 ; Test for nothing entered 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 ; Index from 0 GOSUB Logon ; Test logon IF NOT FLAG(0) ; If flag(0) returns reset S9 = "Logon: " ; Set activity CONCAT S9(7) S1(0:7) ; Add ID of caller ; Index from 0 GOSUB Log_Item ; Add S9 to BBS-LOG SET FLAG(2) OFF ; Indicate no CHDIR this user S1 = S1(0:7) ; Throw away password ; Index from 0 CLOG "* BBS logon: "*S1 GOTO Main_Prompt ; OK - we're on ENDIF ; ; Unrecognized ID/password ; 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" 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) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; 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 TRAN "Ok... bye" GOTO EXIT ENDCASE ; ; Privileged command ; CASE "P" ; Privilege IF FLAG(1) ; Execute only if privileged GOTO Priv_Prompt ; Execute ENDIF ENDCASE ENDSWITCH ; ; Invalid command ; TRAN "^MCommand not recognized... try again^M" GOTO Main_Prompt ; ; ----------------------------------------------------------------------- ; General exit routine - don't GOTO from within a subroutine!!! ; ----------------------------------------------------------------------- ; EXIT: MESS "^G" ; Beep console to indicate exit CLOG "* BBS logoff" 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) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; 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 TRAN "Ok... bye" GOTO EXIT ENDCASE ENDSWITCH ; ; Invalid command ; TRAN "^MCommand not recognized... try again^M" GOTO Priv_Prompt ; ----------------------------------------------------------------------- ; Privileged user: CHDIR... Query for a path. ; ----------------------------------------------------------------------- ; CHDIR: MESS "^M^JCHDIR Command " ; Local console indicator TRAN "^MEnter the drive:subdirectory: " GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. 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 Working..." ; May take a moment DOS "TREED >\HOSTTEMP.TXT" ; To a temp file TRAN "^MUse control-S to suspend, control-Q to continue^M" SENDFILE ASCII "\HOSTTEMP.TXT" TRAN "^M" ; 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 "^MWarning: this command may be used to invoke ANY COMMAND that" TRAN "^MDOS can execute. If you load a program requiring keyboard " TRAN "^Mentry, you lock yourself out and leave the board unusable." TRAN "^M^J" TRAN "^MEnter your command: " GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. 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 Working..." ; May take a moment CONCAT S9 ">\HOSTTEMP.TXT" DOS S9 ; Do it. TRAN "^MUse control-S to suspend, control-Q to continue^M" SENDFILE ASCII "\HOSTTEMP.TXT" TRAN "^M" ; 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 Working..." ; May take a moment DOS "DIR >\HOSTTEMP.TXT" ; To a temp file TRAN "^MUse control-S to suspend, control-Q to continue^M" SENDFILE ASCII "\HOSTTEMP.TXT" TRAN "^M" ; 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 S3 ; Set to default subdir ; ; Prompt for a command ; File_Prompt: GOSUB Display_Limit ; Report amount of time remaining S9 = "^ML)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) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; 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 TRAN "Ok... bye" GOTO EXIT ENDCASE ENDSWITCH TRAN "Invalid selection - try again^M" 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 "^MEnter the file name: " GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set RETURN ; .. disconnect and start over ENDIF ; .. RETURN ; Return to caller ; ; ----------------------------------------------------------------------- ; 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) ; If first flag rtns set GOTO EXIT ; .. disconnect and start over ENDIF ; .. IF NULL S9 ; If no file returned GOTO File_Prompt ; .. start over ENDIF ; .. IF FIND S9 "\" ; Test for subdir in name IF NOT FLAG(1) ; Test for privilege TRAN "^MQualified file names are not permitted." GOTO UPLOAD ; Ask again ENDIF ENDIF IF ISDLFILE S9 ; If file exists in DL subdir TRAN "^MFile already exists" GOTO UPLOAD ; Ask again ENDIF ; ; Prompt for a method ; MESS "^M^JUlo Method prompt " ; Local console indicator TRAN "^MW)xmodem, X)modem, Y)modem, or K)ermit: " S8 = S9 ; Save file name ; ; Keep just the first char entered ; GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; 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 "K" TRAN "^M^JBegin your transfer procedure..." GETFILE KERMIT ; FIle name supplied by caller ENDCASE DEFAULT TRAN "^MInvalid transfer selection" GOTO EOTransfer ENDCASE ENDSWITCH ; ; A file uploaded with subdirectory doesn't get logged ; IF FIND S9 "\" ; Test for subdir in name GOTO EOTransfer ; 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 ; Index from 0 N18 = S10(0:1)*60+S10(3:4) ; Time of upload since midnight ; Index from 0 ; ; 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) ; If disconnect GOTO Exit ; Exit ENDIF 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 NOT SUCCESS ; If error GOTO EOTransfer ; Exit ENDIF DATE S0 ; Get the current date S8 = S8 & " " ; Ensure blank padding FSIZE S11 S8 ; Get file size using fname S10 = S8(0:12) * S0(0:7) * S11(0:6) * S9 ; Index from 0 LENGTH S10 N19 ; Get true length WRITE S10 N19 ; Write the file name WRITE "!" 1 ; Write a delimiter FCLOSEO ; Close the output file 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) ; If first flag rtns set GOTO EXIT ; .. disconnect and start over ENDIF ; .. IF NULL S9 ; If no file returned, GOTO File_Prompt ; .. start over ENDIF ; .. IF FIND S9 "\" ; Test for subdir IF NOT FLAG(1) ; Test for privilege TRAN "^MQualified file names are not permitted." GOTO DOWNLOAD ; Ask again ENDIF ENDIF ISFILE S9 ; Test for file already IF NOT ISFILE S9 ; If file doesn't exist TRAN "^MFile doesn't exist" GOTO DOWNLOAD ; Ask again ENDIF ; ; Prompt for a method ; MESS "^M^JDlo Method prompt " TRAN "^MW)xmodem, X)modem, Y)modem, K)ermit, or A)scii: " S8 = S9 ; Save file name ; ; Keep just the first char entered ; GOSUB Read_Comm ; Read into S9 IF FLAG(0) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; Interpret the response ; SWITCH S9 ; Test the entry CASE "A" 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 "K" TRAN "^M^JBegin your transfer procedure..." SENDFILE KERMIT S8 ENDCASE DEFAULT TRAN "^MInvalid transfer selection" GOTO EOTransfer ENDCASE ENDSWITCH GOTO EOTransfer ; Report success/failure ; ; End of transfer... note result on local console ; EOTRANSFER: IF NOT SUCCESS MESS "^M^JTransfer failed " ELSE MESS "^M^JTransfer OK " ENDIF GOTO File_Prompt ; ----------------------------------------------------------------------- ; List command - list file directories ; ----------------------------------------------------------------------- ; Filelist: N10 = 0 ; Initialize counter (# records) FOPENI "BBS-File" TEXT ; Open the mailkey file IF NOT SUCCESS ; IF error opening TRAN "^MNo files are available at this time^M" GOTO Main_Prompt ; And go back to mainline ENDIF FListLoop: READ S9 80 N19 ; Read a record IF EOF ; Test for end of file GOTO FListEnd ; Report count found ENDIF ; ; With the exception of comments, test for file availability ; IF NOT FIND S9(0:0) "*" ; Always print comments ; Index from 0 S0 = S9(0:12) ; Extract File name ; Index from 0 ISFILE S0 IF FAILURE ; If file dosn't exist GOTO FListLoop ; Count it ENDIF ELSE GOTO FListPrint ; Print comments simply 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:12) * " " * S9(13:19) * " " * S9(21:27) * " " * S9(28:79) ; Index from 0 ; ; And display the record ; FListPrint: 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 ; And continue ENDIF IF NULL S9 ; If blank response TRAN "^M^JSearch aborted" ; Indicate no action GOTO File_Prompt ; And back to submenu ENDIF S18 = S9 ; Save search string ; ; Open the directory for searching ; FOPENI "BBS-File" TEXT ; Open the mailkey file IF NOT SUCCESS ; IF error opening TRAN "^MNo files are available at this time^M" GOTO Main_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 ; Test for end of file GOTO Search_End ; Skip if EOF ENDIF ; ; With the exception of comments, test for file availability ; IF NOT FIND S9(0:0) "*" ; Always print comments ; Index from 0 S0 = S9(0:12) ; Extract File name ; Index from 0 ISFILE S0 IF FAILURE ; If file dosn't exist GOTO Search_Loop ; Skip it ENDIF ELSE GOTO Search_Loop ; Skip comments ENDIF IF NOT FIND S9 S18 ; If string isn't in record GOTO Search_Loop ; Skip record 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 ; S0 = S9(0:12) * " " * S9(13:19) * " " * S9(21:27) * " " * S9(28:79) ; Index from 0 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 S2 ; Reset current subdir MESS "^M^JComment requested " S9 = "Do you wish to leave a comment? " 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) ; If error GOTO Exit ; And continue ENDIF 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 NOT SUCCESS ; 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 ; Index from 0 DATE S8 CONCAT S9(25) S8(0:9) ; Add date ; Index from 0 TIME S8 1 ; (military fmt) CONCAT S9(35) S8(0:7) ; Add time ; Index from 0 WRITE S9 80 ; Write header to file * COM-AND WRITE "!" 1 ; 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 ; ; We have a blank line - and the end of a note ; FCLOSEO ; CLose the file IF FLAG(0) ; If disconnect GOTO Exit ; Hangup ENDIF TRAN "Your note has been recorded - thanks^M^J" 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 S5 ; 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 NOT SUCCESS ; IF error opening TRAN "^MNo bulletins exist^M" 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 ; Test for end of file GOTO Bull_Prompt ; Select one specific ENDIF IF NOT NULL S9(13:13) ; Test privilege flag ; Index from 0 IF NOT FLAG(1) ; Only display if privileged user GOTO BULL_Loop ; SKip if flag set and unprivileged user ENDIF ENDIF ; ; With the exception of comments, test for file availability ; IF FIND S9(0:0) "*" ; Skip comments ; Index from 0 GOTO Bull_Loop ; Throw away comments ENDIF S0 = S9(14:25) ; Extract File name ; Index from 0 ISFILE S0 IF FAILURE ; If file dosn't exist GOTO Bull_Loop ; Count it ENDIF ; ; 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) ; Index from 0 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 = "^ML)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) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. ; ; Test for alpha commands ; GOSUB Left_Justify ; Left justify S9 IF FIND S9(0:0) "L" ; If command was List ; Index from 0 GOTO Bull_List ; Perform the list again ENDIF IF FIND S9(0:0) "M" ; If command was Main ; Index from 0 CHDIR S19 ; Return to default subdir GOTO Main_Prompt ; Go back to main ENDIF IF FIND S9(0:0) "E" ; If command was Exit ; Index from 0 TRAN "Ok... bye" GOTO Exit ; Exit ENDIF ; ; We're going to scan the keys file for the input ; FOPENI "BBS-Bull" TEXT ; Open the bulletin file IF NOT SUCCESS ; IF error opening TRAN "^MNo bulletins available^M" CHDIR S19 ; Return to default subdir GOTO Main_Prompt ; And go back to mainline ENDIF S0 = S9 ; Save response in S0 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) "*" ; Throw away comments ; Index from 0 GOTO Bull_Scan ; .. ENDIF IF NOT NULL S9(13:13) ; Test privilege flag ; Index from 0 IF NOT FLAG(1) ; Only display if privileged user GOTO BULL_Scan ; SKip if flag set and unprivileged user ENDIF ENDIF ; ; Test for file availability ; S8 = S9(14:25) ; Extract File name ; Index from 0 ISFILE S8 IF FAILURE ; If file dosn't exist GOTO Bull_Scan ; Count it ENDIF ; ; Test the record number field against the given ; S9 = S9(0:4) ; Extract just the number ; Index from 0 GOSUB Left_Justify ; Left justify the field in S9 SWITCH S9 ; Test using the given # CASE S0(0:4) ; .. against the rec number field ; Index from 0 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 " ; Local console indicator S9 = "^MError opening Bltnfile" ; Error msg just in case GOSUB Disp_File ; Display the file 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 S4 ; Set to Messages subdir ; ; Prompt for a submenu command ; Mail_Prompt: GOSUB Display_Limit ; Report amount of time remaining S9 = "^MS)can, L)ist, R)ead, 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) ; If first flag rtns set GOTO Exit ; .. disconnect and start over ENDIF ; .. GOSUB Left_Justify ; Left justify S9 S9 = S9(0:0) ; Keep just the first char ; Index from 0 ; ; Interpret the command ; SWITCH S9 ; Test the entry ; ; Read command ; CASE "R" ; Read GOTO Read_Msg 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 TRAN "Ok... bye" GOTO Exit ENDCASE ENDSWITCH TRAN "Invalid selection - try again^M" 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 NOT SUCCESS ; IF error opening GOTO Scan_Rpt ; Use the zero count ENDIF TRAN "^M Working " ; May take a moment Scan_Loop: READ S9 80 N19 ; Read a record IF EOF ; Test for end of file GOTO Scan_Rpt ; Report count found ENDIF S0 = S9(0:7) ; Look at 'to ID' field ; Index from 0 SWITCH S0 ; Test for our ID CASE S1 ; .. in the record S0 = S9(25:37) ; Extract File name ; Index from 0 ISFILE S0 IF SUCCESS ; If file exists INC N11 ; Count it ENDIF 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 "^MYou have no messages waiting" ELSE STRFMT S0 "^MYou 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 NOT SUCCESS ; IF error opening TRAN "^MNo mail exists - why not write something?^M" GOTO Mail_Prompt ; And go back to mainline ENDIF List_Loop: READ S9 80 N19 ; Read a record IF EOF ; Test for end of file GOTO List_End ; Report count found ENDIF S0 = S9(0:7) ; Look at 'to ID' field ; Index from 0 SWITCH S0 ; Test for our ID CASE S1 ; .. in the record ENDCASE DEFAULT ; If not our ID, test privacy IF FIND S9(16:16) "P" ; Test privacy flag ; Index from 0 GOTO List_Loop ; Ignore private messages ENDIF ENDCASE ENDSWITCH S0 = S9(25:37) ; Extract File name ; Index from 0 ISFILE S0 IF FAILURE ; If file dosn't exist GOTO List_Loop ; Count it ENDIF ; ; 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) ; Index from 0 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 command: Read mail files 'to' the current user ; ----------------------------------------------------------------------- ; Read_Msg: FOPENI "BBS-Mail" TEXT ; Open the mailkey file IF NOT SUCCESS ; IF error opening TRAN "^MNo mail exists - why not write something?^M" GOTO Mail_Prompt ; And continue ENDIF Read_Loop: READ S9 80 N19 ; Read a record IF EOF ; Test for end of file GOTO Read_End ; exit on End file ENDIF S0 = S9(0:7) ; Look at 'to ID' field ; Index from 0 SWITCH S0 ; Test for our ID ; ; Test for mail to current caller ; CASE S1 ; .. in the record 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 FIND S9(16:16) "P" ; .. for privacy flag ; Index from 0 IF STRCMP S9(8:15) S1 ; If we wrote it ; Index from 0 SET FLAG(9) ON ; Allow sender to read msgs sent ELSE ; We didn't write it GOTO Read_Loop ; So.. ignore private messages ENDIF ENDIF ENDCASE ENDSWITCH S0 = S9(25:37) ; Extract File name ; Index from 0 ISFILE S0 IF FAILURE ; If file dosn't exist GOTO Read_Loop ; Count it ENDIF ; ; Test if we wrote this notice... if so, allow delete too ; S8 = S1 ; Extract ID SWITCH S8 ; Using our ID CASE S9(8:15) ; Test the from-ID field ; Index from 0 SET FLAG(9) ON ; Allow deletion of our own msgs ENDCASE ENDSWITCH ; ; Display the current file ; S8 = S0 ; Set-up file name S9 = "^MError opening mailfile" GOSUB Disp_File ; Display the file ; ; Ask if the file is to be deleted ; IF FLAG(9) ; If it was ours TRAN "^M^MDelete? (Y/N): ^H"; Ask if its to be deleted GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error GOTO Exit ; And continue ENDIF IF FIND S9 "Y" ; Test for "Y" DELETE S8 ; Delete file named in S8 TRAN "Message deleted^M^J"; Indicate its done ENDIF ENDIF ; ; Ask for the next command ; TRAN "^M^MContinue (CR/Y/N): ^H" GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error GOTO Exit ; And continue ENDIF IF NOT FIND S9 "N" ; Test for "N" GOTO Read_Loop ; And continue looping ENDIF ; ; End of read... close input file, and we're done ; Read_End: FCLOSEI ; Close the mail keys file GOTO Mail_Prompt ; And loop until EOF ; ----------------------------------------------------------------------- ; Write command - write mail ; ----------------------------------------------------------------------- ; Write_Msg: TRAN "To: ^H" ; Prompt for ID GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error GOTO Exit ; And continue ENDIF GOSUB Left_Justify ; Left justify ID IF NULL S9 ; If blank entry GOTO Mail_Prompt ; Skip it ENDIF S10 = S9(0:7) ; Save TO ID ; Index from 0 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) ; If error GOTO Exit ; And continue ENDIF S11 = S9 ; Save returned subject ; ; Open a temporary file ; FOPENO "\HOSTTEMP.TXT" TEXT ; OPEN file for output IF NOT SUCCESS ; if open failed TRAN "Error opening file - please try later^M^J" GOTO Mail_Prompt ; Back to submenu ENDIF ; ; Place a header ; S9 = "To: " ; Set Sender ID CONCAT S9(7) S10 ; .. ; Index from 0 WRITE S9 20 ; Write header to file * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND S9 = "From: " ; Set Sender ID CONCAT S9(7) S1 ; .. ; Index from 0 WRITE S9 20 ; Write header to file * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND S9 = "Date: " ; Set date and time DATE S12 CONCAT S9(7) S12 ; Add date ; Index from 0 TIME S8 1 ; (military fmt) CONCAT S9(17) S8 ; Add time ; Index from 0 WRITE S9 30 ; Write header to file * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND S9 = "Subject: " ; Set subject CONCAT S9(9) S11 ; .. ; Index from 0 LENGTH S9 N19 ; Get actual length WRITE S9 N19 ; Write header to file * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE "!" 1 ; 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 FCLOSEO ; Close the file IF FLAG(0) ; If disconnect during copy_text GOTO Exit ; Hangup w/o saving ENDIF ; ; Ask if the file is to be saved ; TRAN "Save? (Y/N): ^H" ; Ask if its to be saved GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error GOTO Exit ; And continue ENDIF IF NOT FIND S9 "Y" ; Test for "Y" GOTO Mail_Prompt ; Throw it away ENDIF ; ; Now - scan for the last used file name ; TRAN "^MScanning for free slot" N10 = 0 ; Set default extension we'll use S0 = S10(0:7) ; Look at 'to ID' field ; Index from 0 FOPENI "BBS-Mail" TEXT ; Open the mailkey file IF NOT SUCCESS ; IF error opening GOTO Write_End ; Create the file below ENDIF Write_Loop: READ S9 80 N19 ; Read a record IF EOF ; Test for end of file GOTO Write_End ; Go put away the file ENDIF SWITCH S0 ; Test for the ID CASE S9(0:7) ; .. in the to-field of the record ; Index from 0 FIND S9(25:37) "." N11 ; Find the "." delimiter ; Index from 0 N11 = N11+26 ; Point to decimal extension ; Index from 0 ATOI S9(N11:79) N10 ; Get extension # ; Index from 0 ENDCASE ENDSWITCH GOTO Write_Loop ; Loop ; ; We have found the first free file name ; Write_End: FCLOSEI ; CLose the input file TRAN "^M^JPrivate? (Y/N): " ; Ask if its to a private msg GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error GOTO Exit ; And continue ENDIF S13 = " " ; Set privacy flag IF FIND S9 "Y" ; Test for "Y" S13 = "P" ; Set flag field to private ENDIF N10 = N10+1 ; Use next sequential # S0 = S0&"."&N10 ; Make a new file name S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command DOS S9 ; Perform the copy 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 50 ; Write the subject WRITE "!" 1 ; And a delimiter FCLOSEO ; ANd close the keys file GOTO Mail_Prompt ; 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? " 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 RETURN ; SImply return ENDIF FIND S9 "Y" ; Look for "Y" IF NOT FOUND ; IF answer wan't 'Y' TRAN "OK - bye" ; 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) ; If error RETURN ; SImply return ENDIF S18 = S9 ; Save return TRAN "Enter your street address: " GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error RETURN ; SImply return ENDIF S17 = S9 ; Save return TRAN "Enter your city/state and zip: " GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error RETURN ; SImply return ENDIF 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) ; If error RETURN ; SImply return ENDIF 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) ; If error RETURN ; SImply return ENDIF IF FIND S9(0:7) "." ; Index from 0 ; Index from 0 TRAN "ID may not contain '.'s^M^J" GOTO Reg_ID ENDIF IF FIND S9(0:7) "," ; Index from 0 ; Index from 0 TRAN "ID may not contain ','s^M^J" GOTO Reg_ID ENDIF IF FIND S9(0:7) "\" ; Index from 0 ; Index from 0 TRAN "ID may not contain '\'s^M^J" GOTO Reg_ID ENDIF IF FIND S9(0:7) "/" ; Index from 0 ; Index from 0 TRAN "ID may not contain '/'s^M^J" GOTO Reg_ID ENDIF S14 = S9(0:7) ; Save return ; Index from 0 ; ; 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) ; If error RETURN ; SImply return ENDIF IF NULL S9(0:7) ; Test for blank entered ; Index from 0 TRAN "You must have a password^M^J" GOTO Reg_Pass ENDIF S14 = S14 & ";" &S9(0:7) ; Concatenate PASSWORD to ID ; Index from 0 ; ; 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? " GOSUB Read_Comm ; Read a response IF FLAG(0) ; If error RETURN ; SImply return ENDIF FIND S9 "Y" ; Look for "Y" IF NOT FOUND ; IF answer wan't 'Y' GOTO Register ; Try again ENDIF ; ; Open the comments file ; FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input IF NOT SUCCESS ; 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 ; Index from 0 TIME S1 1 ; (military fmt) CONCAT S9(38) S1 ; Index from 0 WRITE S9 20 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE S18 80 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE S17 80 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE S16 80 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE S15 80 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND WRITE S14 80 ; Write a record * COM-AND WRITE "!" 1 ; Write a record delim * COM-AND ; ; 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: FIND S9 "1200" ; Test for 1200 baud IF FOUND ; IF found SET BAUD 1200 ; Set to 1200 baud RETURN ; We're done. ENDIF FIND S9 "2400" ; Test for 1400 baud IF FOUND ; IF found SET BAUD 2400 ; Set to 1400 baud RETURN ; We're done. ENDIF ; ; None of the above... set to 300 ; SET BAUD 300 ; Set to 1200 baud RETURN ; We're done.