home *** CD-ROM | disk | FTP | other *** search
/ Shareware 1 2 the Maxx / sw_1.zip / sw_1 / BBS / RB174BAS.ZIP / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1992-06-20  |  141KB  |  4,085 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  First Released .....: June 21, 1992
  6. '  Subsequent Releases.: 
  7. '  Copyright ..........: 1986 - 1992
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  Macro          1320  Check/execute macro
  18. '  AnswerIt        200  Answer the telephone when it rings
  19. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  20. '  BadChar         455  Check user name for invalid characters
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  BankTime       5500  Let caller change banked time
  23. '  CheckRatio    20096  Test upload/download ratio
  24. '  CheckMacro     1242  Checks for macro and processes
  25. '  CopyRight        97  Display RBBS-PC's copyright notice
  26. '  DEFALTU        9600  Write out the user's defaults
  27. '  DenyAccess     1386  Downgrade security so access denied
  28. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  29. '  DoorInfo      10991  Writes out information for a door
  30. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  31. '  EditALine      2618  Edits a single line
  32. '  EditDef         120  Edit configuration parameters
  33. '  FileNameCheck 20240  Matches file name to a prefix & extension
  34. '  GetArc        20140  Handle request for verbose listing
  35. '  GetCommand      101  Get RBBS-PC's node id from command line
  36. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  37. '  GoIdle           90  Release resources when waiting for keyboard input
  38. '  KillMsg        3952  Delete old or unnecessary messages
  39. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  40. '  LineEdit       3700  Edit a line while minimizing string space consumption
  41. '  LogError      13660  Log error message to CALLERS file
  42. '  LPrnt          1480  Subroutine to write to local display
  43. '  MLInit            8  Handle MultiLink initialization/de-initialization
  44. '  MsgProt        2055  Sets protection for a message
  45. '  ParseIt        1637  Parses a string
  46. '  PassWrd         660  Verify user & message passwords
  47. '  PopCmdStack    1650  Get user input, 1st checking command stack
  48. '  PScrn          1483  Print to display
  49. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  50. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  51. '  QuickTPut1     1478  Outputs short string following by CR LF
  52. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  53. '  RecoverMsg    10410  Recover a deleted message
  54. '  RemNonAlf      5100  Removes non-alpha characters from a string
  55. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  56. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  57. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  58. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  59. '  SetThread      4554  Set up request for threading thru messages
  60. '  SetWhoTo       2018  Sets who a message/personal upload is to
  61. '  SkipLine       1485  Write a # of blank lines to the communications port
  62. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  63. '  SecViolation   1380  Process a security violation
  64. '  SysMenu         112  Displays sysop menu/status
  65. '  SysopChat      4773  Sysop and caller chat
  66. '  TestRel         336  Tests for Reliable connect
  67. '  TGet           1498  Read a line from the communications port
  68. '  TPut           1396  Write a line to the communications port
  69. '  Trim            105  Strip leading and trailing blanks from a string
  70. '  TrimTrail       107  Strip off specified string off end of another string
  71. '  UntilRight    12878  Ask a question until user says answer is right
  72. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  73. '  VarInit         109  Initialize system variables
  74. '  ViewHelp       1330  Processes help command
  75. '  WhoCheck       2250  Checks whether a user exists in user file
  76. '  WhosOn         9801  Report status of each node - who's on
  77. '  WordInFile    10976  Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  NAME    -- MLInit
  85. '
  86. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                     CYLCE TIME
  88. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  89. '                                     A DOOR OR DOS REMOTELY
  90. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  92. '              ZDoorsTermType
  93. '              ZBaudTest!
  94. '              ZComPort$
  95. '              ZComputerType
  96. '
  97. '  OUTPUTS --  NONE
  98. '
  99. '  PURPOSE --  To test for the presence of multi-link and set
  100. '              multi link options to be compatible with RBBS-PC
  101. '
  102.       SUB MLInit (MLParm) STATIC
  103.     DEF SEG = 0
  104.     IF ZComputerType = 1 _
  105.        GOTO 10
  106.     IF NOT ZMLCom THEN _
  107.        IF ZNetworkType <> 1 THEN _
  108.           GOTO 10
  109.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF ZMultiLinkPresent = 0 THEN _
  111.        GOTO 10
  112.     ON MLParm GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF ZDoorsTermType < 1 THEN _
  116.        RETURN
  117.     DEF SEG = ZMultiLinkPresent
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = ZBaudTest!)  ******
  120.     WasAX = &H600
  121.     WasBX = ZBaudTest!   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = ZDoorsTermType) ****
  124.     WasAX = &H700 + ZDoorsTermType
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ***********
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48
  129. ' ************       MLUTIL SCMON       *************
  130.     WasAX = &HB01
  131.     WasBX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ***************
  135. 30  WasAX = &HB00       ' Turn off ML's carrier monitoring.
  136.     WasBX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       *************
  139.     WasAX = &H701       ' Change terminal type to ML type 1.
  140.     WasBX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  143. ' *******            port = 0 if ML 4.00 or greater           ******
  144.     DEF SEG = ZMultiLinkPresent
  145.     MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MultiLinkCommPort) = &H1 OR _
  148.        PEEK(MultiLinkCommPort) = &H2 THEN _
  149.        IF MultiLinkVersion > 5000 THEN _
  150.           POKE (MultiLinkCommPort),&H0 _
  151.        ELSE POKE (MultiLinkCommPort),&H9
  152. ' **********         MLUTIL ENQ         **********
  153.     WasAX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      *********
  156.     WasAX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     WasBX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         *********
  161. 60 WasAX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 WasBX = -4
  163.    IF ZComPort$ = "COM2" THEN _
  164.       WasBX = -3
  165.    IF ZComPort$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  168. 80 CALL RBBSML(WasAX,WasBX)
  169.    RETURN
  170.    END SUB
  171. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  172. '  $PAGE
  173. '
  174. '  NAME    -- GoIdle
  175. '
  176. '  INPUTS  -- ZMLCom
  177. '             ZNetworkType
  178. '
  179. '  OUTPUTS --  NONE
  180. '
  181. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  182. '              input from the communications port
  183. '
  184.       SUB GoIdle STATIC
  185.    IF ZMLCom OR ZNetworkType = 1 THEN _
  186.       CALL MLInit(5) : _
  187.       EXIT SUB
  188.    CALL GiveBack
  189.    END SUB
  190. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  NAME    -- CopyRight
  194. '
  195. '  INPUTS  --  NONE
  196. '
  197. '  OUTPUTS --  NONE
  198. '
  199. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  200. '
  201.       SUB CopyRight STATIC
  202.    ZWasA = (ZDebug OR ZExitToDoors OR ZCopyrightSecs < 1)
  203.    IF ZWasA THEN _
  204.       EXIT SUB
  205.    WIDTH 80
  206.    ZOutTxt$(1) = "If you use RBBS-PC 17.4, please consider contributing to"
  207.    ZOutTxt$(2) = "             Capital PC User Group"
  208.    ZOutTxt$(3) = "             51 Monroe Street"
  209.    ZOutTxt$(4) = "             Plaza East Two"
  210.    ZOutTxt$(5) = "             Rockville, Maryland 20850"
  211.    ZOutTxt$(6) = ""
  212.    ZOutTxt$(7) = "You are free to copy/share RBBS-PC 17.4 provided"
  213.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  214.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  215.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  216.    CLS
  217.    KEY OFF
  218.    LOCATE ,,0
  219.    ZWasA = ZSnoop
  220.    ZSnoop = -1
  221.    CALL LPrnt(SPACE$(60) + "tm",1)
  222.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  223.    CALL SkipLine(1)
  224.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  225.    CALL SkipLine (1)
  226.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  227.    FOR WasI = 1 TO 10
  228.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  229.    NEXT
  230.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  231.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-91 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  232.    CALL DelayTime (ZCopyrightSecs)
  233.    ZSnoop = ZWasA
  234.    END SUB
  235. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  236. ' $PAGE
  237. '
  238. '  NAME    -- GetCommand
  239. '
  240. '  INPUTS  --     PARAMETER                    MEANING
  241. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  242. '                                  USE AS A MODEL WHEN CREATING THE
  243. '                                  .DEF FILE NAME TO BE USED BY THIS
  244. '                                  COPY OF RBBS-PC.
  245. '
  246. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  247. '                                  RBBS-PC IN THE FORM:
  248. '
  249. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  250. '
  251. '   WHERE THE OPTIONAL PARAMETERS ARE:
  252. '
  253. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  254. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  255. ' DEBUG    IS A DEBUGGING Switch
  256. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  257. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  258. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  259. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  260. '             PROGRAM
  261. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  262. '
  263. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  264. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  265. '
  266. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  267. '                                  THIS COPY OF RBBS-PC TO USE
  268. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  269. '                                  MESSAGES FILE FOR THIS "NODE"
  270. '                                  (RANGE IS 2 TO 36)
  271. '
  272. '  PURPOSE --  To get node id from command line and determine if rbbs
  273. '              is being run as a door
  274. '
  275.       SUB GetCommand (PassedDebug,NetTime$,NetBaud$,NetReliable$) STATIC
  276.       STATIC ZDebug
  277. '
  278. '
  279. ' *  GET NODE ID FROM COMMAND LINE
  280. '
  281. '
  282.       WasPM$ = COMMAND$
  283.       CALL AllCaps(WasPM$)
  284.       IF INSTR(WasPM$,"/") = 0 THEN _
  285.          GOTO 103
  286. '
  287. '
  288. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  289. '
  290. '
  291.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  292.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  293.       ZWasA = 0
  294.       FOR WasX = 1 TO LEN(CmdLine$)
  295.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  296.              ZWasA = ZWasA + 1 : _
  297.              ZSubDir$(ZWasA) = "" _
  298.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  299.       NEXT
  300.       NetTime$ = ZSubDir$(1)
  301.       IF ZWasA > 1 THEN _
  302.          NetBaud$ = ZSubDir$(2)
  303.       IF ZWasA > 2 THEN _
  304.          NetReliable$ = ZSubDir$(3)
  305.       IF ZWasA > 3 THEN _
  306.          ZCBaud$ = STR$(VAL(ZSubDir$(ZWasA)))
  307.       CALL Trim(NetTime$)
  308.       CALL Trim(NetBaud$)
  309.       CALL Trim(NetReliable$)
  310.       CALL Trim (ZCBaud$)
  311. 103   ZWasA = INSTR(WasPM$,"DEBUG")
  312.       IF ZWasA > 0 THEN _
  313.          ZDebug = -1 : _
  314.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  315.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  316.       PassedDebug = ZDebug
  317.       ZWasA = INSTR(WasPM$,"LOCAL")
  318.       IF ZWasA > 0 THEN _
  319.          ZComPort$ = "COM0" : _
  320.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  321.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  322.       IF LEN(WasPM$) = 0 THEN _
  323.          WasPM$ = "-"
  324.       ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1))
  325.       IF ZNodeRecIndex < 2 THEN _
  326.          ZNodeRecIndex = 2
  327.       ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2)
  328.       IF ZNodeRecIndex > 10 THEN _
  329.          ZNodeFileID$ = LEFT$(WasPM$,1) _
  330.       ELSE ZNodeFileID$ = ZNodeID$
  331.       IF ZNodeID$ <> "1" THEN _
  332.          ZLibNodeID$ = ZNodeFileID$
  333.       IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _
  334.          ZConfigFileName$ = MID$(WasPM$,3)_
  335.       ELSE MID$(ZConfigFileName$,5,1) = WasPM$
  336.       ZOrigCnfg$ = ZConfigFileName$
  337.       END SUB
  338. 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks'
  339. ' $PAGE
  340. '
  341. '  NAME    -- Trim
  342. '
  343. '  INPUTS  --  PARAMETER                    MEANING
  344. '              TrimParm$           STRING THAT IS TO HAVE LEADING
  345. '                                  AND TRAILING BLANKS ELIMINATED FROM
  346. '
  347. '  OUTPUTS --  TrimParm$           STRING WITH NO LEADING OR TRAILING
  348. '                                   BLANKS
  349. '
  350. '  PURPOSE --  To strip leading and trailing blanks
  351. '
  352.       SUB Trim (TrimParm$) STATIC
  353.       WasL = INSTR(TrimParm$," ")
  354.       IF WasL < 1 THEN _
  355.          EXIT SUB
  356.       IF WasL = 1 THEN _
  357.          WHILE LEFT$(TrimParm$,1) = " " : _
  358.             TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _
  359.          WEND
  360.       CALL TrimTrail (TrimParm$," ")
  361.       END SUB
  362. '
  363. 107 '  $SUBTITLE: 'TrimTrail - sub to trim off trailing characters'
  364. '  $PAGE
  365. '
  366. '  NAME    --  TrimTrail
  367. '
  368. '  INPUTS  --  PARAMETER           MEANING
  369. '              TrimParm$  WHAT STRING TO Trim FROM
  370. '              TrimThis$  WHAT CHARACTER TO Trim OFF END
  371. '
  372. '  OUTPUTS --  NONE
  373. '
  374. '  PURPOSE --  To remove all occurences of a character from end of string
  375. '
  376.       SUB TrimTrail (TrimParm$,TrimThis$) STATIC
  377.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _
  378.          EXIT SUB
  379.       WasJ = LEN(TrimParm$) - 1
  380. 108   IF WasJ > 0 THEN _
  381.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _
  382.             WasJ = WasJ - 1 : _
  383.             GOTO 108
  384.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  385.       END SUB
  386. '
  387. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  388. '  $PAGE
  389. '
  390. '  NAME    --  VarInit
  391. '
  392. '  INPUTS  --  PARAMETER           MEANING
  393. '              NONE
  394. '
  395. '  OUTPUTS --  NONE
  396. '
  397. '  PURPOSE --  To initialize system variable
  398. '
  399.       SUB VarInit STATIC
  400.     DEF SEG                            ' Point to BASIC
  401.     WIDTH 80                           ' Set Screen Width
  402.     KEY OFF                            ' Line 25 turned off
  403. ' ********************* Variable Definitions *******************************
  404.     ZMsgDim = 99
  405.     WasMM = 999
  406.     WasBX = 75
  407.     WasJ = 60
  408.     REDIM ZOptSec(WasJ)
  409.     DIM ZWorkAra$(WasJ)
  410.     DIM ZGSRAra$(WasJ)
  411.     DIM ZCategoryName$(WasBX),ZCategoryCode$(WasBX),ZCategoryDesc$(WasBX)
  412.     DIM ZOutTxt$(ZMsgDim)                      ' Message line table
  413.     DIM ZUserIn$(ZMsgDim)                      ' Message line table
  414.     DIM ZMsgPtr(WasMM,2)                       ' Message pointers
  415.     ZAcknowledge$ = CHR$(6)
  416.     ZAckChar$ = "C" + _
  417.             ZAcknowledge$
  418.     ZActiveMenu$ = "B"
  419.     ZActiveMessage$ = CHR$(225)
  420.     ZBackSpace$ = CHR$(8) + _
  421.                  CHR$(32) + _
  422.                  CHR$(8)
  423.     ZBackArrow$ = CHR$(29) + _
  424.                   CHR$(32) + _
  425.                   CHR$(29)
  426.     ZBaudRates$ = "      300  450 1200 2400 4800 7200 96001200014400168001920038400"
  427.     ZBellRinger$ = CHR$(7)
  428.     ZBulletinMenu$ = ""
  429.     ZWasCL = 24
  430.     ZCancel$ = CHR$(24)
  431.     ZColorReset$ = CHR$(27) + _
  432.                    "[00;37;40m"
  433.     ZConfigFileName$ = "RBBS-PC.DEF"
  434.     ZCarriageReturn$ = CHR$(13)
  435.     ZDeletedMsg$ = CHR$(226)
  436.     ZEndTransmission$ = CHR$(4)
  437.     ZEscape$ = CHR$(27)
  438.     ZExpectActiveModem = 0
  439.     ZFalse = 0
  440.     ZF1Key = 59
  441.     ZF10Key = 68
  442.     ZConfName$ = "MAIN"
  443.     CALL SetHiLite (ZTrue)
  444.     ZHomeConf$ = ""
  445.     ZInConfMenu = -1
  446.     ZLastCommand$ = "M "
  447.     ZLimitMinsPerSession = 0
  448.     ZLineFeed$ = CHR$(10)
  449.     ZLineFeeds = NOT ZFalse
  450.     ZLineEditChk$ = CHR$(9) + _
  451.                     ZLineFeed$ + _
  452.                     CHR$(11) + _
  453.                     CHR$(12) + _
  454.                     CHR$(127) + _
  455.                     CHR$(8) + _
  456.                     ZBellRinger$ + _
  457.                     CHR$(26) + _
  458.                     CHR$(227)
  459.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  460.     ZLockStatus$ = "UM UU UB UD"
  461.     ZMenuIndex = 2
  462.     ZNAK$ = CHR$(21)
  463.     ZNoAdvance = ZFalse
  464.     ZPageLength = 23
  465.     ZParseOff = ZFalse
  466.     ZPressEnter$ = " (Press [ENTER] to quit)"
  467.     ZPressEnterExpert$ = " ([ENTER] quits)"
  468.     ZPressEnterNovice$ = ZPressEnter$
  469.     ZPrivateDoor = ZFalse
  470.     ZRightMargin = 72
  471.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  472.                         ZLineFeed$
  473.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  474.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  475.                    "TY TN BN ND FS LS CN"
  476.     ZStartOfHeader$ = CHR$(1)
  477.     ZTimeLoggedOn$ = SPACE$(8)
  478.     ZTrue = NOT ZFalse
  479.     ZUpInc = -1
  480.     ZXOff$ = CHR$(19)
  481.     ZXOn$ = CHR$(17)
  482.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  483.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  484.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  485.     ZVersionID$ = "17.4"
  486.     ZWasLG$(1) = "Registration Check Failed"
  487.     ZWasLG$(2) = "Sysop name attempted"
  488.     ZWasLG$(3) = "Locked out attempt"
  489.     ZWasLG$(4) = "Password Attempt Failed"
  490.     ZWasLG$(5) = "Auto Lockout done"
  491.     ZWasLG$(6) = "Name in use on another Node!"
  492.     ZWasLG$(7) = ""
  493.     ZWasLG$(8) = "Locked reason read!"
  494.     ZWasLG$(9) = "Expired Registration"
  495.     CALL GetCommand (ZDebug,ZNetTime$,ZNetBaud$,ZNetReliable$)
  496.     ZSubParm = 1
  497.     CALL ReadDef (ZConfigFileName$)
  498.     REDIM ZWorkAra$(ZMaxWorkVar)
  499.     REDIM ZGSRAra$(ZMaxWorkVar)
  500.     ZUseTPut = (ZUpperCase OR ZXOnXOff)
  501.     ZOrigCallers$ = ZCallersFile$
  502.     ZOrigMsgFile$ = ZMainMsgFile$
  503.     ZOrigUserFile$ = ZMainUserFile$
  504.     ZOrigSysopFN$ = ZSysopFirstName$
  505.     ZOrigSysopLN$ = ZSysopLastName$
  506.     ZPromptBell = ZPromptBellDef
  507.     ZSecretName$ = ZSysopPswd1$ + " " + ZSysopPswd2$
  508.     END SUB
  509. '
  510. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  511. '  $PAGE
  512. '
  513. '  NAME    --  SysMenu
  514. '
  515. '  INPUTS  --  PARAMETER           MEANING
  516. '
  517. '  OUTPUTS --  NONE
  518. '
  519. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  520. '
  521.     SUB SysMenu STATIC
  522.     ZLocalUser = ZTrue
  523.     ZSnoop = ZTrue
  524.     ZNonStop = ZTrue
  525.     CALL CheckTime (TIMER, ZDelay!, 1)
  526.     CLS
  527.     ZStopInterrupts = ZTrue
  528.     ZBypassTimeCheck = ZTrue
  529.     CALL BufFile ("MENU0",WasX)
  530.     ZNonStop = ZFalse
  531.     ZBypassTimeCheck = ZFalse
  532.     ZLocalUser = ZFalse
  533.     IF NOT ZOK THEN _
  534.        CALL LPrnt("MENU0 not on default drive",1)
  535.     LOCATE 2,15
  536.     CALL LPrnt(LEFT$(ZVersionID$,12),0)
  537.     LOCATE 2,42
  538.     CALL LPrnt(ZNodeID$,0)
  539.     LOCATE 2,60
  540.     WasX$ = DATE$
  541.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  542.     LOCATE 2,74
  543.     CALL LPrnt(LEFT$(TIME$,5),0)
  544.     IF ZFMSDirectory$ <> "" THEN _
  545.        LOCATE 6,76 : _
  546.        CALL LPrnt("YES",0)
  547.     IF ZExtendedLogging THEN _
  548.        LOCATE 8,76 : _
  549.        CALL LPrnt("YES",0)
  550.     IF ZFossil THEN _
  551.        LOCATE 10,76 : _
  552.        CALL LPrnt("YES",0)
  553.     LOCATE 12,75 : _
  554.     CALL LPrnt(ZComPort$,0)
  555.     LOCATE 14,75
  556.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  557.     IF ZDebug THEN _
  558.        LOCATE 22,76 : _
  559.        CALL LPrnt("Yes",0)
  560.     END SUB
  561. '
  562. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  563. '  $PAGE
  564. '
  565. '  NAME    -- EditDef
  566. '
  567. '  INPUTS  --     PARAMETER                    MEANING
  568. '
  569. '  OUTPUTS --                          OUTPUT STRING
  570. '
  571. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  572. '
  573.       SUB EditDef STATIC
  574.       ZAllOpts$ = ZMainCmds$ + _
  575.                   ZFileCmd$ + _
  576.                   ZUtilCmds$ + _
  577.                   ZLibCmds$ + _
  578.                   ZGlobalCmnds$ + _
  579.                   ZSysopCmds$
  580.       ZHelpExtension$ = "." + _
  581.                         ZHelpExtension$
  582.       ZCompressedExt$ = ZDefaultExtension$
  583.       ZWasQ = INSTR(ZDefaultExtension$,".")
  584.       IF ZWasQ > 0 THEN _
  585.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  586.       ZCurDirPath$ = ZDirPath$
  587.       ZTempExpiredSec = ZExpiredSec
  588.       ZBegMain = 1
  589.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  590.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  591.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  592.       ZHelp$(3) = ZHelpPath$ + _
  593.                  ZHelp$(3)
  594.       ZHelp$(4) = ZHelpPath$ + _
  595.                  ZHelp$(4)
  596.       ZHelp$(7) = ZHelpPath$ + _
  597.                  ZHelp$(7)
  598.       ZHelp$(9) = ZHelpPath$ + _
  599.                  ZHelp$(9)
  600.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  601.                      Extension$,ZTrue)
  602.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  603.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  604.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  605.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  606.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  607.      ZDR1$ = ZFG1Def$
  608.      ZDR2$ = ZFG2Def$
  609.      ZDR3$ = ZFG3Def$
  610.      ZDR4$ = ZFG4Def$
  611.      IF ZSubParm = -62 THEN _
  612.         EXIT SUB
  613.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  614.      IF ZLocalUserMode THEN _
  615.         ZRecycleToDos = ZTrue
  616.      ZEchoer$ = ZDefaultEchoer$
  617.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  618.         ZScreenOutMsg$ = ZStartOfHeader$
  619.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  620.      IF ZMaxWorkVar < 13 THEN _
  621.         ZMaxWorkVar = 13
  622. '
  623. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  624. '
  625.     IF ZMainFMSDir$ <> "" THEN _
  626.        ZFMSDirectory$ = ZDirPath$ + _
  627.                         ZMainFMSDir$ + _
  628.                         "." + _
  629.                         ZMainDirExtension$ : _
  630.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  631.        ZLibDir$ = ZLibDirPath$ + _
  632.                             ZMainFMSDir$ + _
  633.                             "." + _
  634.                             ZLibDirExtension$
  635.     ZUpcatHelp$ = ZHelpPath$ + _
  636.                   ZUpcatHelp$ + _
  637.                   ZHelpExtension$
  638.     IF ZSubDirCount < 1 THEN _
  639.        GOTO 123
  640.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  641.        INPUT #2,ZSubDir$
  642.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  643.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  644.                                  "\" _
  645.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  646.     NEXT
  647.     GOTO 125
  648. 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1
  649.        ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _
  650.                                ":"
  651.     NEXT
  652.     ZSubDirCount = LEN(ZDnldDrives$) - 1
  653. '
  654. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  655. '
  656. 125 ZUpldDirCheck$ = ZUpldDir$
  657.     ZSubDirCount = ZSubDirCount + 1
  658.     IF ZUpldToSubdir THEN _
  659.        ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _
  660.                                "\" _
  661.     ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _
  662.                                  ":"
  663.     ZUpldDir$ = ZUpldDir$ + _
  664.                         "." + _
  665.                         ZMainDirExtension$
  666.     CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found)
  667.     ZCanDnldFromUp = (Found > 0)
  668.     ZUpldDir$ = ZUpldPath$ + _
  669.                         ZUpldDir$
  670. 126 CLOSE #2
  671.     IF ZLibDrive$ <> "" THEN _
  672.        ZLibType = 1
  673.     ZSubParm = -10
  674.     CALL Carrier
  675.     IF ZSubParm = -1 THEN _
  676.        IF ZLibDrive$ <> "" THEN _
  677.           CALL ChangeDir (ZLibDrive$ + _
  678.                          "\") : _
  679.           CALL KillWork (ZLibWorkDiskPath$ + _
  680.                         ZLibNodeID$ + _
  681.                         "DK*.ARC") : _
  682.                         ZErrCode = 0
  683. '
  684. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  685. '
  686. 128 IF ZNetworkType = 2 THEN _
  687.        ZWasCN$ = SPACE$(535) : _
  688.        CALL InitIO(ZWasA)
  689.        END SUB
  690. '
  691. 129 '  $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes'
  692. '  $PAGE
  693. '
  694. '  NAME    -- ASCIICodes
  695. '
  696. '  INPUTS  --     PARAMETER                    MEANING
  697. '                 LeftParen$           MARKS BEGINNING OF #
  698. '                 RightParen$          MARKS END OF #
  699. '                 Strng$                INPUT STRING
  700. '
  701. '  OUTPUTS --    Strng$                OUTPUT STRING
  702. '
  703. '  PURPOSE -- To allow a config string to have any ascii values.
  704. '             characters not enclosed taken as is.  Enclosed
  705. '             characters interpreted as value of ascii code.
  706. '             (e.g. "123[32]4" is interpreted as "123 4").
  707. '
  708.     SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC
  709.     IF LEN(Strng$) < 1 THEN _
  710.        EXIT SUB
  711.     Start = 1
  712.     WasL = LEN(Strng$)
  713.     ZUserIn$ = Strng$ + _
  714.          LeftParen$
  715.     WasX = INSTR(ZUserIn$,LeftParen$)
  716.     NewString$ = ""
  717.     WHILE Start <= WasL
  718.        NewString$ = NewString$ + _
  719.                     MID$(ZUserIn$,Start,WasX - Start)
  720.        WasY = INSTR(WasX,ZUserIn$,RightParen$)
  721.        IF WasY > 0 THEN _
  722.           WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _
  723.           NewString$ = NewString$ + _
  724.                        CHR$(WasK) : _
  725.           Start = WasY + 1 _
  726.        ELSE NewString$ = NewString$ + _
  727.                          MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _
  728.             Start = WasL + 1
  729.        WasX = INSTR(Start,ZUserIn$,LeftParen$)
  730.     WEND
  731.     Strng$ = NewString$
  732.     END SUB
  733. 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection'
  734. ' $PAGE
  735. '
  736. '  NAME    -- AnswerIt
  737. '
  738. '  INPUTS  --     PARAMETER                    MEANING
  739. '                 ZSubParm = 1           WAIT FOR PHONE TO RING
  740. '                          = 2           CONTINUE LOOKING FOR CONNECT
  741. '                          = 3           RENTRY AFTER FUNCTION KEY
  742. '                          = 4           GO ON LINE IMMEDIATELY
  743. '                 ZBG                    LOCAL DISPLAY'S BACKGROUND
  744. '                 ZBorder                LOCAL DISPLAY'S BORDER COLOR
  745. '                 ZComPort$              COMMUNICATIONS PORT NAME
  746. '                 ZComputerType          TYPE OF COMPUTER RUNNING ON
  747. '                 ZDumbModem             NON-HAYES TYPE MODEM FLAG
  748. '                 ZExtendedLogging       EXTENDED CALLERS LOG FLAG
  749. '                 ZFG                    LOCAL DISPLAY'S FOREGROUND
  750. '                 ZModemAnswerCmd$       COMMAND TO ANSWER PHONE
  751. '                 ZModemCntlReg          LOCATION WasOF MODEM CNTRL. REG
  752. '                 ZModemCountRingsCmd$   COMMAND TO COUNT PHONE RINGS
  753. '                 ZModemInitBaud$        BAUD AT WHICH TO OPEN COMM.
  754. '                 ZModemResetCmd$        COMMAND TO RESET THE MODEM
  755. '                 ZModemStatusReg        LOCATION OF MODEM STATUS REG
  756. '                 ZPrinter               FLAG TO PRINT ON LOCAL PRT.
  757. '                 ZRequiredRings         NUMBER OF RINGS TO ANSWER ON
  758. '                 ZSnoop                 FLAG TO DISPLAY ON LOCAL PC
  759. '                 ZSysopNext             FLAG TO GIVE SYSOP CONTROL
  760. '
  761. '  OUTPUTSS --    BaudTest!              BAUD RATE TO SET RS232 AT
  762. '                 ZEightBit              PARITY INDICATOR
  763. '                 ZReliableMode          INDICATES MODEM-SUPPLIED
  764. '                                        "ERROR-FREE" Protocol ACTIVE
  765. '                 ZSubParm          = 1  Carrier DETECT Found (I.E.
  766. '                                        MODEM AUTO-ANSWERED).
  767. '                                   = 2  ANSWERED THE PHONE AND
  768. '                                        Carrier DETECT OCCURRED.
  769. '                                   = 3  SYSOP HIT "ESC" KEY ON THE
  770. '                                        LOCAL KEYBOARD.
  771. '                                   = 4  ANSWERED THE PHONE BUT NO
  772. '                                        Carrier WAS DETECTED.
  773. '                                   = 5  COMM. BUFFER OVERFLOW.
  774. '                                   = 6  FUNCTION KEY PRESSED ON THE
  775. '                                        LOCAL KEYBOARD.
  776. '
  777. '  PURPOSE -- To detect incoming call and establish connection.
  778. '
  779.       SUB AnswerIt STATIC
  780.       ZErrCode = 0
  781.       ZReliableMode = ZFalse
  782.       ZFF = ZSubParm
  783.       ZSubParm = 0
  784.       ON ZFF GOTO 201,324,245,320
  785. '
  786. '
  787. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  788. '
  789. '
  790. 201 ZSubParm = -10
  791.     CALL Carrier
  792.     IF ZSubParm = 0 THEN _
  793.        GOTO 210
  794. '
  795. '
  796. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  797. '
  798. '
  799.     IF ZFossil THEN _
  800.        State = 0 : _
  801.        CALL FosDTR(ZComPort,State) _
  802.     ELSE OUT ZModemCntlReg,&H4
  803.     CALL DelayTime (ZModemInitWaitTime)
  804. '
  805. '
  806. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  807. '
  808. '
  809.     IF ZFossil THEN _
  810.        State = 1 : _
  811.        CALL FosDTR(ZComPort,State) _
  812.     ELSE OUT ZModemCntlReg,&H0
  813.     CALL DelayTime (ZModemInitWaitTime)
  814. 210 IF ZPrivateDoor THEN _
  815.        CALL Transfer : _
  816.        GOTO 235
  817.     CALL OpenCom(ZModemInitBaud$,",N,8,1")
  818. 220 CALL AMorPM
  819. 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _
  820.                     ZNodeID$ + " up " + ZTime$ + " on " + DATE$)
  821. 235 ZEightBit = ZTrue
  822.     IF ZExitToDoors THEN _
  823.        CALL ReadProf
  824.     ZSubParm = -10
  825.     CALL Carrier
  826.     IF ZSubParm = 0 AND _
  827.        ZExitToDoors THEN _
  828.        ZSubParm = 1 : _
  829.        GOTO 335
  830.     IF ZSubParm = 0 AND _
  831.        ZExpectActiveModem THEN _
  832.        ZBaudTest! = VAL(ZNetBaud$) : _
  833.        CALL TestRel (ZNetReliable$) : _
  834.        GOTO 328
  835.     IF ZExpectActiveModem OR _
  836.        ZExitToDoors THEN _
  837.        ZSubParm = 4 : _
  838.        ZExitToDoors = ZFalse : _
  839.        EXIT SUB
  840.     IF ZSubParm = 0 THEN _
  841.        ConnectDelay! = TIMER + ZMaxCarrierWait : _
  842.        GOTO 324
  843.     CALL SysMenu
  844.     CALL ModemPut (ZModemResetCmd$)
  845.     CALL DelayTime (ZModemInitWaitTime)
  846.     CALL ModemPut (ZModemInitCmd$)
  847.     RingBack = ZFalse
  848.     LOCATE 16,55
  849.     IF ZRequiredRings = 0 THEN _
  850.        CALL LPrnt("WAITING FOR CARRIER",0) : _
  851.        GOTO 237
  852.     IF MID$(ZModemInitCmd$, _
  853.           INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  854.        CALL LPrnt("RING BACK SYSTEM",0) : _
  855.        RingBack = ZTrue : _
  856.        GOTO 236
  857.     CALL LPrnt(" WAITING FOR RING ",0)
  858. 236 LOCATE 16,76 : _
  859.     CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  860. 237 LOCATE 18,76
  861.     IF ZDosANSI THEN _
  862.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  863.     ELSE CALL LPrnt ("YES",0)
  864.     COLOR ZFG,ZBG,ZBorder
  865.     LOCATE 20,56
  866. '
  867. '
  868. ' *  GET READY TO ANSWER INCOMMING CALL:
  869. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  870. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  871. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  872. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  873. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  874. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  875. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  876. '
  877. '
  878.     WasQQ = 255
  879.     WasI = INSTR(ZModemInitCmd$,"S0")
  880.     IF WasI = 0 THEN _
  881.        GOTO 239
  882.     IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
  883.        WasQQ = 0 : _
  884.        ZBlk = WasQQ
  885.     ZSecsUsedSession! = TIMER
  886.     ZSubParm = 1
  887.     CALL Line25
  888.     RingAnswer = ZTrue
  889.     IF RingBack THEN _
  890.        RingAnswer = ZFalse
  891. 239 RingBackWaitStart! = 0
  892.     IF RingBack THEN _
  893.        RingBackWaitStart! = TIMER : _
  894.        COLOR 7,0,0 _
  895.     ELSE COLOR ZFG,ZBG,ZBorder
  896. 240 IF ZSysopNext THEN _
  897.        ZSubParm = 3 : _
  898.        EXIT SUB
  899. '
  900. '
  901. ' * WAIT FOR INCOMING CALLS
  902. '
  903. '
  904.     ScreenCleared = ZFalse
  905. 245 InactiveDelay! = TIMER + (60 * ZRecycleWait)
  906.     NoCall = ZTrue
  907.     CALL FlushCom (ModemResponse$)
  908.     ModemResponse$ = ""
  909. 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _
  910.        GOTO 274
  911.        CALL FindFKey
  912.        IF ZSubParm < 0 THEN _
  913.           EXIT SUB
  914. 250    IF ZKeyPressed$ = ZEscape$ THEN _
  915.           ZSubParm = 3 : _
  916.           EXIT SUB
  917.        IF ZKeyPressed$ <> "" THEN _
  918.           GOTO 235
  919. 260    IF RingBackWaitStart! > 0 THEN _
  920.           CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
  921.           IF TempElapsed! > 45 THEN _
  922.              RingBackWaitStart! = 0 : _
  923.              RingBackCount = 0 : _
  924.              RingAnswer = ZFalse: _
  925.              IF RingBack THEN _
  926.                LOCATE 20,56 : _
  927.                CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  928. 265    CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2)
  929.        IF TempElapsed! > 120 AND NOT ScreenCleared THEN _
  930.           LOCATE ,,0 : _
  931.           CLS : _
  932.           ZWasCL = 1 : _
  933.           ScreenCleared = ZTrue : _
  934.           ZSecsUsedSession! = TIMER
  935.        IF ZTimeToDropToDos! > 0 THEN _
  936.           IF ZOldDate$ <> DATE$ THEN _
  937.           IF TIMER => ZTimeToDropToDos! AND _
  938.              TIMER < 86340 THEN _      ' Skip btw 23:59 and 00:00
  939.                 ZSubParm = 7 : _
  940.                 EXIT SUB
  941. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  942.           ZRequiredRings > 0 THEN _
  943.           GOTO 276
  944. 270    IF ZRecycleWait > 0 THEN _
  945.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  946.           IF TempElapsed! <= 0 THEN _
  947.              ZSubParm = 8 : _
  948.              EXIT SUB
  949.        CALL FlushCom (WasX$)
  950.        IF LEN(WasX$) > 0 THEN _
  951.           ModemResponse$ = ModemResponse$ + WasX$ : _
  952.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  953.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  954.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  955.     IF RingDetected AND ZRequiredRings > 0 THEN _
  956.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  957.        RingDetected = ZFalse : _
  958.        GOTO 276
  959.     CALL GoIdle
  960.     GOTO 247
  961. 274 IF NOT RingBack THEN _
  962.        IF ConnectDetected THEN _
  963.           GOTO 321
  964.     IF ZRequiredRings = 0 THEN _
  965.        CALL DelayTime (3) : _
  966.        GOTO 321
  967. '
  968. '
  969. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  970. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  971. ' * "RING BACK."
  972. '
  973. '
  974. 276 CALL EofComm (Char)
  975.     IF Char <> -1 THEN _
  976.        CALL FlushCom(WasX$) : _
  977.        IF ZSubParm = - 1 THEN _
  978.           EXIT SUB
  979.     ZOutTxt$ = ZModemCountRingsCmd$
  980.     CALL ModemPut (ZOutTxt$)
  981.     CALL DelayTime (ZModemCmdDelayTime)
  982. 290 CALL FlushCom(WasX$)
  983.     IF ZSubParm = -1 THEN _
  984.        EXIT SUB
  985. 291 IF LEN(WasX$) = 0 THEN _
  986.        GOTO 310
  987. 292 IF INSTR(WasX$,"0") < 1 THEN _
  988.        GOTO 293
  989.     WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4)
  990. 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _
  991.        RingAnswer = ZTrue
  992. 300 RingBackCount = VAL(WasX$)
  993.     ZWasQ = RingBackCount + 1
  994.     IF (NOT RingAnswer) THEN _
  995.        ZWasQ = 0
  996. 305 LOCATE 20,56
  997.     CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
  998. 310 IF (RingBackCount + 1 < ZRequiredRings) OR _
  999.        (NOT RingAnswer) THEN _
  1000.        GOTO 239
  1001. 320 CALL ModemPut (ZModemAnswerCmd$)
  1002. '
  1003. '
  1004. ' *  TEST FOR Carrier PRESENT
  1005. '
  1006. '
  1007. 321 ConnectDelay! = TIMER + ZMaxCarrierWait
  1008. 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1009. 323 ZSubParm = -10
  1010.     CALL Carrier
  1011.     IF ZSubParm AND _
  1012.        TempElapsed! > 0 THEN _
  1013.        GOTO 322
  1014.     IF ZSubParm THEN _
  1015.        ZSubParm = 4 : _
  1016.        EXIT SUB
  1017.     CALL DelayTime (3)
  1018. 324 ZSubParm = 0
  1019.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1020.     IF TempElapsed! <= 0 THEN _
  1021.        CALL UpdtCalr ("Connect timeout",1) : _
  1022.        ZSubParm = 4 : _
  1023.        EXIT SUB
  1024. 325 CALL FlushCom(WasX$)
  1025.     IF ZSubParm = -1 THEN _
  1026.        IF ZErrCode = 69 THEN _
  1027.           ZSubParm = 5 : _
  1028.        EXIT SUB
  1029.     ModemResponse$ = ModemResponse$ + WasX$
  1030.     IF LEN(ModemResponse$) > 200 THEN _
  1031.        ModemResponse$ = RIGHT$(ModemResponse$,20)
  1032.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1033.     IF TempElapsed! <= 0 THEN _
  1034.        CALL UpdtCalr ("Connect timeout",1) : _
  1035.        ZSubParm = 4 : _
  1036.        EXIT SUB
  1037.     IF ZDumbModem THEN _
  1038.        ZBaudTest! = VAL(ZModemInitBaud$) : _
  1039.        GOTO 327
  1040.     IF INSTR(ModemResponse$,"FAST") THEN _
  1041.        ZBaudTest! = 19200 : _
  1042.        GOTO 327
  1043.     IF INSTR(ModemResponse$,"ONNECT") THEN _
  1044.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
  1045.        GOTO 327
  1046.     IF INSTR(ModemResponse$,"ONLINE") THEN _
  1047.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
  1048.        GOTO 327
  1049.     GOTO 324
  1050. 327 CALL TestRel (ModemResponse$)
  1051. 328 CALL SetBPS (ZBaudTest!,ZBPS)
  1052.     IF ZBPS = 0 THEN GOTO 324
  1053. 331 CALL SetBaud
  1054.     ZSubParm = 2
  1055. 335 DontWrite = 0
  1056.     END SUB
  1057. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  1058. ' $PAGE
  1059. '
  1060. '  NAME    -- TestRel
  1061. '
  1062. '  INPUTS  --     PARAMETER                    MEANING
  1063. '                 Strng$                 String to check for reliable
  1064. '
  1065. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  1066. '
  1067. '  PURPOSE -- To test for reliable connect
  1068. '
  1069.     SUB TestRel (Strng$) STATIC
  1070.     ZReliableMode = ZFalse
  1071.     IF Strng$ = "" THEN _
  1072.        EXIT SUB
  1073.     IF INSTR(Strng$,"REL") OR _
  1074.        INSTR(Strng$,"R C") OR _
  1075.        INSTR(Strng$,"ARQ") OR _
  1076.        INSTR(Strng$,"LAP") OR _
  1077.        INSTR(Strng$,"ECL") OR _
  1078.        INSTR(Strng$,"AFT") OR _
  1079.        INSTR(Strng$,"MNP") THEN _
  1080.          ZReliableMode = -1
  1081.     ZWasZ = INSTR(Strng$,"ARRIER ")
  1082.     IF ZWasZ > 0 THEN _
  1083.        IF VAL(MID$(Strng$,ZWasZ+6)) > 0 THEN _
  1084.           ZCBaud$ = STR$(VAL(MID$(Strng$,ZWasZ+6))) : _
  1085.           CALL Trim (ZCBaud$)
  1086.     END SUB
  1087. 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters'
  1088. ' $PAGE
  1089. '
  1090. '  NAME    -- BadChar
  1091. '
  1092. '  INPUTS  --     PARAMETER                    MEANING
  1093. '                 PassedName$                  USER NAME
  1094. '
  1095. '  OUTPUTS --    PassedName$            USER NAME WILL CONTAIN ""
  1096. '                                       IF BAD CHARACTERS Found
  1097. '
  1098. '  PURPOSE -- To check user names for invalid characters
  1099. '
  1100.     SUB BadChar (PassedName$) STATIC
  1101.     WasJ = 1
  1102.     WasXX = LEN(PassedName$)
  1103. 457 IF WasJ > WasXX THEN _
  1104.        EXIT SUB
  1105.     WasX$ = MID$(PassedName$,WasJ,1)
  1106.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _
  1107.        PassedName$ = "" : _
  1108.        EXIT SUB
  1109.     WasJ = WasJ + 1
  1110.     GOTO 457
  1111.     END SUB
  1112. 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords'
  1113. ' $PAGE
  1114. '
  1115. '  NAME    -- PassWrd
  1116. '
  1117. '  INPUTS  --     PARAMETER                    MEANING
  1118. '                 ZSubParm         = 1      VERIFY USER PASSWORD
  1119. '                                  = 2      VERIFY MESSAGE PASSWORD
  1120. '                                  = 3      VERIFY MESSAGE PASSWORD
  1121. '                                  = 4      VERIFY MESSAGE PASSWORD
  1122. '                                  = 5      VERIFY MESSAGE PASSWORD
  1123. '
  1124. '  OUTPUTS -- ZPswdFailed                   SET TO 0 IF PASSED
  1125. '                                           SET TO -1 IF FAILED
  1126. '
  1127. '  PURPOSE -- To verify user and message passwords
  1128. '
  1129.     SUB PassWrd STATIC
  1130.     ZErrCode = 0
  1131.     ON ZSubParm GOTO 665,667,670,675,677
  1132. 665 IF ZPswdSave$ = ZPswd$ THEN _
  1133.        ZPswdFailed = 0 : _
  1134.        EXIT SUB
  1135. 667 Attempts = 0
  1136. 670 Attempts = Attempts + 1
  1137.     IF Attempts > ZAttemptsAllowed THEN _
  1138.        ZPswdFailed = ZTrue : _
  1139.        EXIT SUB
  1140. 675 ZOutTxt$ = "Enter Password"
  1141.     ZHidden = ZTrue
  1142.     CALL PopCmdStack
  1143.     IF ZSubParm < 0 THEN _
  1144.        ZPswdFailed = ZTrue : _
  1145.        EXIT SUB
  1146.     ZHidden = ZFalse
  1147.     ZWasZ$ = ZUserIn$
  1148. 677 IF LEN(ZWasZ$) > 15 THEN _
  1149.        GOTO 680
  1150.     IF ZErrCode <> 0 THEN _
  1151.        GOTO 670
  1152.     CALL AllCaps (ZWasZ$)
  1153.     ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$))
  1154.     IF ZPswdSave$ = ZWasZ$ THEN _
  1155.        ZPswdFailed = 0 : _
  1156.        ZOutTxt$ = "" : _
  1157.        EXIT SUB
  1158. 680 CALL QuickTPut1 ("Wrong password ")
  1159.     ZLastIndex = 0
  1160.     IF NOT ZMsgPswd THEN _
  1161.        CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
  1162.     GOTO 670
  1163.     END SUB
  1164. 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25'
  1165. ' $PAGE
  1166. '
  1167. '  NAME    -- Line25
  1168. '
  1169. '  INPUTS  --     PARAMETER                    MEANING
  1170. '                 ZSubParm           = 1  BUILD DISPLAY FOR LINE 25
  1171. '                                    = 2  UPDATE LINE 25
  1172. '                 ZLockStatus$            STATUS OF LOCKS IN A MULTI-
  1173. '                                         USER ENVIRONMENT OR TIME OF
  1174. '                                         DAY USER LOGGED ON OR THE
  1175. '                                         RE-CYCLED
  1176. '
  1177. '  OUTPUTS -- ZCursorLine                 CURRENT LINE ON SCREEN
  1178. '             ZCursorRow                  CURRENT ROW ON ZCursorLine
  1179.  
  1180. '
  1181. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1182. '             on the PC screen that is running RBBS-PC.
  1183. '
  1184.       SUB Line25 STATIC
  1185.       IF ZSubParm = 2 THEN _
  1186.          GOTO 950
  1187. '
  1188. '
  1189. ' *  BUILD LINE 25 DISPLAY
  1190. '
  1191. '
  1192. 949 ZLine25$ = "Node " + _
  1193.                ZNodeID$ + " " + _
  1194.                ZPageStatus$ + " " + _
  1195.                MID$("AVL ",1, -4 * ZSysopAvail) + _
  1196.                MID$("ANY ",1, -4 * ZSysopAnnoy) + _
  1197.                MID$("LPT ",1, -4 * ZPrinter) + _
  1198.                MID$("SYS ",1, -4 * ZSysopNext) + _
  1199.                MID$("XOFF ",1,-5 * ZXOffEd) + _
  1200.                MID$("CTS ",1,-4 * ZNotCTS)
  1201. '
  1202. '
  1203. ' *  LINE 25 UPDATE ROUTINE
  1204. '
  1205. '
  1206. 950 IF NOT ZSnoop THEN _
  1207.        EXIT SUB
  1208.     ZCursorLine = CSRLIN
  1209.     ZCursorRow = POS(0)
  1210.     ZWasHH = LEN(ZActiveUserName$) + _
  1211.          LEN(ZWasCI$) + _
  1212.          LEN(ZLine25$) + _
  1213.          LEN(STR$(ZUserSecLevel))
  1214.     LOCATE 25,1
  1215.     IF ZNetworkType = 0 THEN _
  1216.        IF ZAutoDownYes THEN _
  1217.           ZLockStatus$ = " AD " + _
  1218.                          ZTimeLoggedOn$ _
  1219.        ELSE ZLockStatus$ = SPACE$(4) + _
  1220.                            ZTimeLoggedOn$
  1221.     IF ZWasHH > 63 THEN _
  1222.        ZWasHH = 0 _
  1223.     ELSE _
  1224.        ZWasHH = 64 - ZWasHH
  1225.     ZLine25Hold$ = ZLine25$ + _
  1226.                     SPACE$(ZWasHH) + _
  1227.                     STR$(ZUserSecLevel) + _
  1228.                     " " + _
  1229.                     ZActiveUserName$ + _
  1230.                     " " + _
  1231.                     ZWasCI$
  1232.     ZLine25Hold$ = LEFT$(ZLine25Hold$, 66) + " " + ZLockStatus$
  1233.     IF ZDosANSI THEN _
  1234.        ZLine25Hold$ = ZColorReset$ + ZLine25Hold$ + ZEmphasizeOff$
  1235.     CALL LPrnt(ZLine25Hold$,0)
  1236.     LOCATE ZCursorLine,ZCursorRow
  1237.     END SUB
  1238. 1238 ' $SUBTITLE: 'SearchCmd    - sub to search command list'
  1239. ' $PAGE
  1240. '
  1241. '  NAME    -- SearchCmd
  1242. '
  1243. '  INPUTS  -- PARAMETER             MEANING
  1244. '             StartPos         POSITION TO BEGIN SEARCH AT
  1245. '             ZAllOpts$        STRING TO SEARCH (COMMAND LIST)
  1246. '             ZWasZ$            WHAT TO LOOK FOR
  1247. '
  1248. '  OUTPUTS -- WhereFound   POSITION OF ZWasZ$ IN ZAllOpts$
  1249. '                           0 IF NOT Found
  1250. '
  1251. '  PURPOSE -- Searches valid command list for the requested
  1252. '             command.  If the sysop has configured RBBS-PC to
  1253. '             restrict commands to only those valid within the
  1254. '             RBBS-PC subsystem, then only those commands and
  1255. '             "GLOBAL" commands are valid.  Otherwise all commands
  1256. '             are valid from any of the RBBS-PC subsections.
  1257. '
  1258.      SUB SearchCmd (StartPos,WhereFound) STATIC
  1259. 1240 IF LEN(ZWasZ$) < 1 THEN _
  1260.         WhereFound = 0 : _
  1261.         EXIT SUB
  1262.      CALL Trim (ZWasZ$)
  1263.      CALL AllCaps (ZWasZ$)
  1264.      ZWasY$ = LEFT$(ZWasZ$,1)
  1265.      WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$)
  1266.      IF WhereFound = 0 THEN _  'Not found: decide whether to hunt further
  1267.         IF StartPos < 2 OR ZRestrictValidCmds THEN _
  1268.            GOTO 1242 _  ' fully searched or restricted
  1269.         ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further
  1270.              GOTO 1242
  1271.      IF WhereFound => ZBegLibrary THEN _
  1272.         IF WhereFound < LEN(ZAllOpts$) - 11 THEN _
  1273.            IF ZLibType = 0 THEN _
  1274.               WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _
  1275.               IF WhereFound = 0 THEN _
  1276.                  WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _
  1277.                  IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _
  1278.                     WhereFound = 0 : _
  1279.                     GOTO 1242
  1280.      IF NOT ZRestrictValidCmds THEN _
  1281.         GOTO 1242            ' everything found valid
  1282. '
  1283. '
  1284. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1285. '
  1286. '
  1287.      IF WhereFound > LEN(ZAllOpts$) - 11 THEN _
  1288.         IF ZUserSecLevel < ZOptSec(WhereFound) THEN _
  1289.            WhereFound = 0 : _
  1290.            EXIT SUB _
  1291.         ELSE GOTO 1242
  1292.      IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _
  1293.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS
  1294.      IF (WhereFound < StartPos) OR _
  1295.         (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _
  1296.         (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _
  1297.         (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _
  1298.            WhereFound = 0                 ' REJECT: NOT IN Section
  1299. 1242 IF WhereFound > 0 THEN _
  1300.         LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _
  1301.         EXIT SUB
  1302.      IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _
  1303.         EXIT SUB
  1304.      CALL Macro (ZWasZ$,Found)
  1305.      IF Found THEN _
  1306.         CALL FDMACEXE : _
  1307.         ZWasZ$ = ZUserIn$(1) : _
  1308.         GOTO 1240
  1309.      END SUB
  1310. 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process'
  1311. ' $PAGE
  1312. '
  1313. '  NAME    -- CheckMacro
  1314. '
  1315. '  INPUTS  -- PARAMETER             MEANING
  1316. '             Strng$               STRING TO CHECK IF IS A MACRO
  1317. '             ZMacroDrvPath$       DRIVE/PATH WHERE MACROS ARE
  1318. '             ZMacroExtension$     EXTENSION WasOF MACROS
  1319. '             MACRO.OFF            FORCE NO MACRO TO BE Found
  1320. '
  1321. '  OUTPUTS -- MacroFound           WHETHER A MACRO WAS Found
  1322. '             Strng$               SUBSTITUTE FOR COMMANDS
  1323. '             ZCommPortStack$      REST OF MACRO
  1324. '                                  0 IF NOT Found
  1325. '
  1326. '  PURPOSE -- Macro file is checked for security (1st line).
  1327. '             2nd line is substituted for passed string
  1328. '             and parsed.  Remaining part of macro put into
  1329. '             stack to be executed.
  1330. '
  1331.      SUB CheckMacro (Strng$,MacroFound) STATIC
  1332.      MacroFound = ZFalse
  1333.      IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _
  1334.         EXIT SUB
  1335.      IF LEN(Strng$) < ZMacroMin THEN _
  1336.         ZMacroMin = 1 : _
  1337.         EXIT SUB
  1338.      IF LEN(Strng$) = 1 THEN _
  1339.         Temp$ = Strng$ : _
  1340.         CALL AllCaps (Temp$) : _
  1341.         IF INSTR(ZAllOpts$,Temp$) > 0 THEN _
  1342.            EXIT SUB
  1343.      CALL Macro (Strng$,MacroFound)
  1344.      END SUB
  1345. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  1346. ' $PAGE
  1347. '
  1348. '  NAME    -- Macro
  1349. '
  1350. '  INPUTS  -- PARAMETER             MEANING
  1351. '             Strng$           STRING TO CHECK IF IS A MACRO
  1352. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  1353. '             ZMacroExtension$ EXTENSION OF MACROS
  1354. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  1355. '
  1356. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  1357. '             Strng$           SUBSTITUTE FOR COMMANDS
  1358. '             ZCommPortStack$  REST OF MACRO
  1359. '                              0 IF NOT Found
  1360. '
  1361. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1362. '             letter uses a command.
  1363.      SUB Macro (Strng$,MacroFound) STATIC
  1364.      MacroFound = ZFalse
  1365.      FilName$ = Strng$
  1366.      CALL BreakFileName (FilName$,ZWasDF$,Prefix$,WasX$,ZFalse)
  1367.      IF WasX$ = "" THEN _
  1368.         FilName$ = Strng$ + ZMacroExtension$
  1369.      IF ZWasDF$ = "" THEN _
  1370.         FilName$ = ZMacroDrvPath$ + FilName$
  1371.      CALL BadFile (FilName$,ZWasA)
  1372.      IF ZWasA > 1 THEN _
  1373.         EXIT SUB
  1374.      CALL GRAPHICX (FilName$,6)
  1375.      IF NOT ZOK THEN _
  1376.         EXIT SUB
  1377.      CALL ReadDir (6,1)
  1378.      IF ZErrCode > 0 THEN _
  1379.         EXIT SUB
  1380.      CALL CheckInt (ZOutTxt$)
  1381.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  1382.         EXIT SUB
  1383.      ZWasA = INSTR(ZOutTxt$,"/")
  1384.      IF ZWasA > 0 THEN _    ' Check macro contraint
  1385.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  1386.         IF RIGHT$(WasX$,1) = "/" THEN _
  1387.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  1388.               EXIT SUB _
  1389.            ELSE GOTO 1327 _
  1390.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  1391.                 EXIT SUB
  1392. 1327 ZMacroActive = ZTrue
  1393.      MacroFound = ZTrue
  1394.      ZMacroEcho = ZTrue
  1395.      END SUB
  1396. 1330 ' $SUBTITLE: 'ViewHelp    - Processes requests for help'
  1397. ' $PAGE
  1398. '
  1399. '  NAME    -- ViewHelp
  1400. '
  1401. '  INPUTS  -- PARAMETER             MEANING
  1402. '            Section             ORDER OF 1ST COMMAND IN CURRENT
  1403. '                                Section
  1404. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1405. '            HelpDefault$        HELP GET IF PRESS ENTER
  1406. '            ZHelpPath$
  1407. '            ZHelpExtension$
  1408. '            ZBegFile
  1409. '            ZBegMain
  1410. '            ZBegUtil
  1411. '            ZBegLibrary
  1412. '
  1413. '  OUTPUTS -- DISPLAYS HELP
  1414. '
  1415. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1416. '             optional menu.  Accepts help with individual commands.
  1417. '
  1418.      SUB ViewHelp (Section,HelpDefault$) STATIC
  1419.      HelpMenu$ = ZHelpPath$ + _
  1420.                   "HELP" + _
  1421.                   ZHelpExtension$
  1422.      SotMenu = ZTrue
  1423.      IF ZWasQ > 1 THEN _
  1424.         ZAnsIndex = 2 : _
  1425.         ZLastIndex = ZWasQ: _
  1426.         FastHelp = ZTrue : _
  1427.         GOTO 1332
  1428. 1331 IF SotMenu THEN _
  1429.         ZFileName$ = HelpMenu$ : _
  1430.         GOSUB 1350 : _
  1431.         SotMenu = ZFalse
  1432.      ZAnsIndex = 1
  1433.      ZOutTxt$ = "Help with what Command (or Topic name)" + _
  1434.           ZPressEnterExpert$
  1435.      ZSubParm = 1
  1436.      CALL TGet
  1437.      IF ZSubParm = -1 THEN _
  1438.         EXIT SUB
  1439.      IF ZWasQ = 0 THEN _
  1440.         EXIT SUB
  1441.      ZLastIndex = ZWasQ
  1442. 1332 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1443.      CALL AllCaps (ZWasZ$)
  1444.      IF ZWasZ$ = "?" THEN _
  1445.         ZWasZ$ = "H"
  1446.      CALL BadFile (ZWasZ$,BadFileNameIndex)
  1447.      ON BadFileNameIndex GOTO 1333,1340,1340
  1448. 1333 IF LEN(ZWasZ$) <> 1 THEN _
  1449.         GOTO 1335
  1450.      CALL SearchCmd (Section,ZFF)
  1451.      IF ZFF < 1 THEN _
  1452.         ZOK = ZFalse : _
  1453.         GOTO 1336
  1454.      IF ZFF > LEN(ZAllOpts$) - 11 THEN _
  1455.         IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _
  1456.            ZOK = ZFalse : _
  1457.            GOTO 1336 _
  1458.         ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _
  1459.              GOTO 1335 _
  1460.      ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _
  1461.           ZWasZ$ = MID$("MFU@",WasX,1) + _
  1462.                    MID$(ZOrigCommands$,ZFF,1)
  1463. 1335 ZFileName$ = ZHelpPath$ + _
  1464.                   ZWasZ$ + _
  1465.                   ZHelpExtension$
  1466.      GOSUB 1350
  1467. 1336 IF NOT ZOK THEN _
  1468.         ZOutTxt$ = "No help for " + _
  1469.              ZWasZ$ : _
  1470.         CALL QuickTPut1 (ZOutTxt$) : _
  1471.         CALL UpdtCalr (ZOutTxt$,2)
  1472.      ZAnsIndex = ZAnsIndex + 1
  1473.      IF ZAnsIndex <= ZLastIndex THEN _
  1474.         GOTO 1332
  1475.      IF FastHelp THEN _
  1476.         FastHelp = ZFalse : _
  1477.         EXIT SUB
  1478.      GOTO 1331
  1479. 1340 ZOK = ZFalse
  1480.      GOTO 1336
  1481. 1350 CALL Graphic (ZFileName$)
  1482.      CALL BufFile (ZFileName$,WasX)
  1483.      RETURN
  1484.      END SUB
  1485. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1486. ' $PAGE
  1487. '
  1488. '  NAME    -- SecViolation
  1489. '
  1490. '  INPUTS  --     PARAMETER                    MEANING
  1491. '
  1492. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  1493. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  1494. '
  1495. '  PURPOSE -- Inform caller of security violation, augment count of
  1496. '             violations and determine whether too many occurred.
  1497. '
  1498.      SUB SecViolation STATIC
  1499.      CALL FlushKeys
  1500.      CALL BufFile (ZSecVioHelp$,WasX)
  1501.      IF NOT ZOK THEN _
  1502.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  1503.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  1504.      ZLastIndex = 0
  1505.      CALL Muzak (3)
  1506.      ZViolationsThisSession = ZViolationsThisSession + 1
  1507.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  1508.         EXIT SUB
  1509. 1385 IF ZUserFileIndex < 1 THEN _
  1510.         EXIT SUB
  1511.      ZOutTxt$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1512.      IF ZUserSecLevel <= ZMinLogonSec THEN _
  1513.         ZOutTxt$ = "" : _
  1514.         ZUserSecLevel = ZUserSecLevel - 1 _
  1515.      ELSE ZUserSecLevel = ZMinLogonSec
  1516.      ZDenyAccess = ZTrue
  1517.      END SUB
  1518. 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
  1519. ' $PAGE
  1520. '
  1521. '  NAME    -- DenyAccess
  1522. '
  1523. '  INPUTS  --     PARAMETER                    MEANING
  1524. '
  1525. '  OUTPUTS -- (USER'S RECORD)
  1526. '
  1527. '  PURPOSE -- Permanently resets user's security level when access denied
  1528. '
  1529.      SUB DenyAccess STATIC
  1530.      CALL TPut
  1531.      ZLogonErrorIndex = 5
  1532.      ZSubParm = 6
  1533.      CALL FileLock
  1534.      CALL OpenUser (ZHighestUserRecord)
  1535.      FIELD 5, 128 AS ZUserRecord$
  1536.      GET 5,ZUserFileIndex
  1537.      MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
  1538.      PUT 5,ZUserFileIndex
  1539.      ZSubParm = 8
  1540.      CALL FileLock
  1541.      END SUB
  1542. 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port'
  1543. ' $PAGE
  1544. '
  1545. '  NAME    -- TPut (TERMINAL PUT)
  1546. '
  1547. '  INPUTS  --     PARAMETER                    MEANING
  1548. '                     ZOutTxt$                 STRING TO WRITE TO THE
  1549. '                                              COMMUNICATIONS PORT
  1550. '                 ZSubParm = 1           SKIP A LINE BEFORE WRITING
  1551. '                                        TO THE COMMUNICATIONS PORT
  1552. '                          = 2           SKIP A LINE BEFORE WRITING
  1553. '                                        TO THE COMMUNICATIONS PORT
  1554. '                                        AND THEN SKIP TWO LINES
  1555. '                                        AFTER WRITING TO THE COMM-
  1556. '                                        UNICATIONS PORT
  1557. '                           = 3          WRITE TO THE COMMUNICATIONS
  1558. '                                        PORT AND THEN SKIP TWO LINES
  1559. '                           = 4          WRITE TO THE COMMUNICATIONS
  1560. '                                        PORT WITHOUT A CR/LF
  1561. '                           = 5          WRITE TO THE COMMUNICATIONS
  1562. '                                        PORT WITH A CR/LF
  1563. '                           = 6          RESET EVERYTHING FOR INPUT STRING
  1564. '                           = 7          RE-ENTRY AFTER HANDLING A
  1565. '                                        FUNCTION KEY
  1566. '
  1567. '  OUTPUTS --  ZSubParm = -1 Carrier HAS BEEN DROPPED
  1568. '              ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1569. '
  1570. '  PURPOSE --  Common output routine for RBBS-PC to the
  1571. '              communications port (terminal put)
  1572.       SUB TPut STATIC
  1573.       IF ZSubParm <> 7 THEN _
  1574.          Parm = ZSubParm
  1575.       ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411
  1576. '
  1577. '
  1578. ' *  COMMON OUTPUT ROUTINE
  1579. '
  1580. '
  1581. 1398 CALL SkipLine (1)
  1582.      GOTO 1405
  1583. 1399 CALL SkipLine (1)
  1584. 1400 ZCR = 1
  1585. 1403 ZCR = ZCR + 1
  1586. 1405 ZRet = ZFalse
  1587.      IF ZWasCM THEN _
  1588.         GOTO 1435
  1589. 1410 CALL FindFKey
  1590.      IF ZSubParm < 0 THEN _
  1591.         EXIT SUB
  1592. 1411 ZWasY$ = ZKeyPressed$
  1593.      ZSubParm = Parm
  1594.      IF ZLocalUser THEN _
  1595.         GOTO 1430
  1596.      CALL EofComm (Char)
  1597.      IF Char = -1 THEN _
  1598.         CALL CheckCarrier : _
  1599.         IF ZSubParm = -1 THEN _
  1600.            EXIT SUB _
  1601.         ELSE GOTO 1430
  1602.      CALL GetCom(ZWasY$)
  1603. 1425 IF ZSubParm = -1 THEN _
  1604.         EXIT SUB
  1605. 1430 IF ZWasY$ = "" THEN _
  1606.         GOTO 1435
  1607.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  1608.      GOSUB 1476
  1609. '    IF ZTurboKey THEN IF NOT ZStopInterrupts THEN _
  1610. '       GOTO 1471
  1611.      GOTO 1435
  1612. 1433 GOSUB 1476
  1613.      IF ASC(RIGHT$(ZCommPortStack$,2)) = 13 OR _
  1614.         ZStopInterrupts THEN _
  1615.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1616.      GOTO 1471
  1617. 1434 IF ZStopInterrupts THEN _
  1618.         GOTO 1435
  1619.      ZCommPortStack$ = ""
  1620.      IF ZFossil THEN _
  1621.         CALL FOSTXPurge(ZComPort) : _
  1622.         CALL FosRXPurge(ZComPort)
  1623.      GOTO 1471
  1624. 1435 LOCATE ,,1
  1625.      CALL LPrnt (ZOutTxt$,0)
  1626. 1437 IF ZUpperCase THEN _
  1627.         IF ZWasGR <> 2 THEN _
  1628.            CALL AllCaps (ZOutTxt$)
  1629.      CALL PutCom (ZOutTxt$)
  1630. 1450 IF ZCR <> 1 THEN _
  1631.         CALL SkipLine (1) _
  1632.      ELSE IF ZCR > 1 THEN _
  1633.              CALL SkipLine (1)
  1634. 1470 ZCR = 0
  1635.      EXIT SUB
  1636. 1471 IF ZOutTxt$ <> "" THEN _ ' interrupt the display
  1637.         CALL SkipLine (1)
  1638.      ZStopInterrupts = ZFalse
  1639.      ZRet = ZTrue
  1640.      ZNo = ZTrue
  1641.      ZNonStop = ZFalse
  1642.      GOTO 1470
  1643. 1473 ZXOffEd = ZTrue
  1644.      GOTO 1410
  1645. 1475 ZXOffEd = ZFalse
  1646.      GOTO 1410
  1647. 1476 IF ASC(ZWasY$) < 127 THEN _
  1648.         ZCommPortStack$ = ZCommPortStack$ + ZWasY$
  1649.      RETURN
  1650.      END SUB
  1651. 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
  1652. ' $PAGE
  1653. '
  1654. '  NAME    -- QuickTPut
  1655. '
  1656. '  INPUTS  -- PARAMETER             MEANING
  1657. '             Strng$             STRING TO WRITE OUT
  1658. '             NumReturns         NUMBER OF CARRIAGE RETURNS
  1659. '
  1660. '  OUTPUTS -- NONE
  1661. '
  1662. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1663. '             different from "TPut" in the things it doesn't do:
  1664. '                A.) No function key check,
  1665. '                B.) No conversion to upper case,
  1666. '                C.) No check for carrier present
  1667. '                D.) No check for imbedded carriage return in "Strng$"
  1668. '                E.) No support for XON/XOff
  1669. '
  1670.       SUB QuickTPut (Strng$,NumReturns) STATIC
  1671.       IF ZSubParm < 0 THEN _
  1672.          EXIT SUB
  1673.       IF ZUseTPut THEN _
  1674.          ZOutTxt$ = Strng$ : _
  1675.          ZSubParm = 4 : _
  1676.          CALL TPut : _
  1677.          CALL SkipLine (NumReturns) : _
  1678.          EXIT SUB
  1679.       CALL PutCom (Strng$)
  1680.       LOCATE ,,1
  1681.       CALL LPrnt (Strng$,0)
  1682.       CALL SkipLine (NumReturns)
  1683.       END SUB
  1684.       SUB QuickTPut1 (Strng$) STATIC
  1685.       CALL QuickTPut (Strng$,1)
  1686.       END SUB
  1687. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  1688. ' $PAGE
  1689. '
  1690. '  NAME    -- LPrnt
  1691. '
  1692. '  INPUTS  -- PARAMETER             MEANING
  1693. '             Strng$        STRING TO WRITE OUT
  1694. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  1695. '
  1696. '  OUTPUTS -- NONE
  1697. '
  1698. '  PURPOSE -- Subroutine to write to the display.
  1699. '
  1700.       SUB LPrnt (Strng$,NumReturns) STATIC
  1701.       IF NOT ZSnoop THEN _
  1702.          EXIT SUB
  1703.       CALL PScrn (Strng$)
  1704.       IF ZVoiceType <> 0 AND ZTalkAll THEN _
  1705.          CALL Talk (65,Strng$)
  1706.       IF ZUseBASICWrites THEN _
  1707.          FOR WasI = 1 TO NumReturns : _
  1708.             PRINT : _
  1709.          NEXT : _
  1710.       ELSE FOR WasI = 1 TO NumReturns : _
  1711.               LOCATE ,,1 : _
  1712.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1713.               LOCATE ZWasCL,ZWasCC : _
  1714.               NEXT
  1715.       END SUB
  1716. 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display'
  1717. ' $PAGE
  1718. '
  1719. '  NAME    -- QuickLPrnt
  1720. '
  1721. '  INPUTS  -- PARAMETER             MEANING
  1722. '             Strng$        STRING TO WRITE OUT
  1723. '             Num           NUMBER OF CARRIAGE RETURNS
  1724. '
  1725. '  OUTPUTS -- NONE
  1726. '
  1727. '  PURPOSE -- Subroutine to quickly write to the display.
  1728. '             Overwrites, and puts up count
  1729.       SUB QuickLPrnt (Strng$,Num) STATIC
  1730.       IF ZSnoop THEN _
  1731.          LOCATE ,1,1 : _
  1732.          CALL Pscrn (Strng$ + STR$(Num))
  1733.       END SUB
  1734. 1483 ' $SUBTITLE: 'PScrn    - subroutine to print to the screen'
  1735. ' $PAGE
  1736. '
  1737. '  NAME    -- PScrn
  1738. '
  1739. '  INPUTS  -- PARAMETER             MEANING
  1740. '             Strng$        STRING TO WRITE OUT
  1741. '
  1742. '  OUTPUTS -- NONE
  1743. '
  1744. '  PURPOSE -- Writes to local screen regardless of whether you have
  1745. '             carrier.  Assumes have positioned cursor where you want.
  1746. '
  1747.       SUB PScrn (Strng$) STATIC
  1748.       IF Strng$ = "" THEN _
  1749.          EXIT SUB
  1750.       IF ZUseBASICWrites THEN _
  1751.          PRINT Strng$; _
  1752.       ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _
  1753.            LOCATE ZWasCL,ZWasCC
  1754.       END SUB
  1755. 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user'
  1756. ' $PAGE
  1757. '
  1758. '  NAME    -- SkipLine
  1759. '
  1760. '  INPUTS  --   PARAMETER             MEANING
  1761. '               ZLocalUser
  1762. '               ZModemStatusReg
  1763. '               NumReturns
  1764. '               ZReturnLineFeed$
  1765. '               ZSnoop
  1766. '
  1767. '  OUTPUTS -- NONE
  1768. '
  1769. '  PURPOSE -- Skip lines on the user's terminal
  1770. '
  1771.       SUB SkipLine (NumReturns) STATIC
  1772.       FOR WasI=1 TO NumReturns
  1773.           CALL PutCom (ZReturnLineFeed$)
  1774.       NEXT
  1775.       IF NOT ZSnoop THEN _
  1776.          GOTO 1486
  1777.       IF ZUseBASICWrites THEN _
  1778.          FOR WasI = 1 TO NumReturns : _
  1779.             PRINT : _
  1780.          NEXT _
  1781.       ELSE FOR WasI = 1 TO NumReturns : _
  1782.               LOCATE ,,1 : _
  1783.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1784.               LOCATE ZWasCL,ZWasCC : _
  1785.            NEXT
  1786. 1486  ZLinesPrinted = ZLinesPrinted + NumReturns
  1787.       ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns
  1788.       END SUB
  1789. 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output'
  1790. ' $PAGE
  1791. '
  1792. '  NAME    -- SetCrLf
  1793. '
  1794. '  INPUTS  --   PARAMETER          MEANING
  1795. '              ZCarriageReturn$    CARRIAGE RETURN CHARACTER
  1796. '              ZLineFeed$          LINE FEED CHARACTER
  1797. '              ZLineFeeds          LINE FEED Switch
  1798. '              ZNul$                NULL CHARACTER
  1799. '
  1800. '  OUTPUTS -- ZReturnLineFeed$   END-OF-LINE STRING
  1801. '
  1802. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1803. '             each output to the communications port with.
  1804. '
  1805.       SUB SetCrLf STATIC
  1806.       ZReturnLineFeed$ = _
  1807.          MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _
  1808.          ZNul$ + _
  1809.          MID$(ZLineFeed$,1, - (ZLineFeeds <> 0))
  1810.       END SUB
  1811. 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply'
  1812. ' $PAGE
  1813. '
  1814. '  NAME    -- TGet
  1815. '
  1816. '  INPUTS  --    PARAMETER                   MEANING
  1817. '                ZSubParm          = 1  STANDARD ENTRY
  1818. '                                  = 2  ENTRY AFTER A FUNCTION KEY
  1819. '                                         HAS BEEN HANDLED
  1820. '                                  = 3  ENTRY AFTER STACKED COMMAND
  1821. '             ZOutTxt$                        STRING TO WRITE TO THE
  1822. '                                       COMMUNICATIONS PORT
  1823. '             ZHidden                    IF THIS IS TRUE THEN ECHO
  1824. '                                       '.' INSTEAD OF ACTUAL
  1825. '                                       CHARACTER ENTERED.
  1826. '             ZForceKeyboard            IF TRUE, STACKED INPUT
  1827. '                                       IS BYPASSED AND KEYBOARD
  1828. '                                       INPUT IS READ.
  1829. '
  1830. '  OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED
  1831. '             ZUserIn$                  STRING THAT WAS ENTERED
  1832. '             ZWasQ                     NUMBER OF PARAMETERES THAT
  1833. '                                       WERE ENTERED WHICH WHERE
  1834. '                                       SEPARATED BY A SEMICOLON
  1835. '             ZUserIn$()                STRING MATRIX WITH EACH
  1836. '                                       ITEM CONTAIN THE STRING
  1837. '                                       THAT WAS ENTERED BETWEEN
  1838. '                                       SEMICOLONS.
  1839. '             ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1840. '             ZYes                      Reply IS "Y" OR "YES"
  1841. '             ZNo                       Reply IS "N" OR "NO"
  1842. '             ZNonStop                  Reply IS "NS" OR "ns"
  1843. '             ZKillMessage              Reply IS "K"
  1844. '             ZReply                    Reply IS "RE"
  1845. '
  1846. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1847. '
  1848.      SUB TGet STATIC
  1849.      MacroIndex = ZForceKeyboard
  1850.      ON ZSubParm GOTO 1500,1538,1625
  1851. '
  1852. '
  1853. ' *  COMMON INPUT ROUTINE
  1854. '
  1855. '
  1856. 1500 CALL Carrier
  1857.      IF ZSubParm = -1 THEN _
  1858.         EXIT SUB
  1859.      ZLinesPrinted = 0
  1860.      ZDisplayAsUnit = ZFalse
  1861.      InStack = ZFalse
  1862.      GOSUB 1580
  1863.      ZWasA = 0
  1864.      ZWasB = 0
  1865.      ZWasC = 0
  1866.      ZWasQ = 1
  1867.      ZStoreParseAt = 1
  1868.      ZYes = ZFalse
  1869.      ZUserIn$ = ""
  1870.      SleepWarn = ZTrue
  1871.      ZNo = ZFalse
  1872.      ZNonStop = (ZPageLength < 1)
  1873.      IF ZOutTxt$ = "" THEN _
  1874.         GOTO 1525
  1875.      IF ZHidden THEN _
  1876.         ZOutTxt$ = ZOutTxt$ + " (dots echo)"
  1877.      IF (NOT ZVerifying) OR HoldA$ = "" THEN _
  1878.         CALL ColorPrompt (ZOutTxt$) : _
  1879.         ZOutTxt$ = ZOutTxt$ + _
  1880.              MID$("? !  ",2*ZTurboKey+1,2) : _
  1881.         HoldA$ = ZOutTxt$ _
  1882.      ELSE ZOutTxt$ = HoldA$
  1883.      ZSubParm = 4
  1884.      StopSave = ZStopInterrupts
  1885.      ZStopInterrupts = ZTrue
  1886.      CALL TPut
  1887.      ZStopInterrupts = StopSave
  1888.      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1889.         EXIT SUB
  1890. 1523 IF ZPromptBell THEN _
  1891.         IF ZLocalUser THEN _
  1892.            BEEP_
  1893.         ELSE CALL PutCom(ZBellRinger$)
  1894. 1525 CALL Carrier
  1895.      IF ZSubParm = -1 THEN _
  1896.         EXIT SUB
  1897.      IF LEN(ZCommPortStack$) > 0 THEN _
  1898.         InStack = ZTrue : _
  1899.         WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _
  1900.         IF WasX > 0 THEN _
  1901.            ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _
  1902.            ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _
  1903.            GOTO 1534 _
  1904.         ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _
  1905.              ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  1906.              GOTO 1541
  1907.      IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _
  1908.         GOTO 1536
  1909. '
  1910. ' *** MACRO PROCESSING
  1911. '
  1912. 1526 CALL ReadMacro
  1913.      IF ZMacroSave > 0 THEN _
  1914.         GOTO 1500
  1915.      IF NOT ZMacroActive THEN _
  1916.         ZWasQ = 0 : _
  1917.         ZLastIndex = 0 : _
  1918.         EXIT SUB
  1919.      IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _
  1920.         GOTO 1536
  1921. 1534 ZUserIn$ = ZOutTxt$   ' Not Macro command - pass to normal processing
  1922.      IF ZMacroEcho THEN _
  1923.         ZSubParm = 4 : _
  1924.         CALL TPut
  1925.      WasX$ = ZCarriageReturn$
  1926.      GOTO 1547
  1927. 1536 IF ZLocalUser THEN _
  1928.         GOTO 1537
  1929.      CALL EofComm (Char)
  1930.      IF Char <> -1 THEN _
  1931.         CALL GetCom(ZWasY$) : _
  1932.         IF ZSubParm = -1 THEN _
  1933.            EXIT SUB _
  1934.         ELSE GOTO 1541
  1935. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  1936.      IF TempElapsed! < 30 THEN _
  1937.         IF TempElapsed! <= 0 THEN _
  1938.            CALL SkipLine (1) : _
  1939.            ZSubParm = -1 : _
  1940.            ZNo = ZTrue : _
  1941.            ZRet = ZTrue : _
  1942.            ZSleepDisconnect = NOT ZAutoLogoffReq : _
  1943.            IF ZAutoLogoffReq THEN _
  1944.               CALL UpdtCalr ("Auto-logoff",1): _
  1945.               EXIT SUB _
  1946.            ELSE CALL UpdtCalr ("Sleep disconnect",1) : _
  1947.                 EXIT SUB _
  1948.         ELSE IF SleepWarn THEN _
  1949.                 SleepWarn = ZFalse : _
  1950.                 Temp! = TempElapsed! : _
  1951.                 ZOutTxt$ = "Auto-Logoff in 30 seconds..." : _
  1952.                 CALL RingCaller : _
  1953.                 CALL QuickTput ("Press Enter to cancel  30",0) _
  1954.              ELSE IF Temp! - TempElapsed! > 1.0 THEN _
  1955.                      CALL QuickTPut (ZBackSpace$+ZBackSpace$,0) : _
  1956.                      CALL QuickTPut (RIGHT$(STR$(CINT(TempElapsed!)),2),0) : _
  1957.                      Temp! = TempElapsed!                 
  1958.      CALL FindFKey
  1959.      IF ZSubParm < 0 THEN _
  1960.         EXIT SUB
  1961. 1538 ZWasY$ = ZKeyPressed$
  1962.      IF ZWasY$ <> "" THEN _
  1963.         GOTO 1545
  1964.      SendRemote = ZTrue
  1965.      CALL GoIdle
  1966.      GOTO 1525
  1967. 1541 SendRemote = ZRemoteEcho
  1968.      IF ZTestParity THEN _
  1969.         GOTO 1542
  1970.      IF ZWasY$ = CHR$(127) THEN _
  1971.         GOTO 1635
  1972.      GOTO 1545
  1973. 1542 IF ZWasY$ = "" THEN _
  1974.         ZWasY$ = " "
  1975.      IF ASC(ZWasY$) = 141 THEN _
  1976.         OUT ZLineCntlReg,&H1A : _
  1977.         ZEightBit = ZFalse : _
  1978.         ZTestParity = ZFalse : _
  1979.         ZWasGR = ZFalse
  1980.      ZWasY$ = CHR$(ASC(ZWasY$) AND 127)
  1981. 1545 WasX$ = ZWasY$
  1982.      ZAutoLogoffReq = ZFalse
  1983.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  1984.         GOTO 1635
  1985.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  1986.         GOTO 1525
  1987.      IF ZWasY$ = "^" THEN _
  1988.         GOTO 1525
  1989.      IF ZWasY$ = ZCarriageReturn$ THEN _
  1990.         GOTO 1547 _
  1991.      ELSE GOSUB 1550
  1992.      IF ZTurboKey < 1 THEN _
  1993.         GOTO 1546
  1994.      IF ZWasY$ = " " THEN _
  1995.         ZWasY$ = ""
  1996.      IF ZWasY$ <> "/" THEN _
  1997.         ZUserIn$ = ZWasY$ : _
  1998.         ZWasY$ = ZCarriageReturn$ : _
  1999.         WasX$ = ZWasY$ : _
  2000.         GOTO 1547
  2001.      ZTurboKey = 0
  2002.      GOTO 1525
  2003. 1546 IF LEN(ZUserIn$) => 512 THEN _
  2004.         ZOutTxt$ = "Input too long!" : _
  2005.         ZSubParm = 5 : _
  2006.         CALL TPut : _
  2007.         ZWasY$ = ZCarriageReturn$ : _
  2008.         WasX$ = ZWasY$ : _
  2009.         GOTO 1547
  2010.      ZUserIn$ = ZUserIn$ + _
  2011.           ZWasY$
  2012.      GOTO 1525
  2013. 1547 ZTurboKey = ZFalse          ' Carriage Return Handler
  2014.      ZHidden = ZFalse
  2015.      IF ZNoAdvance THEN _
  2016.         ZNoAdvance = ZFalse : _
  2017.         GOTO 1575 _
  2018.      ELSE CALL LPrnt (ZCrLf$,0) : _
  2019.           GOSUB 1551 : _
  2020.           GOTO 1570
  2021. 1549 IF INSTR(ZUserIn$,";") > 0 THEN _
  2022.         CALL ExcludeCount (";",ZUserIn$,Temp) _
  2023.      ELSE IF INSTR(ZUserIn$," ") > 0 THEN _
  2024.         CALL ExcludeCount (" ",ZUserIn$,Temp) _
  2025.      ELSE Temp = 0
  2026.      RETURN
  2027. 1550 IF ZLogonActive THEN _
  2028.         GOSUB 1549 : _
  2029.         ZHidden = (Temp = 2 - (ZLenIndiv > 0 AND ZStartIndiv > 0))
  2030.      IF ZHidden THEN _
  2031.         IF (WasX$ <> " " AND WasX$ <> ";") THEN _
  2032.            WasX$ = "."
  2033.      CALL LPrnt(WasX$,0)
  2034. 1551 IF NOT SendRemote THEN _
  2035.         RETURN
  2036.      IF ZHidden AND (WasX$ <> " ") THEN _
  2037.         WasX$ = "."
  2038. 1553 CALL PutCom (WasX$)
  2039.      RETURN
  2040. 1570 IF SendRemote THEN _
  2041.         IF ZLineFeeds THEN _
  2042.            CALL PutCom (ZLineFeed$)
  2043. 1575 IF LEN(ZUserIn$) > 4000 THEN _
  2044.         ZOutTxt$ = "Try again, " + _
  2045.              ZFirstName$ : _
  2046.         ZSubParm = 5 : _
  2047.         CALL TPut : _
  2048.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2049.            EXIT SUB _
  2050.         ELSE GOTO 1500
  2051.      IF ZParseOff THEN _
  2052.         ZParseOff = ZFalse : _
  2053.         GOTO 1620
  2054.      CALL ParseIt
  2055.      IF ZWasQ = 1 THEN _
  2056.         GOTO 1622
  2057.      GOTO 1625
  2058. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2059.      IF ZAutoLogoffReq OR ZWaitExpired THEN _
  2060.         ZWaitExpired = ZFalse : _
  2061.         IF NOT ZSuspendAutologoff THEN _
  2062.            ZAutoLogoff! = TIMER + 30
  2063.      RETURN
  2064. 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$
  2065.      ZWasQ = 1
  2066. 1622 IF ZUserIn$ = "" THEN _
  2067.         ZWasQ = 0 : _
  2068.         ZHidden = ZFalse : _
  2069.         GOTO 1628
  2070. 1625 IF LEN(ZUserIn$) < 4 THEN _
  2071.         WasX$ = LEFT$(ZUserIn$,3): _
  2072.         CALL AllCaps (WasX$) : _
  2073.         ZYes = (INSTR("YES",WasX$) = 1) : _
  2074.         ZNo = (INSTR("NO",WasX$) = 1 OR WasX$ = "A" OR WasX$ = "Q") : _
  2075.         ZReply = (WasX$ = "RE") OR ZReply : _
  2076.         ZKillMessage = (WasX$ = "K") OR ZKillMessage
  2077.      ZHidden = ZFalse
  2078. 1628 CALL VerifyAns
  2079.      IF NOT ZOK THEN _
  2080.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  2081.         GOTO 1500
  2082.      HoldA$ = ""
  2083.      ZForceKeyboard = ZFalse
  2084.      IF ZMacroSave > 0 THEN _
  2085.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  2086.         ZMacroSave = 0 : _
  2087.         GOTO 1632
  2088.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  2089.         CALL WipeLine (38) : _
  2090.         IF NOT ZNo THEN _
  2091.            GOTO 1632 _
  2092.         ELSE ZWasQ = 0 : _
  2093.              ZMacroTemplate$ = "" : _
  2094.              ZDistantTGet = 0 : _
  2095.              ZNo = ZFalse : _
  2096.              GOTO 1633
  2097.      IF ZMacroActive THEN _
  2098.         ZLastIndex = ZWasQ : _
  2099.         FirstIndex = 1: _
  2100.         ZMacroActive = NOT EOF(6) : _
  2101.         EXIT SUB
  2102.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  2103.         EXIT SUB
  2104.      IF MacroIndex OR ZSubParm < 3 THEN _
  2105.         MacroIndex = 1 _
  2106.      ELSE MacroIndex = ZAnsIndex
  2107.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  2108.      IF Found THEN _
  2109.         EXIT SUB
  2110.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  2111.      IF Found THEN _
  2112.         ZStoreParseAt = ZAnsIndex : _
  2113.         GOTO 1525
  2114.      EXIT SUB
  2115. 1632 ZUserIn$ = ""
  2116.      ZForceKeyboard = ZFalse
  2117. 1633 GOSUB 1580
  2118.      ZWasQ = 1
  2119.      GOTO 1525
  2120. 1635 IF LEN(ZUserIn$) = 0 THEN _
  2121.         GOTO 1525
  2122.      ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
  2123.      CALL LPrnt(ZLocalBksp$,0)
  2124.      IF SendRemote THEN _
  2125.         CALL PutCom(ZBackSpace$)
  2126.      GOTO 1525
  2127.      END SUB
  2128. 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
  2129. ' $PAGE
  2130. '
  2131. '  NAME    -- RingCaller
  2132. '
  2133. '  INPUTS  --     PARAMETER                    MEANING
  2134. '                 ZOutTxt$                           STRING TO EMPHASIZE
  2135. '
  2136. '  OUTPUTS --  none
  2137. '
  2138. '  PURPOSE --  Rings the users bell before and after string
  2139. '              (but not snooping sysop) and adds emphasis around
  2140. '              message sent.
  2141. '
  2142.      SUB RingCaller STATIC
  2143.      WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
  2144.      CALL PutCom (ZBellRinger$)
  2145.      CALL LPrnt (WasX$,0)
  2146.      ZSubParm = 2
  2147.      ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
  2148.      CALL TPut
  2149.      CALL PutCom (ZBellRinger$)
  2150.      CALL LPrnt (WasX$,0)
  2151.      END SUB
  2152. 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string'
  2153. ' $PAGE
  2154. '
  2155. '  NAME    -- ParseIt
  2156. '
  2157. '  INPUTS  --     PARAMETER              MEANING
  2158. '                 ZUserIn$             STRING TO PARSE
  2159. '                 ZSemiOnly            Only parse using semi-colon
  2160. '
  2161. '  OUTPUTS --  ZWasQ                   NUMBER PARSED
  2162. '              ZUserIn$()              PARSED STRINGS
  2163. '
  2164. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2165. '              if exists, otherwise space, otherwise comma
  2166. '
  2167.      SUB ParseIt STATIC
  2168.      ZWasA = INSTR(ZUserIn$,";")
  2169.      IF ZWasA > 0 THEN _
  2170.         ParseChar$ = ";" _
  2171.      ELSE IF ZSemiOnly THEN _
  2172.              ZSemiOnly = ZFalse : _
  2173.              GOTO 1638 _
  2174.           ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _
  2175.              CALL Trim (ZUserIn$) : _
  2176.              WasX$ = ZUserIn$ : _
  2177.              ZWasA = INSTR(ZUserIn$,"  ") : _
  2178.              WHILE ZWasA > 0 : _
  2179.                 ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _
  2180.                      MID$(ZUserIn$,ZWasA + 1) : _
  2181.                 ZWasA = INSTR(ZWasA,ZUserIn$,"  ") : _
  2182.              WEND : _
  2183.              ZWasA = INSTR(ZUserIn$," ") : _
  2184.              IF ZWasA > 1 THEN _
  2185.                 ParseChar$ = " " _
  2186.              ELSE ZWasA = INSTR(ZUserIn$,",") : _
  2187.                   ParseChar$ = ","
  2188.      IF ZWasA > 1 THEN _
  2189.         GOTO 1639
  2190. 1638 ZWasDF$ = ZUserIn$
  2191.      CALL AllCaps (ZWasDF$)
  2192.      IF ZWasDF$ = "NS" THEN _
  2193.          ZUserIn$ = "C" : _
  2194.          ZNonStop = ZTrue
  2195.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  2196.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  2197.      GOTO 1642
  2198. 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1)
  2199.      ZWasA = ZWasA + 1
  2200.      ZEOL = ZFalse
  2201. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  2202.      ZWasC = ZWasB-ZWasA
  2203.      IF ZWasC < 1 THEN _
  2204.         ZEOL = ZTrue : _
  2205.         ZWasC = 128
  2206.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  2207.      IF ZWasDF$ = "" THEN GOTO 1641
  2208.         ZWasQ = ZWasQ + 1
  2209.         ZStoreParseAt = ZStoreParseAt + 1
  2210.         ZUserIn$(ZStoreParseAt) = ZWasDF$
  2211.         CALL AllCaps(ZWasDF$)
  2212.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";")
  2213.         IF WasX = 0 THEN GOTO 1641
  2214.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC)
  2215.      IF ZStoreParseAt > 1 THEN IF INSTR("Jj",ZUserIn$(ZStoreParseAt-1)) THEN _
  2216.         ZNonStop = (ZPageLength < 1)
  2217.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4)
  2218.            IF ZAutoLogoffReq THEN CALL QuickTPut1 ("Auto-logoff, if successful")
  2219.            IF ZWasQ > 0 AND WasX < 7 THEN _
  2220.               ZWasQ = ZWasQ - 1 : _
  2221.               ZStoreParseAt = ZStoreParseAt - 1
  2222. 1641 IF NOT ZEOL AND ZWasQ < 50 THEN _
  2223.         ZWasA = ZWasB + 1 : _
  2224.         GOTO 1640
  2225.      IF ParseChar$ <> ";" THEN _
  2226.         ZUserIn$ = WasX$
  2227. 1642 ZStackC = ZFalse
  2228.      END SUB
  2229. 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check'
  2230.      SUB PopCmdStack STATIC
  2231.      CALL CheckCarrier
  2232.      IF ZSubParm = -1 THEN _
  2233.         ZLastIndex = 0 : _
  2234.         ZWasQ = 0 : _
  2235.         EXIT SUB
  2236.      ZWasQ = 1
  2237. 1651 IF ZAnsIndex < ZLastIndex THEN _
  2238.         ZAnsIndex = ZAnsIndex + 1 : _
  2239.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  2240.         IF MID$(ZLastCommand$,2,1) <> " " AND (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _
  2241.            GOTO 1651 _
  2242.         ELSE ZSubParm = 3 : _
  2243.              ZTurboKey = 0 : _
  2244.              CALL TGet : _
  2245.              GOTO 1652
  2246.      ZLastIndex = 0
  2247.      ZAnsIndex = 1
  2248.      ZSubParm = 1
  2249.      ZSearchingAll = ZFalse
  2250.      CALL TGet
  2251.      ZLastIndex = ZWasQ
  2252. 1652 IF ZStoreParseAt > ZLastIndex THEN _
  2253.         IF ZLastIndex > 0 THEN _
  2254.            ZLastIndex = ZStoreParseAt
  2255.      ZStackC = ZFalse
  2256.      ZParseOff = ZFalse
  2257.      END SUB
  2258. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  2259. ' $PAGE
  2260. '
  2261. '  NAME    -- SetBaud
  2262. '
  2263. '  INPUTS  --     PARAMETER                    MEANING
  2264. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  2265. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2266. '                                 BAUD RATE TO THE USER'S BAUD
  2267. '                                 RATE (INDEPENDENT OF THE BAUD
  2268. '                                 RATE USED TO OPEN THE COMM. PORT)
  2269. '
  2270. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2271. '            RATE              PCjr         PC AND XT
  2272. '              50             2237             2304
  2273. '              75             1491             1536
  2274. '             110             1017             1047
  2275. '             134.5            832              857
  2276. '             150              746              768
  2277. '             300              373              384
  2278. '             600              186              192
  2279. '            1200               93               96
  2280. '            1800               62               64
  2281. '            2000               56               58
  2282. '            2400               47               48
  2283. '            3600               31               32
  2284. '            4800               23               24
  2285. '            7200          not available         16
  2286. '            9600          not available         12
  2287. '           19200          not available          6
  2288. '           38400               "                 3
  2289. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2290. '
  2291. '  PURPOSE -- To set the baud rate in the RS232 interface
  2292. '             inpependent of the baud rate the communications port
  2293. '             was opened at
  2294. '
  2295.       SUB SetBaud STATIC
  2296.      IF ZCBaud$ = "" THEN _
  2297.         ZCBaud$ = MID$(ZBaudRates$,(-5 * ZBPS),5)
  2298.      Temp! = VAL(ZCBaud$)
  2299.      IF Temp! > 0 THEN CALL SetBPS (Temp!,ZCBPS)
  2300.      IF (ZCBPS = 0 OR Temp! = 0) THEN ZCBPS = ZBPS
  2301.      IF NOT ZKeepInitBaud THEN _
  2302.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  2303.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  2304.      CALL Trim (ZTalkToModemAt$)
  2305.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  2306.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  2307.                             ZTalkToModemAt$
  2308.      IF ZEightBit THEN_
  2309.         Parity = 2 : _                                    ' No PARITY
  2310.         DataBits = 3 : _                                  ' 8 DATA BITS
  2311.         StopBits = 0 _                                    ' 1 STOP BIT
  2312.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  2313.           DataBits = 2 : _                                ' 7 DATA BITS
  2314.           StopBits = 0                                    ' 1 STOP BIT
  2315.      ComSpeed! = VAL(ZTalkToModemAt$)
  2316.      IF ComSpeed! > 19200 THEN _
  2317.         IF ZFossil THEN _
  2318.            WasI = &H9600 _
  2319.         ELSE WasI = 19200 _
  2320.      ELSE WasI = ComSpeed!
  2321.      IF ZFossil THEN _
  2322.         CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
  2323.         EXIT SUB
  2324.      IF ComSpeed! = 2400 THEN _
  2325.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  2326.      ELSE IF ComSpeed! = 1200 THEN _
  2327.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  2328.      ELSE IF ComSpeed! = 9600 THEN _
  2329.         ZBaudRateDivisor = &HC _
  2330.      ELSE IF ComSpeed! = 300 THEN _
  2331.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  2332.      ELSE IF ComSpeed! = 450 THEN _
  2333.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  2334.      ELSE IF ComSpeed! = 4800 THEN _
  2335.         ZBaudRateDivisor = &H18 _
  2336.      ELSE IF ComSpeed! = 19200 THEN _
  2337.         ZBaudRateDivisor = &H6 _
  2338.      ELSE IF ComSpeed! = 38400 THEN _
  2339.         ZBaudRateDivisor = &H3
  2340.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  2341.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  2342.      LineCntlStatus = INP(ZLineCntlReg)
  2343.      MSBSave = INP(ZMSB)
  2344.      OUT ZMSB,0
  2345.      OUT ZLineCntlReg,LineCntlStatus OR 128
  2346.      OUT ZLSB,LeastSignifByte
  2347.      OUT ZMSB,MostSignifByte
  2348.      OUT ZLineCntlReg,LineCntlStatus
  2349.      OUT ZMSB,MSBSave
  2350.      END SUB
  2351. 2018 ' $SUBTITLE: 'SetWhoTo - subroutine to get who a msg/upload is to'
  2352. ' $PAGE
  2353. '
  2354. '  NAME    -- SetWhoTo
  2355. '
  2356. '  INPUTS  --     PARAMETER                    MEANING
  2357. '              HighestUserRecord
  2358. '
  2359. '  OUTPUTS --  MsgTo$              Who message is to
  2360. '              RcvrRecNum         User record # of who to
  2361. '
  2362. '  PURPOSE --  Asks who a message/upload is to and checks if receiver exists
  2363. '
  2364.      SUB SetWhoTo (EnableCC,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  2365.      Temp$ = MsgFrom$
  2366.      CALL Trim (Temp$)
  2367.      ZNumHeaders = 0
  2368.      CALL KillWork (ZNodeWorkFile$)
  2369. 2020 IF MsgTo$ <> "" THEN _
  2370.         GOTO 2032
  2371. 2021 ZOutTxt$ = "To A)ll,S)ysop," + _
  2372.                  LEFT$("D)istribution,",-14*EnableCC) + _
  2373.                  " or name" + ZPressEnterExpert$
  2374.      CALL SkipLine (1)
  2375.      ZSemiOnly = ZTrue
  2376.      CALL PopCmdStack
  2377.      IF LEN(ZUserIn$(ZAnsIndex)) > 30 THEN _
  2378.         CALL QuickTPut1 ("30 Char. Max") : _
  2379.         GOTO 2021
  2380.      Found = ZTrue
  2381.      IF ZWasQ = 0 THEN _
  2382.         GOTO 2033 _
  2383.      ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _
  2384.           CALL AllCaps (ZWasDF$) : _
  2385.           ZUserIn$(ZAnsIndex) = ZWasDF$ : _
  2386.           IF ZWasDF$ = "A" THEN _
  2387.              MsgTo$ = "ALL" _
  2388.           ELSE IF ZWasDF$ = "S" THEN _
  2389.              MsgTo$ = "SYSOP" _
  2390.           ELSE IF ZWasDF$ = "D" AND EnableCC THEN _
  2391.              GOTO 2025 _
  2392.           ELSE MsgTo$ = ZUserIn$(ZAnsIndex) :_
  2393.                CALL AllCaps (MsgTo$)
  2394.      GOTO 2032
  2395. 2022 IF NOT ZExpertUser THEN _
  2396.         GOTO 2025
  2397. 2024 ZFileName$ = ZHelpPath$ + ZDistriHelp$ + ZHelpExtension$
  2398.      CALL BufFile (ZFileName$,WasX)
  2399. 2025 ZOutTxt$ = "Use what distribution list (H)elp)"
  2400.      CALL PopCmdStack
  2401.      IF ZWasQ = 0 THEN _
  2402.         GOTO 2021
  2403.      ZFileName$ = ZUserIn$(ZAnsIndex)
  2404.      CALL AllCaps (ZFileName$)
  2405.      IF INSTR("?H",ZFileName$) > 0 THEN _
  2406.         GOTO 2024
  2407.      CALL BadFile (ZFileName$,BadFileNameIndex)
  2408.      ON BadFileNameIndex GOTO 2026,2025,2025
  2409. 2026 ZFileName$ = ZDistriPath$ + ZFileName$ + ".LST"
  2410.      CALL FindItX (ZFileName$,7)
  2411.      IF NOT ZOK THEN _
  2412.         CALL QuickTPUT1 (ZUserIn$ + " not found") : _
  2413.         GOTO 2024
  2414.      ZNumHeaders = 0
  2415.      CALL OpenWorkA (ZNodeWorkFile$)
  2416.      WHILE NOT EOF(7)
  2417.         CALL ReadDir (7,1)
  2418.         CALL AllCaps (ZOutTxt$)
  2419.         ZWasDF$ = ZOutTxt$
  2420.         CALL WhoCheck (ZOutTxt$, Found, RcvrRecNum)
  2421.         ZNumHeaders = ZNumHeaders + 1
  2422.         CALL PrintWorkA (ZWasDF$ + "," + STR$(-RcvrRecNum*Found))
  2423.      WEND
  2424.      CLOSE 7
  2425.      GOTO 2033
  2426. 2032 RcvrRecNum = 0
  2427.      IF MsgTo$ <> "ALL" THEN _
  2428.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  2429.            ZWasDF = INSTR(MsgTo$+" @"," @") : _
  2430.            TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _
  2431.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  2432.            IF NOT Found THEN _
  2433.               ZLastIndex = 0 : _
  2434.               RcvrRecNum = 0 : _
  2435.               IF NOT ZReply THEN _
  2436.                  ZOutTxt$ = "Send anyway (Y,[N])" : _
  2437.                  ZTurboKey = -ZTurboKeyUser : _
  2438.                  ZLastIndex = 0 : _
  2439.                  GOSUB 2034 : _
  2440.                  IF NOT ZYes THEN _
  2441.                     GOTO 2021
  2442.      IF MsgTo$ = Temp$ THEN _
  2443.         ZOutTxt$ = "Really send this to YOURSELF (Y,[N])" : _
  2444.         ZLastIndex = 0 : _
  2445.         GOSUB 2034 : _
  2446.         IF NOT ZYes THEN _
  2447.            MsgTo$ = ""
  2448.      CALL OpenWorkA (ZNodeWorkFile$)
  2449.      CALL PrintWorkA (MsgTo$ + "," + STR$(RcvrRecNum))
  2450.      CLOSE 2
  2451.      ZNumHeaders = ZNumHeaders + 1
  2452.      IF EnableCC AND (NOT ZReply) AND MsgTo$ <> "ALL" AND _
  2453.         MsgTo$ <> "" AND LEFT$(MsgTo$,4) <> "ALL " AND _
  2454.         (NOT ZSysopComment) AND (NOT ZSysopMsg) THEN _
  2455.            ZOutTxt$ = "Carbon copy to another (Y,[N])" : _
  2456.            CALL PopCmdStack : _
  2457.            IF ZYes THEN _
  2458.               GOTO 2021
  2459. 2033 IF ZNumHeaders < 1 THEN _
  2460.         MsgTo$ = "" _
  2461.      ELSE IF ZNumHeaders > 1 THEN _
  2462.         MsgTo$ = "(list)"
  2463.      EXIT SUB
  2464. 2034 ZSubParm = 1
  2465.      CALL TGet
  2466.      IF ZSubParm < 0 THEN _
  2467.         EXIT SUB
  2468.      RETURN
  2469.      END SUB
  2470. 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message'
  2471. ' $PAGE
  2472. '
  2473. '  NAME    -- MsgProt
  2474. '
  2475. '  INPUTS  --     PARAMETER                    MEANING
  2476. '                 MsgTo$
  2477. '                 Found
  2478. '
  2479. '  OUTPUTS --  ZPswd$                Protection desired
  2480. '
  2481. '  PURPOSE --  Sets protection desired for a new message
  2482. '
  2483.      SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC
  2484. 2060 IF INSTR(ZMsgSecCats$,"U") = 0 THEN _
  2485.         ZOutTxt$ = "" _
  2486.      ELSE ZOutTxt$ = " p(U)blic," : _
  2487.           IF MsgTo$ = "ALL" THEN _
  2488.              MsgPswd$ = "" : _
  2489.              GOTO 2061
  2490.      IF INSTR(ZMsgSecCats$,"R") THEN _
  2491.         ZOutTxt$ = ZOutTxt$ + " p(R)ivate,"
  2492.      IF INSTR(ZMsgSecCats$,"P") THEN _
  2493.         ZOutTxt$ = ZOutTxt$ + " (P)assword protected,"
  2494. 2061 ZOutTxt$ = "Make msg" + ZOutTxt$ + " (E)dit more, H)elp"
  2495.      IF MsgPswd$ = "^READ^" THEN _
  2496.         DefaultProt$ = "R" : _
  2497.         GOTO 2065
  2498.      IF LEFT$(MsgPswd$,1) = "!" THEN _
  2499.         DefaultProt$ = "P" _
  2500.      ELSE _
  2501.         DefaultProt$ = "U"
  2502. 2065 IF INSTR(ZMsgSecCats$,DefaultProt$) > 0 THEN _
  2503.         MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]"
  2504.      ZTurboKey = -ZTurboKeyUser
  2505.      GOSUB 2096
  2506.      IF ZWasQ = 0 THEN _
  2507.         ZUserIn$(ZAnsIndex) = DefaultProt$
  2508.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  2509.      CALL AllCaps (ZWasZ$)
  2510.      IF INSTR(ZMsgSecCats$,ZWasZ$) = 0 THEN _
  2511.         GOTO 2060
  2512.      ON INSTR("RUPHE",ZWasZ$) GOTO 2075,2090,2075,2070,2067
  2513.      GOTO 2060
  2514. 2067 MsgPswd$ = ""
  2515.      EXIT SUB
  2516. '
  2517. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2518. '
  2519. 2070 CALL BufFile (ZHelp$(3),WasX)
  2520.      GOTO 2060
  2521. '
  2522. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2523. '
  2524. 2075 IF MsgTo$ = "ALL" THEN _
  2525.         CALL QuickTPut1 ("Msg to ALL cannot be private") : _
  2526.         GOTO 2060
  2527.      IF ZWasZ$ = "P" THEN _
  2528.         GOTO 2088
  2529. 2081 CALL QuickTPut1 ("Sending private mail to " + MsgTo$)
  2530. 2084 MsgPswd$ = "^READ^"
  2531.      EXIT SUB
  2532. 2085 ZOutTxt$ = "Password"
  2533.      GOSUB 2096
  2534.      IF ZWasQ = 0 THEN _
  2535.         IF LEFT$(MsgPswd$,1) = "!" THEN _
  2536.            MsgPswd$ = MID$(MsgPswd$,2) : _
  2537.            CALL QuickTPut1 ("Password is " + MsgPswd$) : _
  2538.            RETURN _
  2539.         ELSE _
  2540.         GOTO 2085
  2541.      IF LEN(ZUserIn$) > WasL THEN _
  2542.         CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _
  2543.         GOTO 2085
  2544.      IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
  2545.         CALL QuickTPut1 ("Password can't begin with '!'") : _
  2546.         GOTO 2085
  2547.      RETURN
  2548. '
  2549. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2550. '
  2551. 2088 ZOutTxt$ = "Receiver(s) MUST know password to read msg.  Use password (Y,[N])"
  2552.      ZTurboKey = -ZTurboKeyUser
  2553.      GOSUB 2096
  2554.      IF NOT ZYes THEN _
  2555.         GOTO 2070
  2556.      WasL = 14
  2557.      WasA1$ = "!"
  2558.      GOSUB 2085
  2559.      CALL AllCaps (ZUserIn$)
  2560.      GOTO 2092
  2561. '
  2562. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2563. '
  2564. 2090 WasL = 15
  2565.      WasA1$ = ""
  2566.      ZUserIn$ = "^KILL^"
  2567. 2092 MsgPswd$ = WasA1$ + ZUserIn$
  2568.      EXIT SUB
  2569. 2093 ZTurboKey = -ZTurboKeyUser
  2570. 2094 ZSubParm = 1
  2571.      CALL TGet
  2572. 2095 IF ZSubParm = -1 THEN _
  2573.         EXIT SUB
  2574.      RETURN
  2575. 2096 CALL PopCmdStack
  2576.      GOTO 2095
  2577.      END SUB
  2578. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  2579. ' $PAGE
  2580. '
  2581. '  NAME    -- WhoCheck
  2582. '
  2583. '  INPUTS  --   PARAMETER                    MEANING
  2584. '              WhoFind$                User to find
  2585. '
  2586. '  OUTPUTS --  WhoFound                Whether user found
  2587. '              UserNumFound           Record # of user
  2588. '
  2589. '  PURPOSE --  Validate that user record exists.  Sysop
  2590. '              counted as found even if lack user record.
  2591. '
  2592.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  2593.      UserNumFound = 0
  2594.      IF ZStartHash <> 1 THEN _
  2595.         WhoFound = ZTrue : _
  2596.         EXIT SUB
  2597.      Work128$ = ZUserRecord$
  2598.      WhoFound = ZFalse
  2599.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  2600.                 INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0)
  2601.      CALL OpenUser (HighestUserRecord)
  2602.      FIELD 5, 128 AS ZUserRecord$
  2603.      IF ToSysop THEN _
  2604.         WasX$ = ZSecretName$ _
  2605.      ELSE WasX$ = WhoFind$
  2606.      ZWasDF = INSTR(WasX$+"@","@")
  2607.      WasX$ = LEFT$(WasX$,ZWasDF)
  2608.      IF LEN(WasX$) > 1 THEN _
  2609.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  2610.                        0,0,HighestUserRecord,WhoFound,_
  2611.                        UserNumFound,ZWasSL)
  2612.      LSET ZUserRecord$ = Work128$
  2613.      IF NOT WhoFound THEN _
  2614.         IF ToSysop THEN _
  2615.            WhoFound = ZTrue _
  2616.         ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  2617.      END SUB
  2618. 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message'
  2619. ' $PAGE
  2620. '
  2621. '  NAME    -- EditALine
  2622. '
  2623. '  INPUTS  --     PARAMETER                    MEANING
  2624. '                 WasL                        Line # to edit
  2625. '
  2626. '  OUTPUTS --  ZOutTxt$(WasL)                 Edited line
  2627. '
  2628. '  PURPOSE --  Edit a line in a message.
  2629. '
  2630.      SUB EditALine (WasL) STATIC
  2631. 2620 ZOutTxt$ = "Line #" + _
  2632.           STR$(WasL) + _
  2633.           " is:" + _
  2634.           ZReturnLineFeed$ + _
  2635.           ZOutTxt$(WasL)
  2636.      ZSubParm = 3
  2637.      CALL TPut
  2638.      GOSUB 2695
  2639.      IF NOT ZExpertUser THEN _
  2640.         CALL QuickTPut1 ("Search & replace")
  2641.      ZOutTxt$ = "Search for" + _
  2642.           ZPressEnterExpert$
  2643.      ZMacroMin = 99
  2644.      ZParseOff = ZTrue
  2645.      ZSubParm = 1
  2646.      GOSUB 2694
  2647.      IF ZWasQ = 0 THEN _
  2648.         EXIT SUB
  2649.      ZWasY$ = LEFT$(ZUserIn$,1)
  2650.      IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
  2651.         IF LEN(ZUserIn$) > 2 THEN _
  2652.            WasX = INSTR(2,ZUserIn$,ZWasY$) : _
  2653.            IF WasX < LEN(ZUserIn$) THEN _
  2654.               IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
  2655.                  ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
  2656.                  WasX = WasX - 1 : _
  2657.                  GOTO 2622
  2658.      WasX = INSTR(ZUserIn$,";")
  2659. 2622 IF WasX > 0 THEN _
  2660.         WasX$ = LEFT$(ZUserIn$,WasX-1) : _
  2661.         ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
  2662.         GOTO 2660
  2663.      WasX$ = ZUserIn$
  2664.      ZOutTxt$ = "And replace by"
  2665.      ZParseOff = ZTrue
  2666.      ZSubParm = 1
  2667.      ZMacroMin = 99
  2668.      GOSUB 2694
  2669.      ZWasY$ = ZUserIn$
  2670. 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
  2671.      IF WasX = 0 THEN _
  2672.         CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _
  2673.         GOTO 2620
  2674. 2670 ZFF = LEN(WasX$)
  2675.      WasJJ = LEN(ZWasY$)
  2676.      IF ZFF = WasJJ THEN _
  2677.         MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _
  2678.         GOTO 2620
  2679. 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1)
  2680.      ZOutTxt$(WasL) = ZWasDF$ + _
  2681.              ZWasY$ + _
  2682.              MID$(ZOutTxt$(WasL),WasX + ZFF)
  2683.      IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _
  2684.         CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$())
  2685.      GOTO 2620
  2686. 2694 CALL TGet
  2687. 2695 IF ZSubParm > -1 THEN _
  2688.         RETURN
  2689.      END SUB
  2690. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  2691. ' $PAGE
  2692. '
  2693. '  NAME    -- LineEdit
  2694. '
  2695. '  INPUTS  -- PARAMETER             MEANING
  2696. '             ZBackArrow$
  2697. '             ZBackSpace$
  2698. '             ZCarriageReturn$
  2699. '             ZLineFeed$
  2700. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  2701. '             ZLocalUser
  2702. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  2703. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  2704. '             ZRightMargin
  2705. '             ZSnoop
  2706. '             ZStopInterrupts
  2707. '             ZWaitExpired
  2708. '
  2709. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  2710. '
  2711. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2712. '             string space.
  2713. '
  2714.      SUB LineEdit (MsgLine,MaxLen) STATIC
  2715.      TabToSpace = 0
  2716.      LSET ZLineMes$ = ZOutTxt$(MsgLine)
  2717.      Col = LEN(ZOutTxt$(MsgLine))
  2718.      ZStopInterrupts = ZTrue
  2719.      WasXXX = MaxLen - 3
  2720.      ZWaitExpired = ZFalse
  2721.      GOTO 3782
  2722. 3720 Col = Col + 1
  2723.      ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2724. 3730 IF TabToSpace > 0 THEN _
  2725.         WasX$ = " " : _
  2726.         TabToSpace = TabToSpace - 1 : _
  2727.         GOTO 3750
  2728.      CALL FindFKey
  2729.      IF ZSubParm < 0 THEN _
  2730.         EXIT SUB
  2731.      WasX$ = ZKeyPressed$
  2732.      IF WasX$ = "" THEN _
  2733.         IF ZLocalUser THEN _
  2734.            GOTO 3733 _
  2735.         ELSE GOTO 3732
  2736.      IF WasX$ = ZEscape$ THEN _
  2737.         ZKeyPressed$ = WasX$ : _
  2738.         EXIT SUB
  2739.      SendRemote = ZTrue
  2740.      WasZ = INSTR(ZLineEditChk$,WasX$)
  2741.      IF WasZ < 1 THEN _
  2742.         GOTO 3750 _
  2743.      ELSE IF WasZ > 4 THEN _
  2744.              GOTO 3870 _
  2745.      ELSE IF WasZ = 1 THEN _
  2746.              GOTO 3810
  2747.      IF ZLocalUser THEN _
  2748.         GOTO 3730
  2749. 3732 IF ZCommPortStack$ <> "" THEN _
  2750.         WasX$ = LEFT$(ZCommPortStack$,1) : _
  2751.         ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  2752.         GOTO 3738
  2753.      CALL EofComm (Char)
  2754.      IF Char <> -1 THEN _
  2755.         GOTO 3736
  2756. 3733 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2757.      IF TempElapsed! <=0 THEN _
  2758.         ZWaitExpired = ZTrue : _
  2759.         Col = Col - 1 : _
  2760.         GOTO 3850
  2761.      CALL Carrier
  2762.      IF ZSubParm THEN _
  2763.         EXIT SUB
  2764.      GOTO 3730
  2765. 3736 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2766. 3737 CALL GetCom (WasX$)
  2767. 3738 SendRemote = ZRemoteEcho
  2768. 3740 ON INSTR(ZLineEditChk$,WasX$) GOTO 3810,3730,3730,3730, _
  2769.                                    3870,3870,3870,3870,3870
  2770. 3750 IF SendRemote THEN _
  2771.         CALL PutCom(WasX$)
  2772.      CALL LPrnt (WasX$, 0)
  2773.      IF WasX$ = ZCarriageReturn$ THEN _
  2774.         Col = Col - 1 : _
  2775.         GOTO 3850
  2776. 3770 IF Col > WasXXX THEN _
  2777.         IF WasX$ = " " THEN _
  2778.            CALL SkipLine (1) : _
  2779.            GOTO 3860
  2780. 3780 MID$(ZLineMes$,Col) = WasX$
  2781. 3782 IF Col < MaxLen THEN _
  2782.         GOTO 3720
  2783.      WasZ = Col
  2784. 3800 IF WasZ < 1 THEN _
  2785.         WasZ = Col-1 : _
  2786.         GOTO 3820
  2787.      IF MID$(ZLineMes$,WasZ,1) = " " THEN _
  2788.         GOTO 3820
  2789.      WasZ = WasZ - 1
  2790.      GOTO 3800
  2791. 3810 TabToSpace = 5 - (Col MOD 5)
  2792.      GOTO 3730
  2793. 3820 IF (NOT ZRemoteEcho) AND (NOT ZLocalUser) THEN _
  2794.         CALL SkipLine (1) : _
  2795.         GOTO 3860
  2796.      Col = MaxLen - WasZ
  2797.      IF ZSnoop THEN _
  2798.         IF (POS(0) > Col) AND (Col > 0) THEN _
  2799.            LOCATE ,POS(0)-Col: _
  2800.            CALL LPrnt(STRING$(Col,32),0)
  2801. 3830 IF ZRemoteEcho THEN _
  2802.         CALL PutCom (STRING$(Col,8) + STRING$(Col,32))
  2803. 3840 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,WasZ)
  2804.      ZOutTxt$(MsgLine + 1) = MID$(ZLineMes$,WasZ + 1,Col)
  2805.      CALL SkipLine (1)
  2806.      GOTO 3891
  2807. 3850 IF SendRemote AND ZLineFeeds THEN _
  2808.         CALL PutCom(ZLineFeed$)
  2809. 3860 ZOutTxt$(MsgLine) = LEFT$(ZLineMes$,Col)
  2810.      GOTO 3891
  2811. 3870 IF Col = 1 THEN _
  2812.         GOTO 3730
  2813.      Col = Col-2
  2814. 3880 CALL LPrnt(ZLocalBksp$,0)
  2815. 3885 IF SendRemote THEN _
  2816.         CALL PutCom (ZBackSpace$)
  2817. 3890 GOTO 3720
  2818. 3891 CALL Carrier
  2819.      END SUB
  2820. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  2821. ' $PAGE
  2822. '
  2823. '  NAME    -- KillMsg
  2824. '
  2825. '  INPUTS  --     PARAMETER                    MEANING
  2826. '              MsgToKill                   MESSAGE NUMBER TO KILL
  2827. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  2828. '
  2829. '  OUTPUTS --  NONE
  2830. '
  2831. '  PURPOSE --  To kill/delete old or unnecessary messages
  2832. '
  2833.      SUB KillMsg (MsgToKill,ActiveMessages) STATIC
  2834.      FIELD #1,128 AS ZMsgRec$
  2835.      WasQX = 1
  2836.      NumHeaders = 0
  2837. 3955 IF WasQX > ActiveMessages THEN _
  2838.         ZOutTxt$ = "No such msg #" + _
  2839.              STR$(MsgToKill) : _
  2840.         GOTO 4031
  2841.      IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
  2842.         GOTO 3970
  2843.      WasQX = WasQX + 1
  2844.      GOTO 3955
  2845. 3970 MsgRec = ZMsgPtr(WasQX,1)
  2846.      GET 1, MsgRec
  2847.      NumHeaders = ASC(MID$(ZMsgRec$,67,1))
  2848.      OrigNumHeaders = NumHeaders
  2849. 3972 CALL ChkIfMsgHeader
  2850.      IF NOT ZOK THEN _
  2851.         NumHeaders = 0 : _
  2852.         GOTO 4032
  2853.      IF MID$(ZMsgRec$,116,1) = ZDeletedMsg$ THEN _
  2854.         GOTO 4032
  2855.      IF ZUserSecLevel >= ZSecKillAny THEN _
  2856.         GOTO 4020
  2857. 3980 ZWasZ$ = MID$(ZMsgRec$,101,15)
  2858.      CALL Trim (ZWasZ$)
  2859.      IF LEN(ZWasZ$) = 0 THEN _
  2860.         GOTO 4030
  2861. 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
  2862.         CALL ChkMsgName (MsgFromCaller,MsgToCaller) : _
  2863.         IF (MsgFromCaller OR MsgToCaller) THEN _
  2864.            GOTO 4020 _
  2865.         ELSE IF NumHeaders > 1 THEN _
  2866.                 GOTO 4032 _
  2867.              ELSE ZMsgPswd = ZTrue : _
  2868.                   ZAttemptsAllowed = 0 : _
  2869.                   ZOutTxt$ = "Only sender & receiver can kill" : _
  2870.                   GOTO 4031
  2871. 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _
  2872.         ZWasZ$ = MID$(ZWasZ$,2)
  2873. 4010 ZPswdSave$ = ZWasZ$ + _
  2874.                       SPACE$(15 - LEN(ZWasZ$))
  2875.      ZAttemptsAllowed = 1
  2876.      ZMsgPswd = ZTrue
  2877.      CALL PassWrd
  2878.      IF ZPswdFailed THEN _
  2879.         GOTO 4031
  2880. 4020 ZWasZ$ = MID$(ZMsgRec$,37,22)
  2881.      CALL Trim (ZWasZ$)
  2882.      IF OrigNumHeaders < 2 AND ZExpertUser THEN _
  2883.         GOTO 4030
  2884.      ZOutTxt$ = "Really kill msg#" + STR$(MsgToKill) + " to " + ZWasZ$ + " ([Y],N)"
  2885.      ZSubParm = 1
  2886.      ZTurboKey = -ZTurboKeyUser
  2887.      CALL TGet
  2888.      IF ZSubParm < 0 THEN _
  2889.         EXIT SUB
  2890.      IF ZNo THEN _
  2891.         GOTO 4032
  2892. 4030 ZSubParm = 3
  2893.      CALL FileLock
  2894.      GET 1, MsgRec
  2895.      MID$(ZMsgRec$,116,1) = ZDeletedMsg$
  2896.      PUT 1, MsgRec
  2897.      ZSubParm = 4
  2898.      CALL FileLock
  2899.      ZOutTxt$ = "Killed Msg #" + _
  2900.           STR$(MsgToKill) + " to " + ZWasZ$
  2901.      CALL UpdtCalr (ZOutTxt$,1)
  2902.      IF ((ZUserSecLevel < ZSecKillAny) AND NOT MsgFromCaller) THEN _
  2903.         NumHeaders = 0
  2904. 4031 ZSubParm = 5
  2905.      CALL TPut
  2906. 4032 NumHeaders = NumHeaders - 1
  2907.      IF NumHeaders > 0 THEN _
  2908.         MsgRec = MsgRec + 1 : _
  2909.         GET 1, MsgRec : _
  2910.         GOTO 3972
  2911.      END SUB
  2912. 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading'
  2913. ' $PAGE
  2914. '
  2915. '  NAME    -- SetThread
  2916. '
  2917. '  INPUTS  --     PARAMETER                    MEANING
  2918. '                 CurMsgNum                 Current message number
  2919. '                 CurSubj$                  Current message subject
  2920. '
  2921. '  OUTPUTS --  ZUserIn$()                   Search msg by string
  2922. '              ZWasQ                        0 if thread cancelled
  2923. '
  2924. '  PURPOSE --  Find out how the caller wants to thread -
  2925. '              i.e. search messages by matching subject -
  2926. '              forward from current, back from current,
  2927. '              or forward from top of messages
  2928. '
  2929.      SUB SetThread (CurMsgNum,CurSubj$) STATIC
  2930.      IF ZWasQ > 1 THEN _
  2931.         ZWasZ$ = ZUserIn$(2) : _
  2932.         GOTO 4657
  2933. 4656 ZOutTxt$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2934.      ZTurboKey = -ZTurboKeyUser
  2935.      ZSubParm = 1
  2936.      CALL TGet
  2937.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2938.         EXIT SUB
  2939.      ZWasZ$ = ZUserIn$(1)
  2940. 4657 ZWasZ$ = LEFT$(ZWasZ$,1)
  2941.      WasX = INSTR("+-1",ZWasZ$)
  2942.      IF WasX = 0 THEN _
  2943.         GOTO 4656
  2944.      ZUserIn$(1) = "R"
  2945.      IF WasX = 1 THEN _
  2946.         CurMsgNum = CurMsgNum + 1 _
  2947.      ELSE IF WasX = 2 THEN _
  2948.              CurMsgNum = CurMsgNum - 1 _
  2949.           ELSE CurMsgNum = 1 : _
  2950.                ZWasZ$ = "+"
  2951.      ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$
  2952.      IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _
  2953.         ZUserIn$(2) = CurSubj$ _
  2954.      ELSE ZUserIn$(2) = MID$(CurSubj$,4)
  2955.      ZUserIn$(2) = LEFT$(ZUserIn$(2) + "  ",22)
  2956.      ZLastIndex = 3
  2957.      ZAnsIndex = 1
  2958.      ZWasQ = 3
  2959.      END SUB
  2960. 4773 ' $SUBTITLE: 'SysopChat - chat with sysop'
  2961. ' $PAGE
  2962. '
  2963. '  NAME    -- SysopChat
  2964. '
  2965. '  INPUTS  --     PARAMETER                    MEANING
  2966. '  OUTPUTS --  ZWasCM                     True if chat active
  2967. '
  2968. '  PURPOSE --  Lets sysop chat interactively with caller
  2969. '
  2970.      SUB SysopChat STATIC
  2971.      ZWasCM = ZTrue
  2972.      TimeChatStarted! = TIMER
  2973.      ZSubParm = 1
  2974.      CALL Line25
  2975.      ZOutTxt$(2) = ""
  2976. 4775 CALL LineEdit (1,72)
  2977.      IF ZKeyPressed$ = ZEscape$ OR _
  2978.         ZSubParm < 0 THEN _
  2979.         GOTO 4777
  2980.      ZOutTxt$(1) = ""
  2981.      IF ZOutTxt$(2) <> "" THEN _
  2982.         ZOutTxt$ = ZOutTxt$(2) : _
  2983.         ZOutTxt$(1) = ZOutTxt$(2) : _
  2984.         ZOutTxt$(2) = "" _
  2985.      ELSE ZOutTxt$ = ""
  2986.      ZSubParm = 4
  2987.      CALL TPut
  2988.      IF ZSubParm > -1 THEN _
  2989.         GOTO 4775
  2990. 4777 ZWasCM = 0
  2991.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  2992.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  2993.      IF NOT ZLocalUser THEN _
  2994.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2995.      CALL QuickTPut("  Chat over.  BBS resuming",2)
  2996.      END SUB
  2997. 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string'
  2998. ' $PAGE
  2999. '
  3000. '  NAME    -- RemNonAlf
  3001. '
  3002. '  INPUTS  --     PARAMETER                    MEANING
  3003. '                 Strng$                   String to check
  3004. '                 MinChar                  Remove chars with this
  3005. '                                          ASCII value or lower
  3006. '                 MaxChar                  Remove chars with this
  3007. '                                          ASCII value or higher
  3008. '
  3009. '  OUTPUTS --       Strng$                 String returned
  3010. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  3011. '
  3012.      SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC
  3013.      Last = LEN(Strng$)
  3014.      WasJ = 1
  3015.      WHILE WasJ <= Last
  3016.         WasK = ASC(MID$(Strng$,WasJ))
  3017.         IF WasK > MinChar AND WasK < MaxChar THEN _
  3018.            WasJ = WasJ + 1 _
  3019.         ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _
  3020.                       RIGHT$(Strng$,Last - WasJ) : _
  3021.              Last = Last - 1
  3022.      WEND
  3023.      END SUB
  3024. 5500 ' $SUBTITLE: 'BankTime - Allows User to Bank Session Time'
  3025. ' $PAGE
  3026. '  NAME    -- BankTime
  3027. '
  3028. '  INPUTS  -- PARAMETER             MEANING
  3029. '             ZBankTime          Time in bank can use
  3030. '
  3031. '  OUTPUTS -- ZBankTime
  3032. '
  3033. '  PURPOSE -- Allow Users to use Bank session time
  3034. '
  3035.      SUB BankTime STATIC
  3036.      GOSUB 5507
  3037. 5501 CALL TimeRemain(MinsRemaining)
  3038.      ZOutTxt$ = STR$(MinsRemaining) + _
  3039.                 " mins left.  D)eposit, W)ithdraw, H)elp, [Q]uit"
  3040.      ZTurboKey = -ZTurboKeyUser
  3041.      CALL PopCmdStack
  3042.      IF ZSubParm = -1 THEN _
  3043.         EXIT SUB
  3044.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  3045.      CALL AllCaps(ZWasZ$)
  3046.      ON INSTR("QDW?H",ZWasZ$) GOTO 5509,5505,5502,5508,5508
  3047.      GOTO 5501
  3048. 5502 SignTime = 1        ' withdraw time
  3049.      MaxTime = ZGlobalBankTime
  3050. 5503 IF SignTime = 1 THEN _
  3051.         ZOutTxt$ = "Withdraw" _
  3052.      ELSE ZOutTxt$ = "Deposit"
  3053.      Temp$ = ZOutTxt$ + " how many mins"
  3054.      CALL ChangeInt (ZFalse,Temp$,Temp,0,Maxtime)
  3055.      IF ZWasQ = 0 OR ZTestedIntValue = 0 THEN _
  3056.         GOTO 5501
  3057.      ZTestedIntValue = SignTime * ZTestedIntValue
  3058.      CALL ChkAddedTime (ZTestedIntValue)
  3059.      IF ZTestedIntValue = 0 THEN _
  3060.         GOTO 5501
  3061.      ZSecsPerSession! = ZSecsPerSession! + (ZTestedIntValue * 60)
  3062.      ZElapsedTime = ZElapsedTime - ZTestedIntValue
  3063.      ZGlobalBankTime = ZGlobalBankTime - ZTestedIntValue
  3064.      GOSUB 5507
  3065.      GOTO 5501
  3066. 5505 SignTime = -1            ' deposit
  3067.      MaxTime = ZMaxBank - ZGlobalBankTime
  3068.      IF MaxTime <= 0 THEN _
  3069.         CALL QuickTPut1 ("Already deposited max of" + STR$(ZMaxBank)) : _
  3070.         ZLastIndex = 0 : _
  3071.         GOTO 5501
  3072.      IF MaxTime > MinsRemaining THEN _
  3073.         MaxTime = MinsRemaining
  3074.      GOTO 5503
  3075. 5507 IF ZAnsIndex < ZLastIndex THEN _
  3076.         RETURN
  3077.      ZOutTxt$ = "Current Bank Balance: " + _
  3078.                  STR$(ZGlobalBankTime) + " Mins"
  3079.      CALL QuickTPut1(ZOutTxt$)
  3080.      RETURN
  3081. 5508 ZFileName$ = ZHelpPath$ + _
  3082.                   "UB" + _
  3083.                   ZHelpExtension$
  3084.      CALL BufFile (ZFileName$,WasX)
  3085.      GOTO 5501
  3086. 5509 GOSUB 5507
  3087.      END SUB                                                         ' SKO10601
  3088. 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time'
  3089. ' $PAGE
  3090. '
  3091. '  NAME    -- GetTime
  3092. '
  3093. '  INPUTS  --     PARAMETER                    MEANING
  3094. '                ZTimeLoggedOn$
  3095. '
  3096. '  OUTPUTS --  ZSessionHour               NUMBER OF HOURS ON
  3097. '              ZSessionMin                NUMBER OF MINUTES ON
  3098. '              ZSessionSec                NUMBER OF SECONDS ON
  3099. '
  3100. '  PURPOSE --  Calculate the elapsed time a user has been on
  3101. '
  3102.      SUB GetTime STATIC
  3103.      CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2)
  3104.      ZSessionHour = TempElapsed! / 3600
  3105.      ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60
  3106.      ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!)
  3107.      IF ZSessionSec < 0 THEN _
  3108.         ZSessionSec = ZSessionSec + 60 : _
  3109.         ZSessionMin = ZSessionMin - 1
  3110.      IF ZSessionMin < 0 THEN _
  3111.         ZSessionMin = ZSessionMin + 60 : _
  3112.         ZSessionHour = ZSessionHour - 1
  3113.      END SUB
  3114. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  3115. ' $PAGE
  3116. '
  3117. '  NAME    -- DefaultU
  3118. '
  3119. '  INPUTS  --     PARAMETER                    MEANING
  3120. '             ZAutoDownDesired
  3121. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  3122. '             ZCheckBulletLogon
  3123. '             ZExpertUser
  3124. '             ZWasGR
  3125. '             ZLastMsgRead
  3126. '             ZLineFeeds
  3127. '             ZNulls
  3128. '             ZPageLength
  3129. '             ZPromptBell
  3130. '             ZRegDate$
  3131. '             ZReqQuesAnswered
  3132. '             ZRightMargin
  3133. '             ZSkipFilesLogon
  3134. '             ZTimesLoggedOn
  3135. '             ZUpperCase
  3136. '             ZUserOption$
  3137. '             ZUserTextColor          Ansi of color (31-37)
  3138. '             ZUserXferDefault$
  3139. '
  3140. '  OUTPUTS--  USER.OPTONS$
  3141. '
  3142. '  PURPOSE --  To update the user's record with their options.
  3143. '  Meaning of graphics preference stored is as follows: where # is
  3144. '  value stored for the color.  E.g. if graphics perference for text
  3145. '  files is color, and preference for normal text is light yellow,
  3146. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3147. '  Blue, Purple, Cyan, and White.
  3148. '
  3149. '             normal                  bold
  3150. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3151. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3152. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3153. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3154. '
  3155.      SUB DefaultU STATIC
  3156.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  3157.             -4 * ZNulls               -8 * ZUpperCase _
  3158.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  3159.            -64 * ZSkipFilesLogon    -128 * ZAutoDownDesired _
  3160.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  3161.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser _
  3162.          -4096 * ZFileWaiting
  3163.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  3164.      IF WasX < 1 OR WasX > 255 THEN _
  3165.         WasX = 48
  3166.      LSET ZUserOption$ = _
  3167.         MKI$(ZTimesLoggedOn) + _
  3168.         MKI$(ZLastMsgRead) + _
  3169.         ZUserXferDefault$ + _
  3170.         CHR$(WasX) + _
  3171.         MKI$(ZRightMargin) + _
  3172.         MKI$(ZWasA) + _
  3173.         ZRegDate$ + _
  3174.         CHR$(ZPageLength) + _
  3175.         ZEchoer$
  3176.      END SUB
  3177. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  3178. ' $PAGE
  3179. '
  3180. '  NAME    -- WhosOn
  3181. '
  3182. '  INPUTS  --     PARAMETER                    MEANING
  3183. '                NumNodes                   # of nodes to check
  3184. '                ZActiveMessageFile$        Current message file
  3185. '                ZOrigMsgFile$              Main msg file
  3186. '
  3187. '  OUTPUTS --  None
  3188. '
  3189. '  PURPOSE --  To display who is on each node.
  3190. '
  3191.      SUB WhosOn (NumNodes) STATIC
  3192.      WasA1$ = ZActiveMessageFile$
  3193.      ZActiveMessageFile$ = ZOrigMsgFile$
  3194.      CALL OpenMsg
  3195.      FIELD 1, 128 AS ZMsgRec$
  3196.      FOR NodeIndex = 2 TO NumNodes + 1
  3197.         GET 1,NodeIndex
  3198.         ZOutTxt$ = ZFG1$ + "Node" + _
  3199.              STR$(NodeIndex - 1) + ZFG2$
  3200.         RecIndex = -VAL(MID$(ZMsgRec$,44,2))
  3201.         IF RecIndex >= 0 THEN _
  3202.            RecIndex = -1
  3203.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  3204.               " BPS: "
  3205.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  3206.            ZWasY$ = "SYSOP" + SPACE$(21) _
  3207.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  3208.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  3209.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN _
  3210.            WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)
  3211.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  3212.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  3213.                 WasAX$ _
  3214.         ELSE IF NOT ZSysop THEN _
  3215.                 ZOutTxt$ = ZOutTxt$ + _
  3216.                      " Waiting for next caller" _
  3217.              ELSE ZOutTxt$ = ZOutTxt$ + _
  3218.                        " Offline at " + _
  3219.                        WasAX$
  3220.         CALL QuickTPut1 (ZOutTxt$)
  3221.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  3222.         IF ZNo THEN _
  3223.            NodeIndex = NumNodes + 2
  3224.      NEXT
  3225.      ZActiveMessageFile$ = WasA1$
  3226.      CALL QuickTPut (ZEmphasizeOff$,0)
  3227.      END SUB
  3228. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  3229. ' $PAGE
  3230. '
  3231. '  NAME    -- RecoverMsg
  3232. '
  3233. '  INPUTS  --     PARAMETER                    MEANING
  3234. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  3235. '               FirstMsgRecord        RECORD # FOR First MSG
  3236. '
  3237. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  3238. '                                         SET TO -1 IF No ERROR
  3239. '
  3240. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3241. '              possible if you have not compressed your message file
  3242. '              using config.
  3243. '
  3244.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC
  3245.       FIELD #1,128 AS ZMsgRec$
  3246.       MsgRec = FirstMsgRecord
  3247. 10420 GET 1,MsgRec
  3248.       NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  3249.       IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  3250.          ZWasY$ = "No Msg #" + _
  3251.               STR$(MsgToRecover) : _
  3252.          GOTO 10485
  3253. 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  3254.          MsgRec = MsgRec + NumRecsInMsg : _
  3255.          GOTO 10420
  3256. 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  3257.          LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  3258.                                 ZActiveMessage$ + _
  3259.                                 MID$(ZMsgRec$,117) : _
  3260.          PUT 1,LOC(1) : _
  3261.          ZWasY$ = "Restored Msg #" + _
  3262.               STR$(MsgToRecover) : _
  3263.          ActionFlag = ZTrue : _
  3264.          GOTO 10485
  3265. 10480 ZWasY$ = "Msg #" + _
  3266.            STR$(MsgToRecover) + _
  3267.            " not Dead"
  3268. 10485 CALL QuickTPut1 (ZWasY$)
  3269.       END SUB
  3270. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  3271. ' $PAGE
  3272. '  NAME    -- UpdateU
  3273. '
  3274. '  INPUTS  -- PARAMETER             MEANING
  3275. '             ZAdjustedSecurity
  3276. '             ZCurDate$
  3277. '             ZDnlds
  3278. '             ZElapsedTime
  3279. '             ZListDir
  3280. '             ZMainUserFileIndex
  3281. '             ZSecsPerSession!
  3282. '             ZUplds
  3283. '             ZUserSecLevel
  3284. '
  3285. '  OUTPUTS -- ZElapsedTime$
  3286. '             ZListNewDate$
  3287. '             ZSecLevel$
  3288. '             ZUserDnlds$
  3289. '             ZUserUplds$
  3290. '
  3291. '  PURPOSE -- Update the user record for the user when the user
  3292. '             exits RBBS-PC.
  3293. '
  3294.       SUB UpdateU (LoggingOff) STATIC
  3295.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  3296.          EXIT SUB
  3297.       IF ZUserFileIndex < 1 THEN _
  3298.          GOTO 10607
  3299.       UpdateDefaults = ZTrue
  3300. 10602 ZSubParm = 6
  3301.       ZWasY$ = ZLastDateTimeOn$
  3302.       CALL FileLock
  3303.       CALL OpenUser (ZHighestUserRecord)
  3304.       FIELD 5,31 AS ZUserName$, _
  3305.               15 AS ZPswd$, _
  3306.                2 AS ZSecLevel$, _
  3307.               14 AS ZUserOption$,  _
  3308.               24 AS ZCityState$, _
  3309.                2 AS MachineType$, _
  3310.                1 AS ZBankTime$,_
  3311.                4 AS ZTodayDl$, _
  3312.                4 AS ZTodayBytes$, _
  3313.                4 AS ZDlBytes$, _
  3314.                4 AS ZULBytes$, _
  3315.               14 AS ZLastDateTimeOn$, _
  3316.                3 AS ZListNewDate$, _
  3317.                2 AS ZUserDnlds$, _
  3318.                2 AS ZUserUplds$, _
  3319.                2 AS ZElapsedTime$
  3320. 10604 GET 5,ZUserFileIndex
  3321.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
  3322.          ZUplds = ZGlobalUplds : _
  3323.          ZDnlds = ZGlobalDnlds : _
  3324.          ZDLToday! = ZGlobalDLToday! : _
  3325.          ZBytesToday! = ZGlobalBytesToday! : _
  3326.          ZDLBytes! = ZGlobalDLBytes! : _
  3327.          ZULBytes! = ZGlobalULBytes! : _
  3328.          ZBankTime = ZGlobalBankTime _
  3329.       ELSE ZBankTime = 0
  3330.       LSET ZBankTime$ = CHR$(ZBankTime)
  3331.       LSET ZLastDateTimeOn$ = ZWasY$
  3332.       LSET ZCityState$ = ZWasCI$
  3333.       IF UpdateDefaults THEN _
  3334.          CALL DefaultU
  3335.       IF ZListDir THEN _
  3336.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  3337.                               CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  3338.                               CHR$(VAL(MID$(ZCurDate$,4,2)))
  3339. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  3340.       LSET ZUserUplds$ = MKI$(ZUplds)
  3341.       IF ZEnforceRatios THEN _
  3342.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  3343.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  3344.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  3345.          LSET ZULBytes$ = MKS$(ZULBytes!)
  3346.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3347.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  3348.          TempElapsed! = ZElapsedTime + _
  3349.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  3350.          ZTimeCredits! = 0 _
  3351.       ELSE TempElapsed! = ZElapsedTime - ZExitToDoors*ZMinsInDoors
  3352.       IF TempElapsed! < -32767 THEN _
  3353.          TempElapsed! = -32767 _
  3354.       ELSE IF TempElapsed! > 32767 THEN _
  3355.          TempElapsed! = 32767
  3356.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  3357.       IF ZAdjustedSecurity THEN _
  3358.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  3359.       PUT 5,ZUserFileIndex
  3360.       ZSubParm = 8
  3361.       CALL FileLock
  3362.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  3363.          ZActiveUserFile$ = ZOrigUserFile$ : _
  3364.          ZUserFileIndex = ZOrigUserFileIndex : _
  3365.          UpdateDefaults = ZFalse : _
  3366.          LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _
  3367.          GOTO 10602
  3368. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  3369.          EXIT SUB
  3370.       Temp = ZMinsPerSession
  3371.       IF ZMaxPerDay > 0 THEN _
  3372.          Temp = ZMaxPerDay - TempElapsed! : _
  3373.          IF Temp > ZMinsPerSession THEN _
  3374.             Temp = ZMinsPerSession
  3375.       Temp = -(Temp > 0) * Temp
  3376.       CALL QuickTPut1 (STR$(Temp)+" min left for next call today")
  3377.       CALL QuickTPut1 (ZFirstName$ + ", Thanks and please call again!")
  3378.       IF NOT ZHiLiteOff THEN _
  3379.          CALL QuickTPut1 (ZColorReset$)
  3380.       CALL DelayTime (8 + ZBPS)
  3381.       END SUB
  3382. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  3383. ' $PAGE
  3384. '  NAME    -- DosExit
  3385. '
  3386. '  INPUTS  -- PARAMETER             MEANING
  3387. '             ZComPort$
  3388. '             ZDoorsTermType
  3389. '             ZMultiLinkPresent
  3390. '             ZRBBSBat$
  3391. '             ZRedirectIOMethod
  3392. '             ZUseDeviceDriver$
  3393. '
  3394. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3395. '                                      ZRCTTYBat$
  3396. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3397. '
  3398. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  3399. '             exit to DOS for the remote RBBS-PC sysop
  3400. '
  3401.       SUB DosExit STATIC
  3402.       IF ZMultiLinkPresent AND _
  3403.          ZDoorsTermType > 0 THEN _
  3404.          ZFF = 0 : _
  3405.          GOTO 10950
  3406.       ZOutTxt$(1) = "ECHO OFF"
  3407.       IF ZUseDeviceDriver$ <> "" THEN _
  3408.          Port$ = ZUseDeviceDriver$ _
  3409.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  3410.       IF ZRedirectIOMethod THEN _
  3411.          ZFF = 5 : _
  3412.          ZOutTxt$(2) = "CTTY " + _
  3413.                  Port$ : _
  3414.          ZOutTxt$(3) = ZDiskForDos$ + _
  3415.                  "COMMAND" : _
  3416.          ZOutTxt$(4) = "CTTY CON" : _
  3417.          ZOutTxt$(5) = ZRBBSBat$ _
  3418.       ELSE ZFF = 3 : _
  3419.            ZOutTxt$(2) = ZDiskForDos$ + _
  3420.                    "COMMAND >" + _
  3421.                    Port$ + _
  3422.                    " <" + _
  3423.                    Port$ : _
  3424.            ZOutTxt$(3) = ZRBBSBat$
  3425. 10950 CALL AMorPM
  3426.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  3427.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  3428.       CALL QuickTPut1 ("SysOp in Remote Console mode")
  3429.       CALL RBBSExit (ZOutTxt$(),ZFF)
  3430.       END SUB
  3431. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  3432. ' $PAGE
  3433. '  NAME    -- WordInFile
  3434. '
  3435. '  INPUTS  -- PARAMETER             MEANING
  3436. '             FilName$              FILE TO SEARCH IN
  3437. '             Strng$                STRING TO SEARCH FOR
  3438. '
  3439. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  3440. '
  3441. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  3442. '             limit doors and questionnaires to those specified
  3443. '             in their menu files.  The "Strng$" is capitalized
  3444. '             but not the lines in the file, so must be exact
  3445. '             case-sensitive match to be found.  The only character
  3446. '             that can immediately proceed or end a name to be
  3447. '             found must be a blank.
  3448. '
  3449.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  3450.       InFile = ZFalse
  3451.       CALL FindIt (FilName$)
  3452.       IF NOT ZOK THEN _
  3453.          EXIT SUB
  3454.       WasX = 0
  3455.       CALL AllCaps (Strng$)
  3456.       WHILE NOT EOF(2) AND WasX < 1
  3457.          LINE INPUT #2,ZOutTxt$
  3458.          WasY = 1
  3459. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  3460.          IF WasX < 1 THEN _
  3461.             GOTO 10980
  3462.          WasY = WasX + 1
  3463.          IF WasX > 1 THEN _
  3464.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  3465.                WasX = 0
  3466.          IF WasX > 0 THEN _
  3467.             WasL = LEN(Strng$) : _
  3468.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  3469.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  3470.                   WasX = 0
  3471.          IF WasX = 0 THEN _
  3472.             GOTO 10978
  3473. 10980 WEND
  3474.       CLOSE 2
  3475.       InFile = (WasX > 0)
  3476.       END SUB
  3477. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  3478. ' $PAGE
  3479. '  NAME    -- DoorExit
  3480. '
  3481. '  INPUTS  -- PARAMETER             MEANING
  3482. '             ZMultiLinkPresent
  3483. '             ZNodeID$
  3484. '             ZRBBSBat$
  3485. '             ZWasZ$
  3486. '
  3487. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3488. '                                      ZRCTTYBat$
  3489. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3490. '
  3491. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  3492. '             exit RBBS-PC to invoke another program
  3493. '
  3494.       SUB DoorExit (ReqDoorsDef) STATIC
  3495.       IF ZWasZ$ = "" OR _
  3496.          ZWasZ$ = "NONE" THEN _
  3497.          EXIT SUB
  3498.       CALL FindIt (ZWasZ$)
  3499.       IF NOT ZOK THEN _
  3500.          GOTO 10986
  3501.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)
  3502.       ExitMethod$ = ""
  3503.       ZDooredTo$ = ExitTo$
  3504.       CALL FindIt (ZDoorsDef$)
  3505.       IF NOT ZOK THEN _
  3506.          IF ReqDoorsDef THEN _
  3507.             EXIT SUB _
  3508.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3509.               GOTO 10989
  3510. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  3511.       IF ZErrCode > 0 THEN _
  3512.          IF ReqDoorsDef THEN _
  3513.             EXIT SUB _
  3514.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3515.               GOTO 10989
  3516.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  3517.          GOTO 10985
  3518.       CALL CheckInt (ZOutTxt$(2))
  3519.       IF ZErrCode > 0 THEN _
  3520.          ZErrCode = 0 : _
  3521.          GOTO 10985
  3522.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3523.          CALL QuickTPut1 ("Insufficient security for door") : _
  3524.          EXIT SUB
  3525.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  3526.       CALL FindIt (WasX$)
  3527.       IF NOT ZOK THEN _
  3528.          GOTO 10986
  3529.       ZFileName$ = ZOutTxt$(3)
  3530.       ExitMethod$ = ZOutTxt$(4)
  3531.       ExitTemplate$ = ZOutTxt$(5)
  3532.       ZDoorDisplay$ = ZOutTxt$(7)
  3533.       ZDoorTime$ = ZOutTxt$(8)
  3534.       CALL AskUsers
  3535.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  3536.       CALL MetaGSR (ExitTemplate$,ZFalse)
  3537.       ExitTo$ = ExitTemplate$
  3538.       GOTO 10989
  3539. 10986 ZOutTxt$ = "Missing door program"
  3540.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  3541.       ZSnoop = ZTrue
  3542.       CALL LPrnt (ZOutTxt$,1)
  3543.       EXIT SUB
  3544. 10989 IF ZTransferFunction = 3 THEN _
  3545.          ZWasY$ = "Registration" _
  3546.       ELSE ZWasY$ = ZDooredTo$
  3547.       ZOutTxt$ = ZWasY$ + _
  3548.            " door opened at " + _
  3549.            TIME$ + _
  3550.            " on " + _
  3551.            DATE$
  3552.       ZSubParm = 5
  3553.       CALL TPut
  3554.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  3555.       CALL DoorInfo
  3556.       IF ExitMethod$ = "S" THEN _
  3557.          CALL UpdateU (ZFalse) : _
  3558.          CLOSE 4,5 : _
  3559.          CALL ShellExit (ExitTemplate$) : _
  3560.          ZPrevCaller$ = "" : _
  3561.          CALL SetCall : _
  3562.          ZExitToDoors = ZTrue : _
  3563.          CALL DoorReturn : _
  3564.          CALL BufFile (ZDoorDisplay$,WasX) : _
  3565.          ZExitToDoors = ZFalse _
  3566.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  3567.                   "COMMAND /C " + _
  3568.                   ExitTo$ : _
  3569.            ZOutTxt$(2) = ZRBBSBat$ : _
  3570.            CALL RBBSExit (ZOutTxt$(),2)
  3571.       END SUB
  3572. 10991 ' $SUBTITLE: 'DoorInfo -- Write info for doors to file'
  3573.       SUB DoorInfo STATIC
  3574.       CLOSE 2
  3575.       OPEN "O",2,"DORINFO" + _
  3576.                  ZNodeFileID$ + _
  3577.                  ".DEF"
  3578.       PRINT #2,ZRBBSName$
  3579.       PRINT #2,ZSysopFirstName$
  3580.       PRINT #2,ZSysopLastName$
  3581.       IF ZLocalUser THEN _
  3582.          PRINT #2,"COM0" _
  3583.       ELSE PRINT #2,ZComPort$
  3584.       ZUserIn$ = MID$(ZBaudParity$, INSTR(ZBaudParity$, ","))
  3585.       PRINT #2,ZTalkToModemAt$;" BAUD";ZUserIn$
  3586.       PRINT #2,ZNetworkType
  3587.       IF ZGlobalSysop THEN _
  3588.          PRINT #2,"SYSOP" : _
  3589.          PRINT #2,"" _
  3590.       ELSE PRINT #2,ZFirstName$ : _
  3591.            PRINT #2,ZLastName$
  3592.       PRINT #2,ZCityState$
  3593.       PRINT #2,ZWasGR
  3594.       PRINT #2,ZUserSecLevel
  3595.       CALL TimeRemain (MinsRemaining)
  3596.       CALL CheckInt (ZDoorTime$)
  3597.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  3598.          IF MinsRemaining > ZTestedIntValue THEN _
  3599.             MinsRemaining = ZTestedIntValue
  3600.       PRINT #2,INT(MinsRemaining)
  3601.       PRINT #2,ZFossil
  3602.       CLOSE 2
  3603.       END SUB
  3604. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  3605. ' $PAGE
  3606. '  NAME    -- RBBSExit
  3607. '
  3608. '  INPUTS  -- PARAMETER             MEANING
  3609. '             LINE.ARA        Array of lines to write to batch file
  3610. '             NumLines        How many lines in array
  3611. '
  3612. '  OUTPUTS -- ZRCTTYBat$
  3613. '
  3614. '  PURPOSE -- To create a batch file that control can be passed to
  3615. '             and to exit RBBS-PC while still keeping carrier up
  3616. '
  3617.       SUB RBBSExit (LineAra$(1),NumLines) STATIC
  3618.       CLOSE 2
  3619.       IF NumLines = 0 THEN _
  3620.          GOTO 10994
  3621.       OPEN "O",2,ZRCTTYBat$
  3622.       FOR WasI = 1 TO NumLines
  3623.          IF LineAra$(WasI) <> "" THEN _
  3624.             PRINT #2,LineAra$(WasI)
  3625.       NEXT
  3626.       CLOSE 2
  3627. 10994 CLOSE 3
  3628.       ZExitToDoors = ZTrue
  3629.       IF NOT ZFossil THEN _
  3630.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  3631.       IF NOT ZPrivateDoor THEN _
  3632.          CALL MLInit (2)
  3633. 10996 CALL UpdateU (ZTrue)
  3634.       CALL GetTime
  3635.       CALL SaveProf (1)
  3636.       IF NumLines = 0 THEN _
  3637.          EXIT SUB
  3638.       CALL DelayTime (9 + ZBPS)
  3639.       IF ZFossil THEN _
  3640.          CALL FOSExit(ZComPort)
  3641.       SYSTEM
  3642.       END SUB
  3643. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  3644. ' $PAGE
  3645. '  NAME    -- SetSection         Doug Azzarito
  3646. '
  3647. '  INPUTS  -- PARAMETER             MEANING
  3648. '             ZMenuIndex      2 = user is in MAIN section
  3649. '                             3 = user is in FILE section
  3650. '                             4 = user is in UTIL section
  3651. '                             6 = user is in LIBR section
  3652. '
  3653. '  OUTPUTS -- ZSection$       4 character section name
  3654. '             ZActiveMenu$    1 character section name
  3655. '             ZSectionPrompt$ Section name (if ZShowSection config)
  3656. '             ZCmdPrompt$     Command input prompt string
  3657. '             ZSectionOpts$   List of options valid in this sect
  3658. '             ZInvalidOpts$   List of options invalid in this sect
  3659. '             ZSubSection     Index into security array for section
  3660. '
  3661. '  PURPOSE -- To build the prompt strings for the current section
  3662. '
  3663.       SUB SetSection STATIC
  3664.       IF ZMenuIndex <> 6 THEN _
  3665.          ZCurDirPath$ = ZDirPath$
  3666.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  3667. 12001 EXIT SUB
  3668. 12005 LSET ZSection$ = "FILE"
  3669.       ZSectionOpts$ = ZFileOpts$
  3670.       ZInvalidOpts$ = ZInvalidFileOpts$
  3671.       ZSubSection = ZBegFile
  3672.       GOTO 12025
  3673. 12010 LSET ZSection$ = "MAIN"
  3674.       ZSectionOpts$ = ZMainOpts$
  3675.       ZInvalidOpts$ = ZInvalidMainOpts$
  3676.       ZSubSection = ZBegMain
  3677.       GOTO 12025
  3678. 12015 LSET ZSection$ = "LIBR"
  3679.       ZSectionOpts$ = ZLibOpts$
  3680.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  3681.       ZSubSection = ZBegLibrary
  3682.       ZCurDirPath$ = ZLibDirPath$
  3683.       GOTO 12025
  3684. 12020 LSET ZSection$ = "UTIL"
  3685.       ZSectionOpts$ = ZUtilOpts$
  3686.       ZInvalidOpts$ = ZInvalidUtilOpts$
  3687.       ZSubSection = ZBegUtil
  3688. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  3689.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  3690.       IF ZShowSection THEN _
  3691.          ZSectionPrompt$ = ZSection$ _
  3692.       ELSE ZSectionPrompt$ = "Your"
  3693.       IF ZCmndsInPrompt=0 THEN _
  3694.           ZSectionOpts$ = ""
  3695.       ZCmdPrompt$ = ZSectionPrompt$ + _
  3696.                         " command" + _
  3697.                         ZSectionOpts$
  3698.       END SUB
  3699. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  3700. ' $PAGE
  3701. '
  3702. '  NAME    -- UntilRight
  3703. '
  3704. '  INPUTS  -- PARAMETER             MEANING
  3705. '             Ques$         QUESTION TO BE ASKED THE USER
  3706. '             Ans$          LOCATION TO STORE THE ANSWER
  3707. '             MinLen        MINIMUM LENGTH OF ANSWER
  3708. '             MaxLen        MAX LENGTH OF ANSWER
  3709. '
  3710. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  3711. '                                      CALLERS SAYS IS CORRECT
  3712. '
  3713. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3714. '             responds that the answer is correct
  3715. '
  3716.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  3717. 12880 ZParseOff = ZTrue
  3718.       ZOutTxt$ = Ques$
  3719.       CALL PopCmdStack
  3720.       IF ZSubParm = -1 THEN _
  3721.          GOTO 12882
  3722.       IF ZWasQ = 0 THEN _
  3723.          GOTO 12880
  3724.       IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
  3725.          ZLastIndex = 0 : _
  3726.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  3727.          GOTO 12880_
  3728.       ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
  3729.               ZLastIndex = 0 : _
  3730.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  3731.               GOTO 12880
  3732.       Ans$ = ZUserIn$(ZAnsIndex)
  3733.       IF ZAnsIndex < ZLastIndex THEN _
  3734.          GOTO 12881
  3735.       ZOutTxt$ = ZUserIn$(ZAnsIndex) + _
  3736.            ", right ([Y],N)"
  3737.       ZTurboKey = -ZTurboKeyUser
  3738.       ZSubParm = 1
  3739.       CALL TGet
  3740.       IF ZSubParm = -1 THEN _
  3741.          GOTO 12882
  3742.       IF ZNo THEN _
  3743.          GOTO 12880
  3744. 12881 CALL AllCaps (Ans$)
  3745.       EXIT SUB
  3746. 12882 Ans$ = "GUEST"
  3747.       END SUB
  3748. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  3749. ' $PAGE
  3750. '
  3751. '  NAME    -- LogError
  3752. '
  3753. '  INPUTS  --     PARAMETER                    MEANING
  3754. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3755. '                    ERL           Last LINE NUMBER ENCOUNTERED
  3756. '                                  PRIOR TO ENCOUNTERNING ERROR
  3757. '
  3758. '  OUTPUTS -- NONE
  3759. '
  3760. '  PURPOSE -- To set up a string to write to the callers log
  3761. '             indicating the date, time, error, and error line
  3762. '
  3763.       SUB LogError STATIC
  3764.       WasIX = ERR
  3765.       IF ERR < 1 THEN _
  3766.          WasIX = ZErrCode
  3767.       CALL UpdtCalr("+++ Error " + _
  3768.            STR$(WasIX) + _
  3769.            " line " + _
  3770.            STR$(ERL) + _
  3771.            " at " + _
  3772.            TIME$ + _
  3773.            " on " + _
  3774.            DATE$,2)
  3775.       END SUB
  3776. '
  3777. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  3778. ' $PAGE
  3779. '
  3780. '  NAME    -- CheckRatio
  3781. '
  3782. '  INPUTS  --   PARAMETER                    MEANING
  3783. '               TellUser           TELL USER THEIR RATIO
  3784. '               ZDnlds             FILES DOWNLOADED
  3785. '               ZDLBytes!          BYTES DOWNLOADED
  3786. '               ZUplds             FILES UPLOADED
  3787. '               ZULBytes!          BYTES UPLOADED
  3788. '
  3789. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  3790. '
  3791. '  PURPOSE -- To determine whether the users violated
  3792. '             their upload to download restriction
  3793. '
  3794.       SUB CheckRatio (TellUser) STATIC
  3795.       ZOK = ZTrue
  3796.       IF ZRatioRestrict# <= 0 OR (NOT ZEnforceRatios) OR ZFreeDnld THEN _
  3797.          GOTO 20110
  3798. '
  3799. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  3800. '
  3801.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  3802.          Method$ = "Bytes" : _
  3803.          ULWork# = ZULBytes! : _
  3804.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  3805.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  3806.          Method$ = "Files" : _
  3807.          ULWork# = ZUplds : _
  3808.          DLWork# = ZDnlds + ZDownFiles
  3809.       IF ULWork# < ZInitialCredit# THEN _
  3810.          ULWork# = ZInitialCredit#
  3811.       IF ZByteMethod = 2 THEN _
  3812.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  3813.       IF ZByteMethod = 3 THEN _
  3814.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  3815. '
  3816.       Ratio# = 0
  3817.       RatioSuffix$ = ":0"
  3818.       IF ULWork# > 0 THEN _
  3819.          Ratio# = (DLWork# / ULWork#) : _
  3820.          RatioSuffix$ = ":1"
  3821.       IF ZByteMethod > 1 THEN _
  3822.          ZOutTxt$ = "Today Downloaded Files: " + STR$(ZDLToday! + ZDownFiles) + _
  3823.               "  Bytes:" + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  3824.          ZSubParm = 5 : _
  3825.          CALL TPut : _
  3826.          CALL SkipLine (1) : _
  3827.          GOTO 20100
  3828.       WasX$ = STR$(Ratio#)
  3829.       X = INSTR(WasX$,".")
  3830.       IF X > 0 THEN _
  3831.          WasX$ = LEFT$(WasX$,X+1)
  3832.       ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _
  3833.               " Uploaded:" + _
  3834.               STR$(ULWork#) + _
  3835.               " Ratio:" + _
  3836.               WasX$ + _
  3837.               RatioSuffix$
  3838.       ZSubParm = 5
  3839.       CALL TPut
  3840. '
  3841. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3842. '
  3843. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  3844.          EXIT SUB
  3845.       IF ZByteMethod <= 1 THEN _
  3846.          GOTO 20105
  3847.       IF Today# < 0 THEN _
  3848.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  3849.               STR$(ZRatioRestrict#) + " " + _
  3850.               Method$ + " Reached" : _
  3851.          ZOK = ZFalse _
  3852.       ELSE ZOutTxt$ = "Download balance:" + _
  3853.                 STR$(Today#) + _
  3854.                 " " + _
  3855.                 Method$ : _
  3856.            ZOK = ZTrue
  3857.       ZSubParm = 5
  3858.       CALL TPut
  3859.       CALL SkipLine(1)
  3860.       EXIT SUB
  3861. '
  3862. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  3863.          ZOK = ZFalse : _
  3864.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  3865.               STR$(ZRatioRestrict#) + _
  3866.               ":1 " + _
  3867.               Method$ + " exceeded" : _
  3868.          ZSubParm = 5 : _
  3869.          CALL TPut : _
  3870.          ZOutTxt$ = "Minimum upload of" + _
  3871.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  3872.               / ZRatioRestrict#) + 1)) + _
  3873.               + " " + Method$ + " required to download" _
  3874.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  3875.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  3876.                 " " + Method$
  3877.       ZSubParm = 5
  3878.       CALL TPut
  3879.       CALL SkipLine (1)
  3880. 20110 END SUB
  3881. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  3882. ' $PAGE
  3883. '
  3884. '  NAME    -- GetArc
  3885. '
  3886. '  INPUTS  --     PARAMETER                    MEANING
  3887. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  3888. '                 ZUserIn$()                  ENTRIES TYPED
  3889. '
  3890. '  OUTPUTS --
  3891. '
  3892. '  PURPOSE --  Process the V)erbose list command.
  3893. '              Takes what user types and tries to list it.
  3894. '
  3895.       SUB GetArc STATIC
  3896. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  3897.          IF LEN(ZDefaultExtension$) > 0 THEN _
  3898.             CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$)
  3899.       WasZ$ = "V"
  3900.       CALL AskItems ("V",WasZ$,ZFalse,"file",ZMarkedFiles$)
  3901.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3902.          EXIT SUB
  3903.       ZViolation$ = "View ARC"
  3904.       WasX = ZAnsIndex
  3905.       ZAnsIndex = WasX
  3906. 20142 IF ZAnsIndex > ZLastIndex THEN _
  3907.          IF ZLastIndex > 1 THEN _
  3908.             EXIT SUB _
  3909.          ELSE GOTO 20141
  3910.       GOSUB 20143
  3911.       IF ZSubParm < 0 THEN _
  3912.          EXIT SUB
  3913.       ZAnsIndex = ZAnsIndex + 1
  3914.       GOTO 20142
  3915. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  3916.       CALL UnMarkItems (ZMarkedFiles$,ZAnsIndex, ZLastIndex,Temp,ZFalse)
  3917.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  3918.       WasZ$ = ZWasZ$
  3919.       CALL AllCaps (ZWasZ$)
  3920.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  3921.       IF Ext$ = "" THEN _
  3922.          Ext$ = ZDefaultExtension$ : _
  3923.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  3924.       ZFileNameHold$ = ZWasZ$
  3925.       ZFileName$ = ZWasZ$
  3926.       CALL BadFile (Prefix$,BadFileNameIndex)
  3927.       ON BadFileNameIndex GOTO 20144,20146,20147
  3928. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  3929.       ON BadFileNameIndex GOTO 20145,20146,20147
  3930. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V")
  3931.       IF ZOK THEN _
  3932.          GOTO 20148
  3933. 20146 ZWasZ$ = WasZ$ + _
  3934.            " not found!"
  3935.       CALL UpdtCalr (ZWasZ$,2)
  3936.       ZOutTxt$ = ZWasZ$ + _
  3937.            " Type correct filename" + ZPressEnterExpert$
  3938.       ZSubParm = 1
  3939.       CALL TGet
  3940.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3941.          RETURN
  3942.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  3943.       GOTO 20143
  3944. 20147 CALL SecViolation
  3945.       IF ZDenyAccess THEN _
  3946.          EXIT SUB
  3947.       GOTO 20146
  3948. 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT"
  3949.       CALL FindIt (WasX$)
  3950.       IF NOT ZOK THEN _
  3951.          GOTO 20150
  3952.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  3953.       CALL ReadDir (2,1)
  3954.       IF EOF(2) THEN _
  3955.          ZWasZ$ = ZOutTxt$ : _
  3956.          ZGSRAra$(1) = ZFileName$ : _
  3957.          ZGSRAra$(2) = ZArcWork$ _
  3958.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  3959.                 " " + ZArcWork$ + " " + ZGSRAra$(3)
  3960.       CALL ShellExit (ZWasZ$)
  3961.       CALL BufFile (ZArcWork$,WasX)
  3962.       RETURN
  3963. 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
  3964.       'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
  3965.       IF (WasX < 1) THEN _
  3966.          CALL QuickTPut1 ("View for "+Ext$+" not implemented") : _
  3967.          RETURN
  3968.       CALL QuickTPut1 (ZFileNameHold$ + " has these files")
  3969.       CALL ViewArc
  3970.       RETURN
  3971.       END SUB
  3972. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  3973. ' $PAGE
  3974. '
  3975. '  NAME    -- BadName
  3976. '
  3977. '  INPUTS  --     PARAMETER                    MEANING
  3978. '               ZActiveMessageFile$
  3979. '               ZActiveUserFile$
  3980. '               ZCallersFile$
  3981. '               ZCmntsFile$
  3982. '               CONFIG.FILEANAME$
  3983. '               ZMainMsgBackup$
  3984. '               ZMainMsgFile$
  3985. '               ZMaxViolations
  3986. '               ZPswdFile$
  3987. '               ZRBBSBat$
  3988. '               ZRCTTYBat$
  3989. '               ZSubDir$()
  3990. '               ZSubDirIndex
  3991. '               ZViolation$
  3992. '               ZViolationsThisSession
  3993. '               ZWasZ$                          NAME OF FILE
  3994. '               ProtectExt              -1 if check for extension
  3995. '                                        0 to allow any extension
  3996. '
  3997. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  3998. '                                       2 = SECURITY BREACH TRIED
  3999. '
  4000. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  4001. '             to either crash the system or to breach RBBS-PC's security
  4002. '
  4003.       SUB BadName (BadFileNameIndex,ProtectExt) STATIC
  4004. '
  4005. '
  4006. ' *  TEST FOR SYSTEM FILE ATTEMPT
  4007. '
  4008.       BadFileNameIndex = 2
  4009.       ZWasZ$ = ZFileName$
  4010.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  4011.       IF LEN(Extension$) = 3 AND ProtectExt THEN _
  4012.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  4013.             EXIT SUB
  4014.       ZOK = 0
  4015.       IF ProtectExt THEN _
  4016.          CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  4017.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  4018.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  4019.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  4020.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  4021.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  4022.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  4023.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  4024.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  4025.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  4026.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  4027.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  4028.       IF ZOK = 0 THEN _
  4029.          BadFileNameIndex = 1
  4030.       END SUB
  4031. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  4032. ' $PAGE
  4033. '
  4034. '  NAME    -- FileNameCheck
  4035. '
  4036. '  INPUTS  --     PARAMETER                    MEANING
  4037. '               CheckThis$           Name of file to check
  4038. '               Pref2$               Prefix to match against
  4039. '               Ext2$                Extension to match against
  4040. '
  4041. '  OUTPUTS  -- ZOK                    1 if got match
  4042. '
  4043. '  PURPOSE -- Checks for match on both prefix and extension of a file
  4044. '             name.   Used to catch match on system files not to be
  4045. '             downloaded.
  4046. '
  4047.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  4048.       IF ZOK > 0 THEN _
  4049.          EXIT SUB
  4050.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  4051.       IF Pref1$ = Pref2$ THEN _
  4052.          IF Ext1$ = Ext2$ THEN _
  4053.             ZOK = 1
  4054.       END SUB
  4055. 20245 SUB SetBPS (BaudTest!,BPS) STATIC
  4056.       IF BaudTest! > 0 AND BaudTest! < 100 THEN _
  4057.          BaudTest! = BaudTest! * 100  ' Support 14.4 for 14,400
  4058.       IF BaudTest! = 2400 THEN _
  4059.          BPS = -4 _
  4060.       ELSE IF BaudTest! = 1200 OR BaudTest! = 1275 THEN _
  4061.          BPS = -3 _
  4062.       ELSE IF BaudTest! >= 7200 AND BaudTest! < 19200 THEN _
  4063.          GOTO 20246 _
  4064.       ELSE IF BaudTest! = 0 OR BaudTest! = 300 THEN _
  4065.          BaudTest! = 300 : _
  4066.          BPS = -1 _
  4067.       ELSE IF BaudTest! = 19200 THEN _
  4068.          BPS = -11 _
  4069.       ELSE IF BaudTest! = 38400 THEN _
  4070.          BPS = -12 _
  4071.       ELSE IF BaudTest! = 4800 THEN _
  4072.          BPS = -5 _
  4073.       ELSE BPS = 0
  4074.       EXIT SUB
  4075. 20246 IF BaudTest! = 14400 THEN _
  4076.          BPS = -9 _
  4077.       ELSE IF BaudTest! = 16800 THEN _
  4078.          BPS = -10 _
  4079.       ELSE IF BaudTest! = 7200 THEN _
  4080.          BPS = -6 _
  4081.       ELSE IF BaudTest! = 12000 THEN _
  4082.          BPS = -8 _
  4083.       ELSE BPS = -7       ' 9600
  4084.       END SUB
  4085.