home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / comm / ca24_1.zip / BBS&HOST.ZIP / BBS-SRC.CMD next >
OS/2 REXX Batch file  |  1989-02-23  |  63KB  |  2,117 lines
  1. ; ----- COM-AND Scripted BBS mode
  2. ;    Commenced: 03/18/88 R.McG
  3. ;    Updated:    2/--/89 R.McG
  4. ; -----------------------------------------------------------------------
  5. ;    Goals:
  6. ;    o    Must autodetect caller's baud rate
  7. ;    o    Must work correctly for modems reporting true CD and otherwise.
  8. ;
  9. ;    Functions:
  10. ;    o    ID/Passworded log-on (with registration)
  11. ;    o    Capabilities set by SYSOP
  12. ;    o    UP and DOWNLOADS
  13. ;    o    Mail and bulletins
  14. ;    o    Privileged access (Pathlist,CHDIR, DOS commands)
  15. ; -----------------------------------------------------------------------
  16. ;    Usages:
  17. ;      S0 ------> General scratch buffer
  18. ;      S1 ------> ID;password during logon; ID after logon upper cased
  19. ;      S2 ------> Default drive/subdir for entry
  20. ;      S3 ------> Default drive/subdir for files
  21. ;      S4 ------> Default drive/subdir for mail
  22. ;      S5 ------> Default drive/subdir for bulletins
  23. ;      S6 ------> Logon time (used by Read_Comm to timeout)
  24. ;      S8 ------> Scratch buffer (file name parm for Disp_File)
  25. ;      S9 ------> General read buffer
  26. ;      S10-S18 -> Scratch buffers
  27. ;      S19 -----> Is used to save default subdir within commands
  28. ;
  29. ;      N0 ------> # minutes allowed for call (set by logon)
  30. ;      N10-N19 -> Generally scratch
  31. ;
  32. ;      FLAG(0) -> ON if an error condition is being reported...
  33. ;          Upon return from Read_Comm: ON -> timeout or disconn
  34. ;          Upon return from Logon -> OFF -> Logon OK
  35. ;      FLAG(1) -> After Logon, privileged access if ON
  36. ;      FLAG(2) -> a CHDIR has been performed by a privileged user
  37. ;      FLAG(3) -> There is a logged on caller (if true)
  38. ; -----------------------------------------------------------------------
  39. ;
  40. ;    Initialize COM related values
  41. ;
  42.     SET BAUD 1200            ; Starting parms
  43.     SET PARITY NONE
  44.     SET DATA 8
  45.     SET STOP 1
  46.     SET PORT COM2
  47.     SET MASK ON            ; accept 7 or 8 bits
  48.     SET ASCII UP_LF LF        ; Send LFs
  49. ;
  50. ;    Initialize variables that must be constant
  51. ;
  52.     S2 = "\BBS"                     ; Set to our subdirectory
  53.     S3 = "\BBS\FILES"               ; Set subdir for files
  54.     S4 = "\BBS\MAIL"                ; Set subdir for mail
  55.     S5 = "\BBS\BULLETIN"            ; Set subdir for bulletins
  56. ;
  57. ;    Initialize other values
  58. ;
  59.     SET ALARM OFF            ; Turn off alarm
  60.     SET ATIME 1            ; Set alarm time to 1 second
  61.     CHDIR S2            ; Set to our subdirectory
  62.     SET DLDIR S3            ; Set DLDIR
  63.     LEGEND "Scripted BBS mode.  Press ESC to terminate or to CHAT."
  64.     TRANSMIT "~~~+++~~~ATZ^M"       ; Initialize modem
  65.  
  66.     ON ESCAPE GOSUB Chat        ; Enter chat mode on operator escape
  67.     CLOG "* BBS script loaded"
  68.     GOTO Restart            ; Branch around subroutines
  69.  
  70. ; -----------------------------------------------------------------------
  71. ;    Subroutine: Chat mode: Operator entered escape
  72. ;
  73. ;    S0 is used as scratch
  74. ; -----------------------------------------------------------------------
  75. ;
  76. Chat:
  77. ;
  78. ;    Ask if we're to terminate.
  79. ;
  80.     MESS "^M^JDo you wish to terminate? (Y/N) "
  81.     GET S0 2            ; Read a response
  82.     IF FIND S0 "Y"                  ; If response was yes
  83.        HANGUP            ; Hangup the phone
  84.        CLOG "* BBS script terminated"
  85.        EXIT             ; Exit
  86.        ENDIF
  87. ;
  88. ;    If no user is logged on, just return to what we were doing
  89. ;
  90.     IF NOT FLAG(3)            ; If noone logged on
  91.        RETURN            ; Return to caller
  92.        ENDIF
  93. ;
  94. ;    Ask if we're to chat.
  95. ;
  96.     MESS "^M^JDo you wish to chat with the caller (Y/N) "
  97.     GET S0 2            ; Read a response
  98.     IF FIND S0 "N"                  ; If response was no
  99.        RETURN            ; Return to what we were doing
  100.        ENDIF
  101. ;
  102. ;    Start chat mode.
  103. ;
  104.     TRAN "^M^J"                     ; Send a c/r
  105.     TRAN "^M^JOperator initiated chat mode..."
  106. ;
  107. ;    Read from the operator
  108. ;
  109. Chat_Loop:
  110.     MESS "^M^JSYSOP: "              ; Prompt
  111.     GET S0 80            ; Read from kbd
  112.  
  113.     IF NULL S0            ; If blank entry
  114.        MESS "Continue? (Y/N) "
  115.        GET S0 2            ; Read a response
  116.        IF FIND S0 "N"               ; If response was no
  117.           TRAN "^M^JChat terminated by SYSOP"
  118.           RETURN            ; Return to what we were doing
  119.           ENDIF
  120.        S0 = " "                     ; Make a blank line
  121.        ENDIF
  122.     TRAN "^M^JSYSOP: "
  123.     TRAN S0             ; Send the line
  124. ;
  125. ;    Read from the caller
  126. ;
  127.     MESS "Caller: "                 ; NO c/r req'd
  128.     TRAN "^M^JCaller: "             ; Prompt
  129.     GOSUB Read_Comm         ; read the comm port
  130.     IF FLAG(0)            ; If caller disconn
  131.        MESS "^M^JCaller disconnected" ; Inform sysop
  132.        RETURN            ; ANd return
  133.        ENDIF
  134.     GOTO Chat_Loop            ; And continue
  135.  
  136. ; -----------------------------------------------------------------------
  137. ;    Subroutine: Limit time on-line
  138. ;    .. S6 -> Time of logon
  139. ;    .. N0 -> Max minutes allowed
  140. ;
  141. ;    FLAG(0) off -> Time remaining
  142. ;        on --> Disconnect the caller
  143. ;
  144. ;    S9 and N18,N19 are used as scratch
  145. ; -----------------------------------------------------------------------
  146. ;
  147. Limit_Time:
  148. ;
  149. ;    If privileged user, just return true
  150. ;
  151.     IF FLAG(1)            ; If privileged user
  152.        SET FLAG(0) OFF        ; Return OK
  153.        RETURN            ; Return to caller
  154.        ENDIF
  155. ;
  156. ;    Convert times to numeric quantities
  157. ;
  158.     TIME S9 1            ; Get current time (military fmt)
  159.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight ; Index from 0
  160.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight          ; Index from 0
  161. ;
  162. ;    And test the time remaining
  163. ;
  164.     IF GT N18 N19            ; If timeout on the RGET
  165.        N19 = N19+1440        ; Allow wrap accross midnight
  166.        ENDIF
  167.     N19 = N19-N18            ; COmpute time on
  168.  
  169.     IF GT N19 N0            ; Test against logon determined time
  170.        TRAN "^M^JYour alotted time has expired..."
  171.        TRAN "^M^JYou are being disconnected."
  172.        SET FLAG(0) ON        ; Indicate disconnect
  173.        RETURN            ; RETURN to caller
  174.        ENDIF
  175. ;
  176. ;    Return 'OK'
  177. ;
  178.     SET FLAG(0) OFF         ; Report to caller
  179.     RETURN                ; Return with text in S9
  180.  
  181. ; -----------------------------------------------------------------------
  182. ;    Subroutine: Read from the caller into S9
  183. ;    .. This handles 'disconnect' and timeouts.
  184. ;
  185. ;    FLAG(0) off -> Line read correctly
  186. ;        on --> Disconnect or timeout
  187. ; -----------------------------------------------------------------------
  188. ;
  189. Read_Comm:
  190. ;
  191. ;    Test timeout
  192. ;
  193.     IF FLAG(3)            ; If user logged on now
  194.        GOSUB Limit_Time        ; Test time on-line
  195.        IF FLAG(0)            ; If error returns set
  196.           RETURN            ; .. End the proc here
  197.           ENDIF            ; .. with a simulated disconn
  198.        ENDIF
  199. ;
  200. ;    Now, sit on the COMM port waiting for a read
  201. ;
  202.     RGET S9 80 180            ; Wait for a connection
  203.     IF NOT CONNECTED        ; If modem reports CD dropped
  204.        GOTO Disconnect        ; Goto disconnect
  205.        ENDIF
  206.  
  207.     IF NOT SUCCESS            ; If timeout on the RGET
  208.        GOTO Timeout         ; .. issue message and disconnect
  209.     ENDIF
  210.  
  211.     FIND S9 "NO CARRIER"            ; Test for message from modem
  212.     IF FOUND            ; If modem didn't report 'CD' true
  213.        GOTO Disconnect        ; Goto disconnect
  214.        ENDIF
  215. ;
  216. ;    Return 'text read'
  217. ;
  218.     SET FLAG(0) OFF         ; Report to caller
  219.     RETURN                ; Return with text in S9
  220. ;
  221. ;    Timeout on the call
  222. ;
  223. Timeout:
  224.     TRAN "^M^J... autodisconnect due to timeout^M^J"
  225.     MESSAGE "^M... autodisconnect due to timeout"
  226.     GOTO RComm_Exit         ; Exit cycle in the usual manner
  227. ;
  228. ;    Disconnect was reported.
  229. ;
  230. Disconnect:
  231.     MESSAGE  "^MCaller disconnected"
  232. ;
  233. ;    Read_Comm error exit
  234. ;
  235. RComm_Exit:
  236.     SET FLAG(0) ON            ; Report to caller
  237.     RETURN                ; Return to the caller
  238.  
  239. ; -----------------------------------------------------------------------
  240. ;    Subroutine: Display the # of allotted minutes remaining
  241. ;    .. S6 -> Time of logon
  242. ;    .. N0 -> Max minutes allowed
  243. ;
  244. ;    S9 and N18,N19 are used as scratch
  245. ; -----------------------------------------------------------------------
  246. ;
  247. Display_Limit:
  248. ;
  249. ;    If privileged user, just return (no message)
  250. ;
  251.     IF FLAG(1)            ; If privileged user
  252.        RETURN            ; RETURN to caller
  253.        ENDIF
  254. ;
  255. ;    Convert times to numeric quantities
  256. ;
  257.     TIME S9 1            ; Get current time (military fmt)
  258.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight ; Index from 0
  259.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight          ; Index from 0
  260. ;
  261. ;    Compute the time remaining
  262. ;
  263.     IF GT N18 N19            ; If timeout on the RGET
  264.        N19 = N19+1440        ; Allow wrap accross midnight
  265.        ENDIF
  266.     N19 = N0-(N19-N18)        ; Compute remaining time
  267. ;
  268. ;    Display the quantity and we're done
  269. ;
  270.     STRFMT S9 "^M^J(%d minutes remaining)" N19
  271.     TRAN S9
  272.     RETURN                ; Return with text in S9
  273.  
  274. ; -----------------------------------------------------------------------
  275. ;    Subroutine: Logon - ID/password are in S1 (0:15)
  276. ;
  277. ;    On exit:
  278. ;       FLAG(0) ON -> indicate falure of logon
  279. ;       FLAG(1) ON -> if logon successful to indicate privileged access
  280. ; -----------------------------------------------------------------------
  281. ;
  282. Logon:
  283.     FOPENI "BBS-User" TEXT          ; OPEN file for input
  284.     IF NOT SUCCESS            ; if open failed
  285.        SET FLAG(0) ON        ; Report an error
  286.        RETURN            ; Return to caller
  287.        ENDIF
  288.  
  289. Logon_Loop:
  290.     READ S9 80 N19            ; Read a record      * COM-AND
  291.     IF EOF                ; Test for EOF
  292.        FCLOSEI            ; CLose the input file
  293.        SET FLAG(0) ON        ; Report an error
  294.        RETURN            ; Return to caller
  295.        ENDIF
  296.  
  297.     FIND S9(0:0) "<"                ; Test for comment line  ; Index from 0
  298.     IF FOUND            ; IF "<" found,
  299.        GOTO Logon_Loop        ; Skip comment lines
  300.        ENDIF
  301.  
  302.     SWITCH S1            ; Test ID/Password
  303.        CASE S9(0:15)        ; .. against record     ; Index from 0
  304.           GOTO Logon_OK        ; We have a match
  305.        ENDCASE
  306.     ENDSWITCH
  307.     GOTO Logon_Loop         ; Read the next record
  308. ;
  309. ;    We have a successful logon
  310. ;
  311. Logon_OK:
  312.     SET FLAG(1) OFF         ; Default no privilege
  313.     SET FLAG(3) ON            ; Set flag to say 'logged-on'
  314.     N0 = 60             ; Set time limit for non-privileged user
  315.  
  316.     FIND S9(16:16) "P"              ; Test for privilege     ; Index from 0
  317.     IF FOUND            ; IF "P" found,
  318.        SET FLAG(1) ON        ; Indicate privilege
  319.        N0 = 3000            ; 50 hours ought to be enough
  320.        ENDIF
  321.  
  322.     TIME S6 1            ; Set time of logon (military fmt)
  323.  
  324.     FCLOSEI             ; CLose the input file
  325.     SET FLAG(0) OFF         ; Indicate successful logon
  326.     RETURN
  327.  
  328. ; -----------------------------------------------------------------------
  329. ;    Subroutine: DispFile: Display a file
  330. ;
  331. ;    On entry:
  332. ;       S8 -> The file to be opened (and displayed)
  333. ;       S9 -> A message to be displayed if the file D.N.E
  334. ; -----------------------------------------------------------------------
  335. ;
  336. Disp_File:
  337.     ISFILE S8            ; Test file for existance
  338.     IF NOT SUCCESS            ; if open d.n.e
  339.        TRAN S9            ; Display the alternative message
  340.        RETURN            ; Return to caller
  341.        ENDIF
  342.  
  343.     TRAN "^M^J"                     ; Send an initial delimiter
  344.     SENDFILE ASCII S8        ; Send the file
  345.     TRAN "^M^J"                     ; Send a final delimiter
  346.     RETURN                ; Return to caller
  347. ;
  348. ; -----------------------------------------------------------------------
  349. ;    Subroutine: Left_justify: Left justify the string in S9
  350. ;
  351. ;    N19 is used as a scratch reg
  352. ; -----------------------------------------------------------------------
  353. ;
  354. Left_Justify:
  355.     LENGTH S9 N19            ; Set a loop stopper
  356. LJ_Loop:
  357.     IF NOT NULL S9(0:0)        ; If column 1 is not blank ; Index from 0
  358.        RETURN            ; End of procedure
  359.        ENDIF
  360.  
  361.     S9 = S9(1:79)            ; Strip the blank     ; Index from 0
  362.     DEC N19             ; Count the strip
  363.     IF GT N19 0            ; If still within string
  364.        GOTO LJ_Loop         ; Continue stripping
  365.        ENDIF
  366.     RETURN                ; Whole string was blank
  367.  
  368. ; -----------------------------------------------------------------------
  369. ;    Subroutine: Log_Item: Add a line to the activity log
  370. ;
  371. ;    On entry:
  372. ;       S9 -> The line to be added
  373. ;
  374. ;    S8 is used as a scratch reg; S9 is modified
  375. ; -----------------------------------------------------------------------
  376. ;
  377. Log_Item:
  378.     FOPENO "BBS-LOG" TEXT APPEND    ; OPEN file for output
  379.     IF NOT SUCCESS            ; if open failed
  380.        RETURN            ; Return to caller
  381.        ENDIF
  382.  
  383.     DATE S8             ; Get current date
  384.     CONCAT S9(59) S8        ; Add date to S9 line     ; Index from 0
  385.     TIME S8 1            ; Get current time (military fmt)
  386.     CONCAT S9(70) S8        ; Add time to S9 line     ; Index from 0
  387.  
  388.     WRITE S9 80            ; Write a record     * COM-AND
  389.     WRITE "^M" 1                    ; Write a cr/lf          * COM-AND
  390.     FCLOSEO             ; CLose the output file
  391.     RETURN                ; And we're done
  392. ;
  393. ; -----------------------------------------------------------------------
  394. ;    Subroutine: Copy text to an open file (write a message)
  395. ;    The output file must be opened by the caller
  396. ;
  397. ;    S9, N18 and N19 are used as scratch
  398. ; -----------------------------------------------------------------------
  399. ;
  400. Copy_Text:
  401.     N19 = 0
  402. Copy_Loop:
  403.     INC N19             ; Increment line counter
  404.     S9 = N19 & ":  ^H"              ; Convert to decimal ascii
  405.     TRAN S9             ; Transmit line number
  406.  
  407.     GOSUB Read_Comm         ; Read a response
  408.     IF FLAG(0)            ; If error
  409.        RETURN            ; RETURN - end of text
  410.        ENDIF
  411. ;
  412. ;    If the line is not blank, copy it to the output file
  413. ;
  414.     IF NOT NULL S9            ; Test for a blank line
  415.        LENGTH S9 N18        ; Get proper length
  416.        WRITE S9 N18         ; Write the line     * COM-AND
  417.        IF NOT SUCCESS        ; if write failed
  418.           TRAN "Error recording text - please try later^M^J"
  419.           RETURN            ; Return to caller
  420.           ENDIF
  421.        WRITE  "!" 1                 ; And a record delimiter * COM-AND
  422.        GOTO Copy_Loop        ; And loop
  423. ;
  424. ;    A blank line was entered - ask if we are to terminate
  425. ;
  426.     ELSE
  427.        TRAN "^M^JComplete? (Y/N) "  ; Ask if this is end of input
  428.        GOSUB Read_Comm        ; Read a response
  429.        IF FLAG(0)            ; If error
  430.           RETURN            ; RETURN - disconn
  431.           ENDIF
  432.        IF NOT FIND S9 "Y"           ; Test for positive response
  433.           WRITE "!" 1               ; Write a blank line
  434.           GOTO Copy_Loop        ; COntinue copying
  435.           ENDIF
  436.        ENDIF
  437.     RETURN                ; Return - we're done
  438.  
  439. ; -----------------------------------------------------------------------
  440. ; ----- Begin ... reset values, and set the modem to accept a call
  441. ; -----------------------------------------------------------------------
  442. ;
  443. Restart:
  444.     CHDIR S2            ; Reset to default drive
  445.     SET RECHO OFF            ; Turn off echo for us
  446.     SET RDISP ON            ; Turn on display of received chars
  447.     CLEAR                ; Clear screen
  448.     LOCATE 0,0            ; Set to home
  449.  
  450.     SET FLAG(1) OFF         ; Turn off privilege flag
  451.     SET FLAG(2) OFF         ; Turn off CHDIR flag
  452.     SET FLAG(3) OFF         ; Turn off logged-on flag
  453. ;
  454. ;    Go into auto answer (echo off, answer on 3rd)
  455. ;    Also: Return result codes, word form, with CONNECT 1200
  456. ;
  457.     MESSAGE "^MWaiting..."
  458.     Pause 3             ; Wait 3 seconds
  459.     HANGUP                ; HANGUP and leave modem in cmd mode
  460.     PAUSE 3             ; Wait 3 secs
  461.     TRANSMIT "ATE0Q0V1X1S0=2 S7=30 S9=10^M"
  462. ;
  463. ; -----------------------------------------------------------------------
  464. ; ----- Wait for a connect
  465. ; -----------------------------------------------------------------------
  466. ;
  467. Wait_Connect:
  468.     RGET S9 80 180            ; Wait for a line
  469.     IF NOT SUCCESS            ; If nothing was read
  470.        GOTO Wait_Connect
  471.        ENDIF
  472.  
  473.     FIND S9 "NO CARRIER"            ; Look for a disconn
  474.     IF FOUND
  475.        GOTO Restart
  476.        ENDIF
  477.  
  478.     FIND S9 "CONNECT"               ; Anything else BUT CONNECT
  479.     IF NOT FOUND            ; .. waits
  480.        GOTO Wait_Connect
  481.        ENDIF
  482.  
  483. ;***    IF NOT CONNECTED
  484. ;***       GOTO Wait_Connect
  485. ;***       ENDIF
  486. ;
  487. ; ----- Connection established: Adjust our linespeed if need be
  488. ;
  489.     GOSUB AutoBaud            ; Change rate according to CONNECT MSG
  490. ;
  491. ; ----- Issue a greeting
  492. ;
  493.     S9 = "^M^JThe Flying Scotsman greets you!! ^M^J"
  494.     S8 = "BBS-Welc"                 ; Set file name
  495.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  496.  
  497.     SET RECHO ON            ; Turn on echo (echo back to caller)
  498.     N10 = 0             ; Set count of logon tries
  499.  
  500. ; ----- Request an ID
  501. ;
  502. ID_Query:
  503.     TRANSMIT "^MEnter your ID (or enter GUEST): "
  504.     GOSUB Read_Comm         ; Read into S9
  505.     IF FLAG(0)            ; If first flag rtns set
  506.        GOTO Exit            ; .. disconnect and start over
  507.        ENDIF            ; ..
  508.  
  509.     IF NULL S9            ; Test for nothing entered
  510.        GOTO ID_Query        ; Require an ID
  511.        ENDIF            ; End of empty test
  512.  
  513.     SWITCH S9
  514.        CASE "GUEST"                 ; Test for nothing entered
  515.           GOSUB Register        ; Try to register the caller
  516.           GOTO Exit         ; And exit the sequence
  517.        ENDCASE            ; End of GUEST test
  518.     ENDSWITCH            ; End of ID test
  519.     S1 = S9(0:7)            ; Save 8 chars of ID     ; Index from 0
  520.     UPPER S1            ; Make ID upper case
  521. ;
  522. ; ----- Request a password
  523. ;
  524. Password_Query:
  525.     TRANSMIT "^MEnter your password: "
  526.     SET RECHO OFF            ; Turn of echo of received text
  527.     SET RDISPLAY OFF        ; Turn off echo to console too
  528.  
  529.     GOSUB Read_Comm         ; Read into S9
  530.     IF FLAG(0)            ; If first flag rtns set
  531.        GOTO Exit            ; .. disconnect and start over
  532.        ENDIF            ; ..
  533.  
  534.     SET RECHO ON            ; Restore echo
  535.     SET RDISPLAY ON         ; Turn on echo to console again
  536.  
  537.     IF NULL S9            ; Test for nothing entered
  538.        GOTO Password_Query        ; Require a password
  539.        ENDIF            ; End of empty test
  540. ;
  541. ;    Build the ID/password string and test logon
  542. ;
  543.     S1(8:79) = S9(0:7)        ; Add password to S1     ; Index from 0
  544.     GOSUB Logon            ; Test logon
  545.     IF NOT FLAG(0)            ; If flag(0) returns reset
  546.        S9 = "Logon: "               ; Set activity
  547.        CONCAT S9(7) S1(0:7)     ; Add ID of caller     ; Index from 0
  548.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  549.        SET FLAG(2) OFF        ; Indicate no CHDIR this user
  550.        S1 = S1(0:7)         ; Throw away password     ; Index from 0
  551.        CLOG "* BBS logon: "*S1
  552.        GOTO Main_Prompt        ; OK - we're on
  553.        ENDIF
  554. ;
  555. ;    Unrecognized ID/password
  556. ;
  557.     TRAN "Unrecognized ID/Password^M^J"
  558.     INC N10             ; Increment count of tries
  559.     IF GE N10 3            ; If tried 3 times to logon
  560.        TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
  561.        MESS "^M^JLogon attempts failed^M^J"
  562.        GOTO Exit            ; ANd hangup
  563.        ENDIF
  564.     GOTO ID_Query            ; And try again
  565.  
  566. ; -----------------------------------------------------------------------
  567. ; ----- Main Loop: Prompt for a command and interpret the return
  568. ; -----------------------------------------------------------------------
  569. ;
  570. Main_Prompt:
  571.     MESS "^M^JMain prompt "         ; Local console indicator
  572.  
  573.     GOSUB Display_Limit        ; Report amount of time remaining
  574.     IF NOT FLAG(1)            ; According to privilege
  575.        S9 = "^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  576.        S8 = "BBS-NpMn"              ; Set file name
  577.     ELSE
  578.        S9 = "^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  579.        S8 = "BBS-PrMn"              ; Set file name
  580.        ENDIF
  581.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  582. ;
  583. ;    Keep just the first char entered
  584. ;
  585.     GOSUB Read_Comm         ; Read into S9
  586.     IF FLAG(0)            ; If first flag rtns set
  587.        GOTO Exit            ; .. disconnect and start over
  588.        ENDIF            ; ..
  589.  
  590.     GOSUB Left_Justify        ; Left justify S9
  591.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  592. ;
  593. ;    Perform commands
  594. ;
  595.     SWITCH S9            ; Test the entry
  596.     ;
  597.     ;    Alarm
  598.     ;
  599.        CASE "A"                     ; Signal request for chat mode
  600.           GOTO Alarm
  601.        ENDCASE
  602.     ;
  603.     ;    Mail
  604.     ;
  605.        CASE "M"                     ; Messages
  606.           GOTO Mail_Command
  607.        ENDCASE
  608.     ;
  609.     ;    Files command
  610.     ;
  611.        CASE "F"                     ; Files
  612.           GOTO File_Command
  613.        ENDCASE
  614.     ;
  615.     ;    Comment command
  616.     ;
  617.        CASE "C"                     ; Leave a note
  618.           GOTO Comment
  619.        ENDCASE
  620.     ;
  621.     ;    Bulletin command
  622.     ;
  623.        CASE "B"                     ; Read bulletins
  624.           GOTO Bull_Command
  625.        ENDCASE
  626.     ;
  627.     ;    Exit command
  628.     ;
  629.        CASE "E"                     ; Exit
  630.           TRAN "Ok... bye"
  631.           GOTO EXIT
  632.        ENDCASE
  633.     ;
  634.     ;    Privileged command
  635.     ;
  636.        CASE "P"                     ; Privilege
  637.           IF FLAG(1)        ; Execute only if privileged
  638.          GOTO Priv_Prompt    ; Execute
  639.          ENDIF
  640.        ENDCASE
  641.     ENDSWITCH
  642. ;
  643. ;    Invalid command
  644. ;
  645.     TRAN "^MCommand not recognized... try again^M"
  646.     GOTO Main_Prompt
  647. ;
  648. ; -----------------------------------------------------------------------
  649. ;    General exit routine - don't GOTO from within a subroutine!!!
  650. ; -----------------------------------------------------------------------
  651. ;
  652. EXIT:
  653.     MESS "^G"                       ; Beep console to indicate exit
  654.     CLOG "* BBS logoff"
  655.     GOTO Restart            ; And start over
  656. ;
  657. ; -----------------------------------------------------------------------
  658. ;    Alarm routine - make some noise, in hopes we can upset somebody
  659. ; -----------------------------------------------------------------------
  660. ;
  661. Alarm:
  662.     SOUND 440 500            ; 1/2 sec  Scale in 'A'
  663.     SOUND 493 100            ; 1/10 sec
  664.     SOUND 554 100            ; 1/10 sec
  665.     SOUND 587 100            ; 1/10 sec
  666.     SOUND 659 100            ; 1/10 sec
  667.     SOUND 739 100            ; 1/10 sec
  668.     SOUND 830 100            ; 1/10 sec
  669.     SOUND 880 500            ; 1/2 sec
  670.     GOTO Main_Prompt        ; And start over
  671.  
  672. ; -----------------------------------------------------------------------
  673. ; ----- Privileged commands submenu.
  674. ; -----------------------------------------------------------------------
  675. ;
  676. Priv_Prompt:
  677.     MESS "^M^JPrivilege prompt "    ; Local console indicator
  678.  
  679.     GOSUB Display_Limit        ; Report amount of time remaining
  680.     S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
  681.     S8 = "BBS-PPMn"                 ; Set file name
  682.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  683. ;
  684. ;    Keep just the first char entered
  685. ;
  686.     GOSUB Read_Comm         ; Read into S9
  687.     IF FLAG(0)            ; If first flag rtns set
  688.        GOTO Exit            ; .. disconnect and start over
  689.        ENDIF            ; ..
  690.  
  691.     GOSUB Left_Justify        ; Left justify S9
  692.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  693. ;
  694. ;    Execute a command
  695. ;
  696.     SWITCH S9            ; Test the entry
  697.     ;
  698.     ;    List command
  699.     ;
  700.        CASE "L"                     ; List
  701.           GOTO DIR
  702.        ENDCASE
  703.     ;
  704.     ;    Subdir command
  705.     ;
  706.        CASE "S"                     ; Chdir
  707.           GOTO CHDIR
  708.        ENDCASE
  709.     ;
  710.     ;    Pathlist command
  711.     ;
  712.        CASE "P"                     ; Pathlist
  713.           GOTO PATHLIST
  714.        ENDCASE
  715.     ;
  716.     ;    Shell command
  717.     ;
  718.        CASE "D"                     ; Shell
  719.           GOTO Shell
  720.        ENDCASE
  721.     ;
  722.     ;    Main command
  723.     ;
  724.        CASE "M"                     ; Go back to main prompt
  725.           GOTO Main_Prompt
  726.        ENDCASE
  727.     ;
  728.     ;    Exit command
  729.     ;
  730.        CASE "E"                     ; Exit
  731.           TRAN "Ok... bye"
  732.           GOTO EXIT
  733.        ENDCASE
  734.     ENDSWITCH
  735. ;
  736. ;    Invalid command
  737. ;
  738.     TRAN "^MCommand not recognized... try again^M"
  739.     GOTO Priv_Prompt
  740.  
  741. ; -----------------------------------------------------------------------
  742. ;    Privileged user: CHDIR... Query for a path.
  743. ; -----------------------------------------------------------------------
  744. ;
  745. CHDIR:
  746.     MESS "^M^JCHDIR Command "       ; Local console indicator
  747.     TRAN "^MEnter the drive:subdirectory: "
  748.  
  749.     GOSUB Read_Comm         ; Read into S9
  750.     IF FLAG(0)            ; If first flag rtns set
  751.        GOTO Exit            ; .. disconnect and start over
  752.        ENDIF            ; ..
  753.  
  754.     IF NOT NULL S9            ; If something entered
  755.        CHDIR S9            ; Do it.
  756.        SET FLAG(2) ON        ; Save the fact we've done a CHDIR
  757.        ENDIF
  758.     GOTO Priv_Prompt        ; And continue
  759.  
  760. ; -----------------------------------------------------------------------
  761. ;    Privileged user: Path tree... awkward... but it works
  762. ; -----------------------------------------------------------------------
  763. ;
  764. PATHLIST:
  765.     MESS "^M^JPathlist command "    ; Local console indicator
  766.     TRAN "^M Working..."            ; May take a moment
  767.  
  768.     DOS "TREED >\HOSTTEMP.TXT"      ; To a temp file
  769.  
  770.     TRAN "^MUse control-S to suspend, control-Q to continue^M"
  771.     SENDFILE ASCII "\HOSTTEMP.TXT"
  772.     TRAN "^M"                       ; Send a c/r
  773.  
  774.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  775.     GOTO Priv_Prompt        ; And continue
  776.  
  777. ; -----------------------------------------------------------------------
  778. ;    Privileged user: DOS SHELL... Query for a command
  779. ; -----------------------------------------------------------------------
  780. ;
  781. Shell:
  782.     MESS "^M^JDOS Command "         ; Local console indicator
  783.     TRAN "^MWarning: this command may be used to invoke ANY COMMAND that"
  784.     TRAN "^MDOS can execute.  If you load a program requiring keyboard  "
  785.     TRAN "^Mentry, you lock yourself out and leave the board unusable."
  786.     TRAN "^M^J"
  787.     TRAN "^MEnter your command: "
  788.  
  789.     GOSUB Read_Comm         ; Read into S9
  790.     IF FLAG(0)            ; If first flag rtns set
  791.        GOTO Exit            ; .. disconnect and start over
  792.        ENDIF            ; ..
  793.  
  794.     IF NULL S9            ; If nothing entered
  795.        GOTO Priv_Prompt        ; User decided better
  796.        ENDIF
  797.  
  798.     IF FIND S9 "FORMAT"             ; Disallow any format commands
  799.        TRAN "^M^JFormat commands are not allowed..."
  800.        GOTO Priv_Prompt        ; And continue
  801.        ENDIF
  802. ;
  803. ;    Perform it
  804. ;
  805.     TRAN "^M Working..."            ; May take a moment
  806.  
  807.     CONCAT S9 ">\HOSTTEMP.TXT"
  808.     DOS   S9            ; Do it.
  809.  
  810.     TRAN "^MUse control-S to suspend, control-Q to continue^M"
  811.     SENDFILE ASCII "\HOSTTEMP.TXT"
  812.     TRAN "^M"                       ; Send a c/r
  813.  
  814.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  815.     GOTO Priv_Prompt        ; And continue
  816.  
  817. ; -----------------------------------------------------------------------
  818. ;    Directory list... awkward... but it works
  819. ; -----------------------------------------------------------------------
  820. ;
  821. Dir:
  822.     MESS "^M^JDirectory command "   ; Local console indicator
  823.     TRAN "^M Working..."            ; May take a moment
  824.  
  825.     DOS "DIR >\HOSTTEMP.TXT"        ; To a temp file
  826.     TRAN "^MUse control-S to suspend, control-Q to continue^M"
  827.     SENDFILE ASCII "\HOSTTEMP.TXT"
  828.     TRAN "^M"                       ; Send a c/r
  829.  
  830.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  831.     GOTO Priv_Prompt        ; And continue
  832.  
  833. ; -----------------------------------------------------------------------
  834. ;    Files command: File list, Upload, download or back to main
  835. ;
  836. ;    Note: S19 must be retained throughout this submenu...
  837. ;          It is used to save the current subdir
  838. ; -----------------------------------------------------------------------
  839. ;
  840. File_Command:
  841.     MESS "^M^JFile prompt "         ; Local console indicator
  842.     SUBDIR S19            ; Save current subdir
  843.     CHDIR S3            ; Set to default subdir
  844. ;
  845. ;    Prompt for a command
  846. ;
  847. File_Prompt:
  848.     GOSUB Display_Limit        ; Report amount of time remaining
  849.     S9 = "^ML)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
  850.     S8 = "BBS-FiMe"                 ; Set file name
  851.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  852. ;
  853. ;    Keep just the first char entered
  854. ;
  855.     GOSUB Read_Comm         ; Read into S9
  856.     IF FLAG(0)            ; If first flag rtns set
  857.        GOTO Exit            ; .. disconnect and start over
  858.        ENDIF            ; ..
  859.  
  860.     GOSUB Left_Justify        ; Left justify S9
  861.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  862. ;
  863. ;    Interpret the command
  864. ;
  865.     SWITCH S9            ; Test the entry
  866.     ;
  867.     ;    Download command
  868.     ;
  869.        CASE "D"                     ; Download
  870.           GOTO DOWNLOAD
  871.        ENDCASE
  872.     ;
  873.     ;    Upload command
  874.     ;
  875.        CASE "U"                     ; Upload
  876.           GOTO UPLOAD
  877.        ENDCASE
  878.     ;
  879.     ;    List command
  880.     ;
  881.        CASE "L"                     ; File list
  882.           GOTO FILELIST
  883.        ENDCASE
  884.     ;
  885.     ;    Search command
  886.     ;
  887.        CASE "S"                     ; Search list
  888.           GOTO Search
  889.        ENDCASE
  890.     ;
  891.     ;    Main command
  892.     ;
  893.        CASE "M"                     ; Go back to main prompt
  894.           CHDIR S19         ; Reset subdir
  895.           GOTO Main_Prompt
  896.        ENDCASE
  897.     ;
  898.     ;    Exit command
  899.     ;
  900.        CASE "E"                     ; Exit
  901.           TRAN "Ok... bye"
  902.           GOTO EXIT
  903.        ENDCASE
  904.     ENDSWITCH
  905.  
  906.     TRAN "Invalid selection - try again^M"
  907.     GOTO FILE_Prompt
  908.  
  909. ; -----------------------------------------------------------------------
  910. ;    Subroutine: Query for a file name - return in S8
  911. ;    On exit:
  912. ;       FLAG(0) Returned ON to indicate caller disconn/timedout
  913. ; -----------------------------------------------------------------------
  914. ;
  915. File_Query:
  916.     MESS "^M^JFname query "         ; Local console indicator
  917.     TRAN "^MEnter the file name: "
  918.  
  919.     GOSUB Read_Comm         ; Read into S9
  920.     IF FLAG(0)            ; If first flag rtns set
  921.        RETURN            ; .. disconnect and start over
  922.        ENDIF            ; ..
  923.     RETURN                ; Return to caller
  924. ;
  925. ; -----------------------------------------------------------------------
  926. ;    XMODEM Upload (up from caller)
  927. ;
  928. ;    Files unqualified by drive:subdir are placed in the default
  929. ;    DLOAD subdirectory.
  930. ;
  931. ;    Note: Qualified names (containing subdir) are permitted
  932. ;          only if the privilege flag (FLAG(1)) is set.
  933. ; -----------------------------------------------------------------------
  934. ;
  935. UPLOAD:
  936.     MESS "^M^JUpload from caller "
  937.  
  938.     GOSUB File_Query        ; Ask for a file name
  939.     IF FLAG(0)            ; If first flag rtns set
  940.        GOTO EXIT            ; .. disconnect and start over
  941.        ENDIF            ; ..
  942.  
  943.     IF NULL S9            ; If no file returned
  944.        GOTO File_Prompt        ; .. start over
  945.        ENDIF            ; ..
  946.  
  947.     IF FIND S9 "\"                  ; Test for subdir in name
  948.        IF NOT FLAG(1)        ; Test for privilege
  949.           TRAN "^MQualified file names are not permitted."
  950.           GOTO UPLOAD        ; Ask again
  951.           ENDIF
  952.        ENDIF
  953.  
  954.     IF ISDLFILE S9            ; If file exists in DL subdir
  955.        TRAN "^MFile already exists"
  956.        GOTO UPLOAD            ; Ask again
  957.        ENDIF
  958. ;
  959. ;    Prompt for a method
  960. ;
  961.     MESS "^M^JUlo Method prompt "   ; Local console indicator
  962.     TRAN "^MW)xmodem, X)modem, Y)modem, or K)ermit: "
  963.  
  964.     S8 = S9             ; Save file name
  965. ;
  966. ;    Keep just the first char entered
  967. ;
  968.     GOSUB Read_Comm         ; Read into S9
  969.     IF FLAG(0)            ; If first flag rtns set
  970.        GOTO Exit            ; .. disconnect and start over
  971.        ENDIF            ; ..
  972.  
  973.     GOSUB Left_Justify        ; Left justify S9
  974.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  975. ;
  976. ;    Interpret the response
  977. ;
  978.     TIME S10 1            ; Save start of upload time
  979.     SWITCH S9            ; Test the entry
  980.        CASE "W"
  981.           TRAN "^M^JBegin your transfer procedure..."
  982.           GETFILE WXMODEM S8
  983.        ENDCASE
  984.        CASE "X"
  985.           TRAN "^M^JBegin your transfer procedure..."
  986.           GETFILE XMODEM S8
  987.        ENDCASE
  988.        CASE "Y"
  989.           TRAN "^M^JBegin your transfer procedure..."
  990.           GETFILE YMODEM S8
  991.        ENDCASE
  992.        CASE "K"
  993.           TRAN "^M^JBegin your transfer procedure..."
  994.           GETFILE KERMIT        ; FIle name supplied by caller
  995.        ENDCASE
  996.        DEFAULT
  997.           TRAN "^MInvalid transfer selection"
  998.           GOTO EOTransfer
  999.        ENDCASE
  1000.     ENDSWITCH
  1001. ;
  1002. ;    A file uploaded with subdirectory doesn't get logged
  1003. ;
  1004.     IF FIND S9 "\"                  ; Test for subdir in name
  1005.        GOTO EOTransfer        ; Skip logging it
  1006.        ENDIF
  1007. ;
  1008. ;    Convert times to numeric quantities
  1009. ;
  1010.     TIME S11 1            ; Get current time (military fmt)
  1011.     N19 = S11(0:1)*60+S11(3:4)    ; Compute current time since midnight ; Index from 0
  1012.     N18 = S10(0:1)*60+S10(3:4)    ; Time of upload since midnight       ; Index from 0
  1013. ;
  1014. ;    Compute the time remaining and add it to the max
  1015. ;
  1016.     IF GT N18 N19            ; If timeout on the RGET
  1017.        N19 = N19+1440        ; Allow wrap accross midnight
  1018.        ENDIF
  1019.     N0 = N0+(N19-N18)        ; Compute time to upload and add it in
  1020. ;
  1021. ;    At this point, ask for a description for the file
  1022. ;
  1023. Describe:
  1024.     TRAN "^M^JDescription: "        ; Prompt
  1025.     GOSUB Read_Comm         ; Read response
  1026.     IF FLAG(0)            ; If disconnect
  1027.        GOTO Exit            ; Exit
  1028.        ENDIF
  1029.  
  1030.     IF NULL S9            ; If nothing entered
  1031.        TRAN "^M^JPlease leave something of a description"
  1032.        GOTO Describe        ; Try again
  1033.        ENDIF
  1034. ;
  1035. ;    Open the file list, and append the file
  1036. ;
  1037.     FOPENO "BBS-File"  TEXT APPEND  ; Open the file to append
  1038.     IF NOT SUCCESS            ; If error
  1039.        GOTO EOTransfer        ; Exit
  1040.        ENDIF
  1041.  
  1042.     DATE S0             ; Get the current date
  1043.     S8 = S8 & "            "        ; Ensure blank padding
  1044.     FSIZE S11 S8            ; Get file size using fname
  1045.     S10 = S8(0:12) * S0(0:7) * S11(0:6) * S9         ; Index from 0
  1046.     LENGTH S10 N19            ; Get true length
  1047.     WRITE S10 N19            ; Write the file name
  1048.     WRITE "!" 1                     ; Write a delimiter
  1049.  
  1050.     FCLOSEO             ; Close the output file
  1051.     GOTO EOTransfer         ; Report success/failure
  1052.  
  1053. ; -----------------------------------------------------------------------
  1054. ;    XMODEM Download (down to caller)
  1055. ;
  1056. ;    Download occurs from the default drive:subdir unless explicitly
  1057. ;    qualified.
  1058. ;
  1059. ;    Note: Qualified names (containing subdir) are permitted
  1060. ;          only if the privilege flag (FLAG(1)) is set.
  1061. ; -----------------------------------------------------------------------
  1062. ;
  1063. DOWNLOAD:
  1064.     MESS "^M^JDownload to caller "
  1065.  
  1066.     GOSUB File_Query        ; Ask for a file name
  1067.     IF FLAG(0)            ; If first flag rtns set
  1068.        GOTO EXIT            ; .. disconnect and start over
  1069.        ENDIF            ; ..
  1070.  
  1071.     IF NULL S9            ; If no file returned,
  1072.        GOTO File_Prompt        ; .. start over
  1073.        ENDIF            ; ..
  1074.  
  1075.     IF FIND S9 "\"                  ; Test for subdir
  1076.        IF NOT FLAG(1)        ; Test for privilege
  1077.           TRAN "^MQualified file names are not permitted."
  1078.           GOTO DOWNLOAD        ; Ask again
  1079.           ENDIF
  1080.        ENDIF
  1081.  
  1082.     ISFILE S9            ; Test for file already
  1083.     IF NOT ISFILE S9        ; If file doesn't exist
  1084.        TRAN "^MFile doesn't exist"
  1085.        GOTO DOWNLOAD        ; Ask again
  1086.        ENDIF
  1087. ;
  1088. ;    Prompt for a method
  1089. ;
  1090.     MESS "^M^JDlo Method prompt "
  1091.     TRAN "^MW)xmodem, X)modem, Y)modem, K)ermit, or A)scii: "
  1092.  
  1093.     S8 = S9             ; Save file name
  1094. ;
  1095. ;    Keep just the first char entered
  1096. ;
  1097.     GOSUB Read_Comm         ; Read into S9
  1098.     IF FLAG(0)            ; If first flag rtns set
  1099.        GOTO Exit            ; .. disconnect and start over
  1100.        ENDIF            ; ..
  1101.  
  1102.     GOSUB Left_Justify        ; Left justify S9
  1103.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  1104. ;
  1105. ;    Interpret the response
  1106. ;
  1107.     SWITCH S9            ; Test the entry
  1108.        CASE "A"
  1109.           SENDFILE ASCII S8
  1110.        ENDCASE
  1111.        CASE "W"
  1112.           TRAN "^M^JBegin your transfer procedure..."
  1113.           SENDFILE WXMODEM S8
  1114.        ENDCASE
  1115.        CASE "X"
  1116.           TRAN "^M^JBegin your transfer procedure..."
  1117.           SENDFILE XMODEM S8
  1118.        ENDCASE
  1119.        CASE "Y"
  1120.           TRAN "^M^JBegin your transfer procedure..."
  1121.           SENDFILE YMODEM S8
  1122.        ENDCASE
  1123.        CASE "K"
  1124.           TRAN "^M^JBegin your transfer procedure..."
  1125.           SENDFILE KERMIT S8
  1126.        ENDCASE
  1127.        DEFAULT
  1128.           TRAN "^MInvalid transfer selection"
  1129.           GOTO EOTransfer
  1130.        ENDCASE
  1131.     ENDSWITCH
  1132.  
  1133.     GOTO EOTransfer         ; Report success/failure
  1134. ;
  1135. ;    End of transfer... note result on local console
  1136. ;
  1137. EOTRANSFER:
  1138.     IF NOT SUCCESS
  1139.        MESS "^M^JTransfer failed "
  1140.     ELSE
  1141.        MESS "^M^JTransfer OK "
  1142.        ENDIF
  1143.     GOTO File_Prompt
  1144.  
  1145. ; -----------------------------------------------------------------------
  1146. ;    List command - list file directories
  1147. ; -----------------------------------------------------------------------
  1148. ;
  1149. Filelist:
  1150.     N10 = 0             ; Initialize counter (# records)
  1151.  
  1152.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1153.     IF NOT SUCCESS            ; IF error opening
  1154.        TRAN "^MNo files are available at this time^M"
  1155.        GOTO Main_Prompt        ; And go back to mainline
  1156.        ENDIF
  1157.  
  1158. FListLoop:
  1159.     READ S9 80 N19            ; Read a record
  1160.     IF EOF                ; Test for end of file
  1161.        GOTO FListEnd        ; Report count found
  1162.        ENDIF
  1163. ;
  1164. ;    With the exception of comments, test for file availability
  1165. ;
  1166.     IF NOT FIND S9(0:0) "*"         ; Always print comments  ; Index from 0
  1167.        S0 = S9(0:12)        ; Extract File name     ; Index from 0
  1168.        ISFILE S0
  1169.        IF FAILURE            ; If file dosn't exist
  1170.           GOTO FListLoop        ; Count it
  1171.           ENDIF
  1172.     ELSE
  1173.        GOTO FListPrint        ; Print comments simply
  1174.        ENDIF
  1175. ;
  1176. ;    If nothing has been displayed yet, do a heading
  1177. ;
  1178.     IF ZERO N10            ; If no recs displayed yet
  1179.        TRAN "^M^JName        Dated    Size     Description ^M^J"
  1180.        TRAN  "----------- -------- -------- ----------------------------------------------^M^J"
  1181.        ENDIF
  1182. ;
  1183. ;    Format the record for printing
  1184. ;
  1185.     S9 = S9(0:12) * " " * S9(13:19) * " " * S9(21:27) * " " * S9(28:79) ; Index from 0
  1186. ;
  1187. ;    And display the record
  1188. ;
  1189. FListPrint:
  1190.     TRAN S9             ; Display the record
  1191.     TRAN "^M^J"                     ; And a cr/lf
  1192.     N10 = N10+1            ; COunt this one
  1193.     GOTO FListLoop            ; Loop until EOF
  1194. ;
  1195. ;    End of loop
  1196. ;
  1197. FListEnd:
  1198.     FCLOSEI             ; CLOSE the keys file
  1199.     GOTO File_Prompt        ; And loop until EOF
  1200.  
  1201. ; -----------------------------------------------------------------------
  1202. ;    Search command - search file directory
  1203. ; -----------------------------------------------------------------------
  1204. ;
  1205. Search:
  1206.     TRAN "^M^JEnter the search string: "
  1207.     GOSUB Read_Comm         ; Read response
  1208.     IF FLAG(0)
  1209.        GOTO Exit            ; And continue
  1210.        ENDIF
  1211.  
  1212.     IF NULL S9            ; If blank response
  1213.        TRAN "^M^JSearch aborted"    ; Indicate no action
  1214.        GOTO File_Prompt        ; And back to submenu
  1215.        ENDIF
  1216.     S18 = S9            ; Save search string
  1217. ;
  1218. ;    Open the directory for searching
  1219. ;
  1220.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1221.     IF NOT SUCCESS            ; IF error opening
  1222.        TRAN "^MNo files are available at this time^M"
  1223.        GOTO Main_Prompt        ; And go back to mainline
  1224.        ENDIF
  1225.     N10 = 0             ; Initialize counter (# records)
  1226. ;
  1227. ;    Read a record
  1228. ;
  1229. Search_Loop:
  1230.     READ S9 80 N19            ; Read a record
  1231.     IF EOF                ; Test for end of file
  1232.        GOTO Search_End        ; Skip if EOF
  1233.        ENDIF
  1234. ;
  1235. ;    With the exception of comments, test for file availability
  1236. ;
  1237.     IF NOT FIND S9(0:0) "*"         ; Always print comments  ; Index from 0
  1238.        S0 = S9(0:12)        ; Extract File name     ; Index from 0
  1239.        ISFILE S0
  1240.        IF FAILURE            ; If file dosn't exist
  1241.           GOTO Search_Loop        ; Skip it
  1242.           ENDIF
  1243.     ELSE
  1244.        GOTO Search_Loop        ; Skip comments
  1245.        ENDIF
  1246.  
  1247.     IF NOT FIND S9 S18        ; If string isn't in record
  1248.        GOTO Search_Loop        ; Skip record
  1249.        ENDIF
  1250. ;
  1251. ;    If nothing has been displayed yet, do a heading
  1252. ;
  1253.     IF ZERO N10            ; If no recs displayed yet
  1254.        TRAN "^M^JName        Dated    Size     Description ^M^J"
  1255.        TRAN  "----------- -------- -------- ----------------------------------------------^M^J"
  1256.        ENDIF
  1257. ;
  1258. ;    Format the record for printing
  1259. ;
  1260.     S0 = S9(0:12) * " " * S9(13:19) * " " * S9(21:27) * " " * S9(28:79) ; Index from 0
  1261.     TRAN S0             ; Display the record
  1262.     TRAN "^M^J"                     ; And a cr/lf
  1263.     N10 = N10+1            ; COunt this one
  1264.     GOTO Search_Loop        ; Loop until EOF
  1265. ;
  1266. ;    End of loop
  1267. ;
  1268. Search_End:
  1269.     IF ZERO N10            ; If nothing found...
  1270.        TRAN "^M^JNo matches"        ; Indicate it
  1271.        ENDIF
  1272.  
  1273.     FCLOSEI             ; CLOSE the keys file
  1274.     GOTO File_Prompt        ; And loop until EOF
  1275.  
  1276. ; -----------------------------------------------------------------------
  1277. ;    Leave a comment (branched to - "Main_Prompt")
  1278. ;
  1279. ;    This routine executes out of the defined BBS subdir, no matter
  1280. ;    what subdir a privileged user has selected.  It saves the current
  1281. ;    subdir and restores it upon completion.
  1282. ;
  1283. ;    Note: S19 must be retained throughout this submenu...
  1284. ;          It is used to save the current subdir
  1285. ; -----------------------------------------------------------------------
  1286. ;
  1287. Comment:
  1288.     SUBDIR S19            ; Save current subdir
  1289.     CHDIR S2            ; Reset current subdir
  1290.  
  1291.     MESS "^M^JComment requested "
  1292.     S9 = "Do you wish to leave a comment? "
  1293.     S8 = "BBS-NoMe"                 ; Set file name
  1294.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1295.  
  1296.     GOSUB Read_Comm         ; Read a response
  1297.     IF FLAG(0)            ; If error
  1298.        GOTO Exit            ; And continue
  1299.        ENDIF
  1300.  
  1301.     FIND S9 "Y"                     ; Look for "Y"
  1302.     IF NOT FOUND            ; IF answer wan't 'Y'
  1303.        TRAN "OK"                    ; Odd character
  1304.        CHDIR S19            ; Reset default subdir
  1305.        GOTO Main_Prompt        ; We're done.
  1306.        ENDIF
  1307. ;
  1308. ;    Open the comments file
  1309. ;
  1310.     FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
  1311.     IF NOT SUCCESS            ; if open failed
  1312.        TRAN "Error recording note - please try later^M^J"
  1313.        CHDIR S19            ; Reset default subdir
  1314.        GOTO Main_Prompt        ; GOTO Main_Prompt to caller
  1315.        ENDIF
  1316.  
  1317.     S9 = "*** Note left by "
  1318.     CONCAT S9(17) S1        ; Add User ID         ; Index from 0
  1319.     DATE S8
  1320.     CONCAT S9(25) S8(0:9)        ; Add date         ; Index from 0
  1321.     TIME S8 1            ; (military fmt)
  1322.     CONCAT S9(35) S8(0:7)        ; Add time         ; Index from 0
  1323.     WRITE S9 80            ; Write header to file     * COM-AND
  1324.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  1325. ;
  1326. ;    Ask for lines, and write them to the output file
  1327. ;
  1328.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  1329.     TRAN "Enter a line/line(s) of text.  A blank line ends the note.^M^J"
  1330.     GOSUB Copy_Text
  1331. ;
  1332. ;    We have a blank line - and the end of a note
  1333. ;
  1334.     FCLOSEO             ; CLose the file
  1335.     IF FLAG(0)            ; If disconnect
  1336.        GOTO Exit            ; Hangup
  1337.        ENDIF
  1338.     TRAN "Your note has been recorded - thanks^M^J"
  1339.  
  1340.     CHDIR S19            ; Reset default subdir
  1341.     GOTO Main_Prompt        ; GO for next cmd
  1342.  
  1343. ; -----------------------------------------------------------------------
  1344. ;    Bulletin command: List, and read a specific item
  1345. ;
  1346. ;    The BBS-BULL file is structured:
  1347. ;    0      5        13 14     26
  1348. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1349. ;    ! Number  ! Date    !  ! Fname     ! Subject (40 char)!
  1350. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1351. ;                 ^ Privileged user bulletin flag
  1352. ;
  1353. ;    Note: S19 must be retained throughout this submenu...
  1354. ;          It is used to save the current subdir
  1355. ; -----------------------------------------------------------------------
  1356. ;
  1357. Bull_Command:
  1358.     SUBDIR S19            ; Save current subdir
  1359.     CHDIR S5            ; Switch to Bulletins subdir
  1360. ;
  1361. ;    Restart (perform a list command) at this point
  1362. ;
  1363. BULL_List:
  1364.     MESS "^M^JBulletin list "       ; Local console indicator
  1365.     N10 = 0             ; Initialize a counter
  1366.  
  1367.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1368.     IF NOT SUCCESS            ; IF error opening
  1369.        TRAN "^MNo bulletins exist^M"
  1370.        CHDIR S19            ; Return to default subdir
  1371.        GOTO Main_Prompt        ; And go back to mainline
  1372.        ENDIF
  1373. ;
  1374. ;    Read a record
  1375. ;
  1376. Bull_Loop:
  1377.     READ S9 80 N19            ; Read a record
  1378.     IF EOF                ; Test for end of file
  1379.        GOTO Bull_Prompt        ; Select one specific
  1380.        ENDIF
  1381.  
  1382.     IF NOT NULL S9(13:13)        ; Test privilege flag     ; Index from 0
  1383.        IF NOT FLAG(1)        ; Only display if privileged user
  1384.           GOTO BULL_Loop        ; SKip if flag set and unprivileged user
  1385.           ENDIF
  1386.        ENDIF
  1387. ;
  1388. ;    With the exception of comments, test for file availability
  1389. ;
  1390.     IF FIND S9(0:0) "*"             ; Skip comments          ; Index from 0
  1391.        GOTO Bull_Loop        ; Throw away comments
  1392.        ENDIF
  1393.  
  1394.     S0 = S9(14:25)            ; Extract File name     ; Index from 0
  1395.     ISFILE S0
  1396.     IF FAILURE            ; If file dosn't exist
  1397.        GOTO Bull_Loop        ; Count it
  1398.        ENDIF
  1399. ;
  1400. ;    If nothing has been displayed yet, do a heading
  1401. ;
  1402.     IF ZERO N10            ; If no recs displayed yet
  1403.        TRAN "^M^JNum   Dated    Subject     ^M^J"
  1404.        TRAN  "----- -------- --------------------------------------------------------------^M^J"
  1405.        ENDIF
  1406. ;
  1407. ;    And display the record
  1408. ;
  1409.     S0 = S9(0:4)*" "*S9(5:12)*" "*S9(26:79)                  ; Index from 0
  1410.     TRAN S0             ; Display the record
  1411.     TRAN "^M^J"                     ; And a cr/lf
  1412.     N10 = N10+1            ; COunt this one
  1413.     GOTO Bull_Loop            ; Loop until EOF
  1414. ;
  1415. ;    End of loop prompt for a bulletin number
  1416. ;
  1417. Bull_Prompt:
  1418.     FCLOSEI             ; CLose the input file
  1419.  
  1420.     GOSUB Display_Limit        ; Report amount of time remaining
  1421.     S9 = "^ML)ist, M)ain, E)xit, or a bulletin number: "
  1422.     S8 = "BBS-BuMe"                 ; Set file name
  1423.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1424. ;
  1425. ;    Read a response
  1426. ;
  1427.     GOSUB Read_Comm         ; Read into S9
  1428.     IF FLAG(0)            ; If first flag rtns set
  1429.        GOTO Exit            ; .. disconnect and start over
  1430.        ENDIF            ; ..
  1431. ;
  1432. ;    Test for alpha commands
  1433. ;
  1434.     GOSUB Left_Justify        ; Left justify S9
  1435.     IF FIND S9(0:0) "L"             ; If command was List    ; Index from 0
  1436.        GOTO Bull_List        ; Perform the list again
  1437.        ENDIF
  1438.  
  1439.     IF FIND S9(0:0) "M"             ; If command was Main    ; Index from 0
  1440.        CHDIR S19            ; Return to default subdir
  1441.        GOTO Main_Prompt        ; Go back to main
  1442.        ENDIF
  1443.  
  1444.     IF FIND S9(0:0) "E"             ; If command was Exit    ; Index from 0
  1445.        TRAN "Ok... bye"
  1446.        GOTO Exit            ; Exit
  1447.        ENDIF
  1448. ;
  1449. ;    We're going to scan the keys file for the input
  1450. ;
  1451.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1452.     IF NOT SUCCESS            ; IF error opening
  1453.        TRAN "^MNo bulletins available^M"
  1454.        CHDIR S19            ; Return to default subdir
  1455.        GOTO Main_Prompt        ; And go back to mainline
  1456.        ENDIF
  1457.     S0 = S9             ; Save response in S0
  1458.  
  1459. Bull_Scan:
  1460.     READ S9 80 N19            ; Read a record
  1461.     IF EOF                ; Test for end of file
  1462.        TRAN "^M^JNo such bulletin!! ^M^J"
  1463.        FCLOSEI            ; CLose input file
  1464.        GOTO Bull_Prompt        ; Select one specific
  1465.        ENDIF
  1466.  
  1467.     IF FIND S9(0:0) "*"             ; Throw away comments    ; Index from 0
  1468.        GOTO Bull_Scan        ; ..
  1469.        ENDIF
  1470.  
  1471.     IF NOT NULL S9(13:13)        ; Test privilege flag     ; Index from 0
  1472.        IF NOT FLAG(1)        ; Only display if privileged user
  1473.           GOTO BULL_Scan        ; SKip if flag set and unprivileged user
  1474.           ENDIF
  1475.        ENDIF
  1476. ;
  1477. ;    Test for file availability
  1478. ;
  1479.     S8 = S9(14:25)            ; Extract File name     ; Index from 0
  1480.     ISFILE S8
  1481.     IF FAILURE            ; If file dosn't exist
  1482.        GOTO Bull_Scan        ; Count it
  1483.        ENDIF
  1484. ;
  1485. ;    Test the record number field against the given
  1486. ;
  1487.     S9 = S9(0:4)            ; Extract just the number ; Index from 0
  1488.     GOSUB Left_Justify        ; Left justify the field in S9
  1489.     SWITCH S9            ; Test using the given #
  1490.        CASE S0(0:4)         ; .. against the rec number field ; Index from 0
  1491.           GOTO Bull_Read        ; Match - go read it
  1492.        ENDCASE
  1493.     ENDSWITCH
  1494.     GOTO Bull_Scan            ; Loop until EOF
  1495. ;
  1496. ;    Read a single bulletin - the name is in S8
  1497. ;
  1498. Bull_Read:
  1499.     FCLOSEI             ; Close the mail keys file
  1500.     MESS "^M^JReading bulletin "    ; Local console indicator
  1501.  
  1502.     S9 = "^MError opening Bltnfile" ; Error msg just in case
  1503.     GOSUB Disp_File         ; Display the file
  1504.     GOTO Bull_Prompt        ; And loop until EOF
  1505.  
  1506. ; -----------------------------------------------------------------------
  1507. ;    Mail command: Read, write or back to main
  1508. ;
  1509. ;    Note: S19 must be retained throughout this submenu...
  1510. ;          It is used to save the current subdir
  1511. ; -----------------------------------------------------------------------
  1512. ;
  1513. Mail_Command:
  1514.     MESS "^M^JMail prompt "         ; Local console indicator
  1515.     SUBDIR S19            ; Save current default
  1516.     CHDIR S4            ; Set to Messages subdir
  1517. ;
  1518. ;    Prompt for a submenu command
  1519. ;
  1520. Mail_Prompt:
  1521.  
  1522.     GOSUB Display_Limit        ; Report amount of time remaining
  1523.     S9 = "^MS)can, L)ist, R)ead, W)rite, M)ain or E)xit: "
  1524.     S8 = "BBS-MeMe"                 ; Set file name
  1525.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1526. ;
  1527. ;    Keep just the first char entered
  1528. ;
  1529.     GOSUB Read_Comm         ; Read into S9
  1530.     IF FLAG(0)            ; If first flag rtns set
  1531.        GOTO Exit            ; .. disconnect and start over
  1532.        ENDIF            ; ..
  1533.  
  1534.     GOSUB Left_Justify        ; Left justify S9
  1535.     S9 = S9(0:0)            ; Keep just the first char ; Index from 0
  1536. ;
  1537. ;    Interpret the command
  1538. ;
  1539.     SWITCH S9            ; Test the entry
  1540.     ;
  1541.     ;    Read command
  1542.     ;
  1543.        CASE "R"                     ; Read
  1544.           GOTO Read_Msg
  1545.        ENDCASE
  1546.     ;
  1547.     ;    Write command
  1548.     ;
  1549.        CASE "W"                     ; Write
  1550.           GOTO Write_msg
  1551.        ENDCASE
  1552.     ;
  1553.     ;    Scan command
  1554.     ;
  1555.        CASE "S"                     ; Scan
  1556.           GOTO Scan_Msg
  1557.        ENDCASE
  1558.     ;
  1559.     ;    List command
  1560.     ;
  1561.        CASE "L"                     ; Scan
  1562.           GOTO List_Msg
  1563.        ENDCASE
  1564.     ;
  1565.     ;    Main command
  1566.     ;
  1567.        CASE "M"                     ; Go back to main prompt
  1568.           CHDIR S19         ; Reset subdir
  1569.           GOTO Main_Prompt
  1570.        ENDCASE
  1571.     ;
  1572.     ;    Exit command
  1573.     ;
  1574.        CASE "E"                     ; Exit
  1575.           TRAN "Ok... bye"
  1576.           GOTO Exit
  1577.        ENDCASE
  1578.     ENDSWITCH
  1579.  
  1580.     TRAN "Invalid selection - try again^M"
  1581.     GOTO Mail_Prompt
  1582.  
  1583. ; -----------------------------------------------------------------------
  1584. ;    Scan command: Scan for files 'to' the current user
  1585. ;
  1586. ;    The MAILKEY file is structured:
  1587. ;    0      8        16 17     25       38
  1588. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1589. ;    ! To ID   ! From ID !  ! Date     ! Fname   ! Subject (40 char)!
  1590. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1591. ;                 ^Privacy flag = P
  1592. ; -----------------------------------------------------------------------
  1593. ;
  1594. Scan_Msg:
  1595.     N10 = 0             ; Initialize counter (# records)
  1596.     N11 = 0             ; Initialize counter (# to current ID)
  1597.  
  1598.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1599.     IF NOT SUCCESS            ; IF error opening
  1600.        GOTO Scan_Rpt        ; Use the zero count
  1601.        ENDIF
  1602.  
  1603.     TRAN "^M Working "              ; May take a moment
  1604.  
  1605. Scan_Loop:
  1606.     READ S9 80 N19            ; Read a record
  1607.     IF EOF                ; Test for end of file
  1608.        GOTO Scan_Rpt        ; Report count found
  1609.        ENDIF
  1610.  
  1611.     S0 = S9(0:7)            ; Look at 'to ID' field  ; Index from 0
  1612.     SWITCH S0            ; Test for our ID
  1613.        CASE S1            ; .. in the record
  1614.           S0 = S9(25:37)        ; Extract File name     ; Index from 0
  1615.           ISFILE S0
  1616.           IF SUCCESS        ; If file exists
  1617.          INC N11        ; Count it
  1618.          ENDIF
  1619.        ENDCASE
  1620.     ENDSWITCH
  1621.  
  1622.     INC N10             ; Count the read
  1623.     N12 = N10/10*10         ; Every 10th record
  1624.     IF EQ N10 N12            ; .. or so
  1625.        TRAN "."                     ; .. indicate we didn't die
  1626.        ENDIF
  1627.     GOTO Scan_Loop            ; Loop until EOF
  1628. ;
  1629. ;    Report the count found
  1630. ;
  1631. Scan_Rpt:
  1632.     IF ZERO N11            ; If no files found
  1633.        TRAN "^MYou have no messages waiting"
  1634.     ELSE
  1635.        STRFMT S0 "^MYou have %d message(s) waiting." N11
  1636.        TRAN S0            ; Transmit the text
  1637.        ENDIF
  1638.  
  1639.     FCLOSEI             ; CLOSE the keys file
  1640.     GOTO Mail_Prompt        ; And loop until EOF
  1641.  
  1642. ; -----------------------------------------------------------------------
  1643. ;    Mail List command: List files available to be read.
  1644. ;
  1645. ; -----------------------------------------------------------------------
  1646. ;
  1647. List_Msg:
  1648.     N10 = 0             ; Initialize counter (# records)
  1649.  
  1650.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1651.     IF NOT SUCCESS            ; IF error opening
  1652.        TRAN "^MNo mail exists - why not write something?^M"
  1653.        GOTO Mail_Prompt        ; And go back to mainline
  1654.        ENDIF
  1655.  
  1656. List_Loop:
  1657.     READ S9 80 N19            ; Read a record
  1658.     IF EOF                ; Test for end of file
  1659.        GOTO List_End        ; Report count found
  1660.        ENDIF
  1661.  
  1662.     S0 = S9(0:7)            ; Look at 'to ID' field  ; Index from 0
  1663.     SWITCH S0            ; Test for our ID
  1664.        CASE S1            ; .. in the record
  1665.        ENDCASE
  1666.        DEFAULT            ; If not our ID, test privacy
  1667.           IF FIND S9(16:16) "P"     ; Test privacy flag      ; Index from 0
  1668.          GOTO List_Loop     ; Ignore private messages
  1669.          ENDIF
  1670.        ENDCASE
  1671.     ENDSWITCH
  1672.  
  1673.     S0 = S9(25:37)            ; Extract File name     ; Index from 0
  1674.     ISFILE S0
  1675.     IF FAILURE            ; If file dosn't exist
  1676.        GOTO List_Loop        ; Count it
  1677.        ENDIF
  1678. ;
  1679. ;    If nothing has been displayed yet, do a heading
  1680. ;
  1681.     IF ZERO N10            ; If no recs displayed yet
  1682.        TRAN "^M^JTo       From     Date     Subject^M^J"
  1683.        TRAN  "-------- -------- -------- --------------------------------------------------------------^M^J"
  1684.        ENDIF
  1685. ;
  1686. ;    And display the record
  1687. ;
  1688.     S0 = S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)    ; Index from 0
  1689.     TRAN S0             ; Display the record
  1690.     TRAN "^M^J"                     ; And a cr/lf
  1691.     N10 = N10+1            ; COunt this one
  1692.     GOTO List_Loop            ; Loop until EOF
  1693. ;
  1694. ;    End of loop
  1695. ;
  1696. List_End:
  1697.     FCLOSEI             ; CLOSE the keys file
  1698.     GOTO Mail_Prompt        ; And loop until EOF
  1699.  
  1700. ; -----------------------------------------------------------------------
  1701. ;    Read command: Read mail files 'to' the current user
  1702. ; -----------------------------------------------------------------------
  1703. ;
  1704. Read_Msg:
  1705.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1706.     IF NOT SUCCESS            ; IF error opening
  1707.        TRAN "^MNo mail exists - why not write something?^M"
  1708.        GOTO Mail_Prompt        ; And continue
  1709.        ENDIF
  1710.  
  1711. Read_Loop:
  1712.     READ S9 80 N19            ; Read a record
  1713.     IF EOF                ; Test for end of file
  1714.        GOTO Read_End        ; exit on End file
  1715.        ENDIF
  1716.  
  1717.     S0 = S9(0:7)            ; Look at 'to ID' field  ; Index from 0
  1718.     SWITCH S0            ; Test for our ID
  1719.     ;
  1720.     ;    Test for mail to current caller
  1721.     ;
  1722.        CASE S1            ; .. in the record
  1723.           SET FLAG(9) ON        ; Flag for delete
  1724.        ENDCASE
  1725.     ;
  1726.     ;    Not to current caller - test sender/privacy
  1727.     ;
  1728.        DEFAULT            ; If not our ID, test privacy
  1729.           SET FLAG(9) OFF        ; Flag no delete
  1730.           IF FIND S9(16:16) "P"     ; .. for privacy flag    ; Index from 0
  1731.          IF STRCMP S9(8:15) S1    ; If we wrote it     ; Index from 0
  1732.             SET FLAG(9) ON    ; Allow sender to read msgs sent
  1733.          ELSE            ; We didn't write it
  1734.             GOTO Read_Loop    ; So.. ignore private messages
  1735.             ENDIF
  1736.          ENDIF
  1737.        ENDCASE
  1738.     ENDSWITCH
  1739.  
  1740.     S0 = S9(25:37)            ; Extract File name     ; Index from 0
  1741.     ISFILE S0
  1742.     IF FAILURE            ; If file dosn't exist
  1743.        GOTO Read_Loop        ; Count it
  1744.        ENDIF
  1745. ;
  1746. ;    Test if we wrote this notice... if so, allow delete too
  1747. ;
  1748.     S8 = S1             ; Extract ID
  1749.     SWITCH S8            ; Using our ID
  1750.        CASE S9(8:15)        ; Test the from-ID field ; Index from 0
  1751.           SET FLAG(9) ON        ; Allow deletion of our own msgs
  1752.        ENDCASE
  1753.     ENDSWITCH
  1754. ;
  1755. ;    Display the current file
  1756. ;
  1757.     S8 = S0             ; Set-up file name
  1758.     S9 = "^MError opening mailfile"
  1759.     GOSUB Disp_File         ; Display the file
  1760. ;
  1761. ;    Ask if the file is to be deleted
  1762. ;
  1763.     IF FLAG(9)            ; If it was ours
  1764.        TRAN "^M^MDelete? (Y/N):  ^H"; Ask if its to be deleted
  1765.        GOSUB Read_Comm        ; Read a response
  1766.        IF FLAG(0)            ; If error
  1767.           GOTO Exit         ; And continue
  1768.           ENDIF
  1769.        IF FIND S9 "Y"               ; Test for "Y"
  1770.           DELETE S8         ; Delete file named in S8
  1771.           TRAN "Message deleted^M^J"; Indicate its done
  1772.           ENDIF
  1773.        ENDIF
  1774. ;
  1775. ;    Ask for the next command
  1776. ;
  1777.     TRAN "^M^MContinue (CR/Y/N):  ^H"
  1778.     GOSUB Read_Comm         ; Read a response
  1779.     IF FLAG(0)            ; If error
  1780.        GOTO Exit            ; And continue
  1781.        ENDIF
  1782.  
  1783.     IF NOT FIND S9 "N"              ; Test for "N"
  1784.        GOTO Read_Loop        ; And continue looping
  1785.        ENDIF
  1786. ;
  1787. ;    End of read... close input file, and we're done
  1788. ;
  1789. Read_End:
  1790.     FCLOSEI             ; Close the mail keys file
  1791.     GOTO Mail_Prompt        ; And loop until EOF
  1792.  
  1793. ; -----------------------------------------------------------------------
  1794. ;    Write command - write mail
  1795. ; -----------------------------------------------------------------------
  1796. ;
  1797. Write_Msg:
  1798.     TRAN "To:  ^H"                  ; Prompt for ID
  1799.     GOSUB Read_Comm         ; Read a response
  1800.     IF FLAG(0)            ; If error
  1801.        GOTO Exit            ; And continue
  1802.        ENDIF
  1803.  
  1804.     GOSUB Left_Justify        ; Left justify ID
  1805.     IF NULL S9            ; If blank entry
  1806.        GOTO Mail_Prompt        ; Skip it
  1807.        ENDIF
  1808.     S10 = S9(0:7)            ; Save TO ID         ; Index from 0
  1809.     UPPER S10            ; Force it upper case
  1810. ;
  1811. ;    Prompt for a subject
  1812. ;
  1813.     TRAN "Subject:  ^H"             ; Prompt for subject
  1814.     GOSUB Read_Comm         ; Read a response
  1815.     IF FLAG(0)            ; If error
  1816.        GOTO Exit            ; And continue
  1817.        ENDIF
  1818.     S11 = S9            ; Save returned subject
  1819. ;
  1820. ;    Open a temporary file
  1821. ;
  1822.     FOPENO "\HOSTTEMP.TXT" TEXT     ; OPEN file for output
  1823.     IF NOT SUCCESS            ; if open failed
  1824.        TRAN "Error opening file - please try later^M^J"
  1825.        GOTO Mail_Prompt        ; Back to submenu
  1826.        ENDIF
  1827. ;
  1828. ;    Place a header
  1829. ;
  1830.     S9 = "To:    "                  ; Set Sender ID
  1831.     CONCAT S9(7) S10        ; ..             ; Index from 0
  1832.     WRITE S9 20            ; Write header to file     * COM-AND
  1833.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  1834.  
  1835.     S9 = "From: "                   ; Set Sender ID
  1836.     CONCAT S9(7) S1         ; ..             ; Index from 0
  1837.     WRITE S9 20            ; Write header to file     * COM-AND
  1838.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  1839.  
  1840.     S9 = "Date: "                   ; Set date and time
  1841.     DATE S12
  1842.     CONCAT S9(7) S12        ; Add date         ; Index from 0
  1843.     TIME S8 1            ; (military fmt)
  1844.     CONCAT S9(17) S8        ; Add time         ; Index from 0
  1845.     WRITE S9 30            ; Write header to file     * COM-AND
  1846.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  1847.  
  1848.     S9 = "Subject: "                ; Set subject
  1849.     CONCAT S9(9)  S11        ; ..             ; Index from 0
  1850.     LENGTH S9 N19            ; Get actual length
  1851.     WRITE S9 N19            ; Write header to file     * COM-AND
  1852.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  1853.     WRITE "!" 1                     ; Write a text delim     * COM-AND
  1854. ;
  1855. ;    Ask for lines, and write them to the output file
  1856. ;
  1857.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  1858.     TRAN "Enter a line/line(s) of text.  A blank line ends the text.^M^J"
  1859.     GOSUB Copy_Text
  1860.     FCLOSEO             ; Close the file
  1861.  
  1862.     IF FLAG(0)            ; If disconnect during copy_text
  1863.        GOTO Exit            ; Hangup w/o saving
  1864.        ENDIF
  1865. ;
  1866. ;    Ask if the file is to be saved
  1867. ;
  1868.     TRAN "Save? (Y/N):  ^H"         ; Ask if its to be saved
  1869.     GOSUB Read_Comm         ; Read a response
  1870.     IF FLAG(0)            ; If error
  1871.        GOTO Exit            ; And continue
  1872.        ENDIF
  1873.  
  1874.     IF NOT FIND S9 "Y"              ; Test for "Y"
  1875.        GOTO Mail_Prompt        ; Throw it away
  1876.        ENDIF
  1877. ;
  1878. ;    Now - scan for the last used file name
  1879. ;
  1880.     TRAN "^MScanning for free slot"
  1881.     N10 = 0             ; Set default extension we'll use
  1882.     S0 = S10(0:7)            ; Look at 'to ID' field  ; Index from 0
  1883.  
  1884.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1885.     IF NOT SUCCESS            ; IF error opening
  1886.        GOTO Write_End        ; Create the file below
  1887.        ENDIF
  1888.  
  1889. Write_Loop:
  1890.     READ S9 80 N19            ; Read a record
  1891.     IF EOF                ; Test for end of file
  1892.        GOTO Write_End        ; Go put away the file
  1893.        ENDIF
  1894.  
  1895.     SWITCH S0            ; Test for the ID
  1896.        CASE S9(0:7)         ; .. in the to-field of the record ; Index from 0
  1897.           FIND S9(25:37) "." N11    ; Find the "." delimiter           ; Index from 0
  1898.           N11 = N11+26        ; Point to decimal extension       ; Index from 0
  1899.           ATOI S9(N11:79) N10    ; Get extension #           ; Index from 0
  1900.        ENDCASE
  1901.     ENDSWITCH
  1902.     GOTO Write_Loop         ; Loop
  1903. ;
  1904. ;    We have found the first free file name
  1905. ;
  1906. Write_End:
  1907.     FCLOSEI             ; CLose the input file
  1908.  
  1909.     TRAN "^M^JPrivate? (Y/N): "     ; Ask if its to a private msg
  1910.     GOSUB Read_Comm         ; Read a response
  1911.     IF FLAG(0)            ; If error
  1912.        GOTO Exit            ; And continue
  1913.        ENDIF
  1914.  
  1915.     S13 = " "                       ; Set privacy flag
  1916.     IF FIND S9 "Y"                  ; Test for "Y"
  1917.        S13 = "P"                    ; Set flag field to private
  1918.        ENDIF
  1919.  
  1920.     N10 = N10+1            ; Use next sequential #
  1921.     S0 = S0&"."&N10                 ; Make a new file name
  1922.     S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command
  1923.     DOS S9                ; Perform the copy
  1924.  
  1925.     FOPENO "BBS-Mail" TEXT APPEND   ; Open the keys file for append
  1926.     WRITE S10 8            ; Write the 'TO ID'
  1927.     WRITE S1  8            ; Write the from ID
  1928.     WRITE S13 1            ; Write privacy flag
  1929.     WRITE S12 8            ; Write date
  1930.     WRITE S0  13            ; Write file name
  1931.     WRITE S11 50            ; Write the subject
  1932.     WRITE "!" 1                     ; And a delimiter
  1933.     FCLOSEO             ; ANd close the keys file
  1934.     GOTO Mail_Prompt        ; GO for next cmd
  1935.  
  1936. ; -----------------------------------------------------------------------
  1937. ;    Registration (Exit must be performed after)
  1938. ;
  1939. ;    Upon return: FLAG(0) ON -> Caller disconnected
  1940. ; -----------------------------------------------------------------------
  1941. ;
  1942. Register:
  1943.     MESS "^M^JRegistration requested "
  1944.     S9 = "Do you wish to register? "
  1945.     S8 = "BBS-ReMe"                 ; Set file name
  1946.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1947.  
  1948.     GOSUB Read_Comm         ; Read a response
  1949.     IF FLAG(0)            ; If error
  1950.        RETURN            ; SImply return
  1951.        ENDIF
  1952.  
  1953.     FIND S9 "Y"                     ; Look for "Y"
  1954.     IF NOT FOUND            ; IF answer wan't 'Y'
  1955.        TRAN "OK - bye"              ; Say g'night Gracie
  1956.        RETURN            ; We're done.
  1957.        ENDIF
  1958. ;
  1959. ;    Ask for a name/address/csz phone and ID/Password
  1960. ;
  1961.     TRAN "Enter your full name: "
  1962.     GOSUB Read_Comm         ; Read a response
  1963.     IF FLAG(0)            ; If error
  1964.        RETURN            ; SImply return
  1965.        ENDIF
  1966.     S18 = S9            ; Save return
  1967.  
  1968.     TRAN "Enter your street address: "
  1969.     GOSUB Read_Comm         ; Read a response
  1970.     IF FLAG(0)            ; If error
  1971.        RETURN            ; SImply return
  1972.        ENDIF
  1973.     S17 = S9            ; Save return
  1974.  
  1975.     TRAN "Enter your city/state and zip: "
  1976.     GOSUB Read_Comm         ; Read a response
  1977.     IF FLAG(0)            ; If error
  1978.        RETURN            ; SImply return
  1979.        ENDIF
  1980.     S16 = S9            ; Save return
  1981.  
  1982.     TRAN "Enter a area code and phone number where^M^J"
  1983.     TRAN "you may be reached:  "
  1984.     GOSUB Read_Comm         ; Read a response
  1985.     IF FLAG(0)            ; If error
  1986.        RETURN            ; SImply return
  1987.        ENDIF
  1988.     S15 = S9            ; Save return
  1989. ;
  1990. ;    Request an ID
  1991. ;
  1992. Reg_ID:
  1993.     TRAN "Enter the ID (1-8 chars) you wish to use: "
  1994.     GOSUB Read_Comm         ; Read a response
  1995.     IF FLAG(0)            ; If error
  1996.        RETURN            ; SImply return
  1997.        ENDIF
  1998.  
  1999.     IF FIND S9(0:7) "."             ; Index from 0           ; Index from 0
  2000.        TRAN "ID may not contain '.'s^M^J"
  2001.        GOTO Reg_ID
  2002.        ENDIF
  2003.     IF FIND S9(0:7) ","             ; Index from 0           ; Index from 0
  2004.        TRAN "ID may not contain ','s^M^J"
  2005.        GOTO Reg_ID
  2006.        ENDIF
  2007.     IF FIND S9(0:7) "\"             ; Index from 0           ; Index from 0
  2008.        TRAN "ID may not contain '\'s^M^J"
  2009.        GOTO Reg_ID
  2010.        ENDIF
  2011.     IF FIND S9(0:7) "/"             ; Index from 0           ; Index from 0
  2012.        TRAN "ID may not contain '/'s^M^J"
  2013.        GOTO Reg_ID
  2014.        ENDIF
  2015.     S14 = S9(0:7)            ; Save return         ; Index from 0
  2016. ;
  2017. ;    Request a password
  2018. ;
  2019. Reg_Pass:
  2020.     TRAN "Enter the password (1-8 chars) you wish to use: "
  2021.     GOSUB Read_Comm         ; Read a response
  2022.     IF FLAG(0)            ; If error
  2023.        RETURN            ; SImply return
  2024.        ENDIF
  2025.  
  2026.     IF NULL S9(0:7)         ; Test for blank entered ; Index from 0
  2027.        TRAN "You must have a password^M^J"
  2028.        GOTO Reg_Pass
  2029.        ENDIF
  2030.     S14 = S14 & ";" &S9(0:7)        ; Concatenate PASSWORD to ID ; Index from 0
  2031. ;
  2032. ;    Repeat for validity:
  2033. ;
  2034.     TRAN "^M^JRepeating your entry...^M^J"
  2035.     TRAN S18            ; Transmit name
  2036.     TRAN "^M^J"
  2037.     TRAN S17            ; Transmit Street address
  2038.     TRAN "^M^J"
  2039.     TRAN S16            ; Transmit CSZ
  2040.     TRAN "^M^J"
  2041.     TRAN S15            ; Transmit Phone
  2042.     TRAN "^M^J"
  2043.     TRAN S14            ; Transmit ID/password
  2044.  
  2045.     TRAN "^M^JIs this correct? "
  2046.     GOSUB Read_Comm         ; Read a response
  2047.     IF FLAG(0)            ; If error
  2048.        RETURN            ; SImply return
  2049.        ENDIF
  2050.  
  2051.     FIND S9 "Y"                     ; Look for "Y"
  2052.     IF NOT FOUND            ; IF answer wan't 'Y'
  2053.        GOTO Register        ; Try again
  2054.        ENDIF
  2055. ;
  2056. ;    Open the comments file
  2057. ;
  2058.     FOPENO "BBS-Note" TEXT APPEND   ; OPEN file for input
  2059.     IF NOT SUCCESS            ; if open failed
  2060.        TRAN "Error recording registration - please call back^M^J"
  2061.        RETURN            ; Return to caller
  2062.        ENDIF
  2063.  
  2064.     S9 = "*** Registration requested: "
  2065.     DATE S1
  2066.     CONCAT S9(27) S1        ; S1 would be ID anyway  ; Index from 0
  2067.     TIME S1 1            ; (military fmt)
  2068.     CONCAT S9(38) S1                     ; Index from 0
  2069.     WRITE S9 20            ; Write a record     * COM-AND
  2070.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2071.  
  2072.     WRITE S18 80            ; Write a record     * COM-AND
  2073.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2074.     WRITE S17 80            ; Write a record     * COM-AND
  2075.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2076.     WRITE S16 80            ; Write a record     * COM-AND
  2077.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2078.     WRITE S15 80            ; Write a record     * COM-AND
  2079.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2080.     WRITE S14 80            ; Write a record     * COM-AND
  2081.     WRITE "!" 1                     ; Write a record delim   * COM-AND
  2082. ;
  2083. ;    We have a successful record
  2084. ;
  2085.     TRAN "Your request will be processed by the SYSOP^M^J"
  2086.     TRAN "Thanks for calling...^M^J"
  2087.  
  2088.     FCLOSEO             ; CLose the file
  2089.     RETURN                ; Return from subroutine
  2090.  
  2091. ; -----------------------------------------------------------------------
  2092. ;    Auto baudrate detect (according to message in S9)
  2093. ;
  2094. ;    This procedure is placed last to ensure that the entire script
  2095. ;    file is scanned once before the main prompt.  COM-AND caches
  2096. ;    label addresses, so this ensures that the 1st 100 labels are
  2097. ;    known by COM-AND (and thus can be quickly reached).
  2098. ; -----------------------------------------------------------------------
  2099. ;
  2100. AutoBaud:
  2101.     FIND S9 "1200"                  ; Test for 1200 baud
  2102.     IF FOUND            ; IF found
  2103.        SET BAUD 1200        ; Set to 1200 baud
  2104.        RETURN            ; We're done.
  2105.        ENDIF
  2106.  
  2107.     FIND S9 "2400"                  ; Test for 1400 baud
  2108.     IF FOUND            ; IF found
  2109.        SET BAUD 2400        ; Set to 1400 baud
  2110.        RETURN            ; We're done.
  2111.        ENDIF
  2112. ;
  2113. ;    None of the above... set to 300
  2114. ;
  2115.     SET BAUD 300            ; Set to 1200 baud
  2116.     RETURN                ; We're done.
  2117.